UVrules.pm

   1 # UVrules: Module with rule functions for usevote
   2 # Used by uvvote.pl, UVconfig.pm
   3
   4 package UVrules;
   5
   6 use strict;
   7 use vars qw (@ISA @EXPORT $VERSION @rules);
   8 use UVconfig;
   9 use UVmessage;
  10
  11 require Exporter;
  12 @ISA = qw(Exporter);
  13 @EXPORT = qw(@rules);
  14
  15 # Module version
  16 $VERSION = "0.3";
  17
  18 # ---------------------------------------------------------------------
  19 # Erlaeuterung zur Regelpruefung (to be translated)
  20 # ---------------------------------------------------------------------
  21 # Um Stimmen mit multiplen Abstimmungspunkten auf ihre Sinnfaelligkeit
  22 # pruefen zu koennen, koennen in Usevote verschiedenste Regeln
  23 # fuer solche Pruefungen definiert werden.
  24 #
  25 # Die Regeln bestehen aus zwei Teilen. Einer IF-Klausel und einer THEN-
  26 # Klausel. Die IF-Klausel bestimmt, ob die Stimme mit der THEN-Klausel
  27 # verglichen werden soll. Passt sie auf diese, ist die Stimme in Ordnung,
  28 # wenn nicht liegt ein Fehler vor.
  29 #
  30 # Ein kleines Beispiel: "IF S.. THEN .SS"
  31 # Wenn beim ersten Punkt mit Ja oder Nein gestimmt wurde, dann muss
  32 # bei den anderen beiden Punkten auch ein Ja oder Nein vorliegen.
  33 #
  34 # Die Stimmabgabe JNE wuerde also gegen die obige Regel verstossen,
  35 # JJN nicht. EEJ wuerde ebenfalls gueltig sein, da die Regel nicht unter
  36 # die IF-Klausel faellt und somit keine Ueberpruefung der THEN-Klausel
  37 # erfolgt.
  38 #
  39 #
  40 # ---------------------------------------------------------------------
  41 # Implementierung
  42 # ---------------------------------------------------------------------
  43 # Um eine moeglichst einfache Ueberpruefung der Stimmen vorzunehmen,
  44 # bietet es sich an, aus den beiden Klauseln regulaere Ausdruecke zu
  45 # generieren. Diese wuerden dann auf die Stimme angewandt werden.
  46 #
  47 # Bei der Umwandlung in regulaere Audruecke kommt uns die Notation
  48 # der Regeln bereits entgegen. So kann der Punkt als beliebige Stimme
  49 # beibehalten werden. Die grossen Buchstaben bleiben ebenfalls bis
  50 # auf S erhalten, da die zu pruefenden Stimmen aus den Buchstaben
  51 # 'JNE' bestehen.
  52 #
  53 # So muessen wir zur Ueberpruefung von direkten Stimmen nur 'S' in
  54 # eine Klasse mit [JN] und I in eine Klasse mit [EN] umwandeln.
  55 #
  56 # 'J..' => 'J..', 'NNE' => 'NNE', 'S..' => '[JN]..'
  57 #
  58 # Bei den indirekten Stimmabgaben wird es schon schwieriger. Hier
  59 # muessten alle Moeglichkeiten eines Strings gebaut werden, um zu
  60 # testen ob mindestens eine Version matcht.
  61 #
  62 # '.jjj' => '.(j..|.j.|..j)
  63 #
  64 # Je komplexer die Regeln, um so mehr Moeglichkeiten muessten
  65 # konstruiert werden, um einen geschlossenen regulaeren Ausdruck
  66 # zu erhalten.
  67 #
  68 # Wir koennen den Regex aber auch einfach aufbauen, in dem wir
  69 # nicht alle Faelle betrachten die moeglich sind, sondern nur die
  70 # Faelle die nicht erlaubt sind.
  71 #
  72 # D.h. soll an einer Stelle ein Ja stehen, erlauben wir dort
  73 # nur Nein und Enthaltungen. Passt eine Stimme auf diesen Regex,
  74 # kann sie unmoeglich die Vorgabe enthalten.
  75 #
  76 # 'nnnn' => '[JE][JE][JE][JE]'
  77 #
  78 # Besteht eine Stimme also nur aus Ja und Enthaltung, wissen wir
  79 # das kein einziges Nein enthalten seien kann. Die Stimme passt
  80 # also nicht auf unser Muster.
  81 #
  82 # Tritt hingegen nur ein einziges J auf, passt der regulaere Ausdruck
  83 # nicht mehr, und wir wissen, dass die Stimme die Regel erfuellt.
  84 #
  85 # Wie wir sehen koennen, ist der negative Ausdruck leichter zu
  86 # bilden als der positive.
  87 #
  88 #
  89 # Da eine Stimme nun sowohl aus direkten, als auch indirekten
  90 # Stimmen bestehen kann (z.B. 'Jnnn..') muessen wir die Stimme
  91 # zerlegen. Wir bilden einen positiven Regex fuer die Grossbuch-
  92 # staben und einen negativen Regex fuer die kleinen.
  93 #
  94 # Passt eine Stimme dann auf den positiven Regex und nicht auf
  95 # den negativen Regex, so entspricht sie der urspruenglichen
  96 # Regel.
  97 #
  98 # Ein Beispiel: 'Sss..' (Der erste Punkt und der zweite oder dritte
  99 # Punkt muessen ein Ja oder Nein sein.)
 100 #
 101 # positiver Regex: '[JN]...'    muss erfuellt werden
 102 # negativer Regex: '.EE.'       darf nicht erfuellt werden
 103 #
 104 # JJNN => positiv matcht => negativ matcht nicht => Regel erfuellt
 105 # ENJE => positiv matcht nicht => Regel nicht erfuellt
 106 # NEEJ => positiv matcht => negativ matcht => Regel nicht erfuellt
 107 #
 108 #
 109 # Mit Hilfe dieser Technik, lassen sich einfach Regex bilden, die
 110 # ebenso einfach ueberprueft werden koennen.
 111
 112
 113 ##############################################################################
 114 # Read usevote.rul and check rules for correct syntax                        #
 115 ##############################################################################
 116
 117 sub read_rulefile {
 118   @rules = ();
 119
 120   open (RULES, "<$config{rulefile}")
 121     or die UVmessage::get("RULES_ERROPENFILE", (FILE => $config{rulefile})) . "\n\n";
 122
 123   while (<RULES>) {
 124     chomp;
 125     s/#.*$//;  # delete comments
 126
 127     # does line match correct if-then syntax?
 128     if (/^\s*if\s+(\S+)\s+then\s+(\S+)\s*$/) {
 129       my $if   = $1;
 130       my $then = $2;
 131
 132       # $num contains the rule's array index
 133       my $num = @rules;
 134
 135       # check for correct length of condition
 136       my $errortext;
 137       if (length($if) < @groups) {
 138         $errortext = UVmessage::get("RULES_TOOSHORT", (NUM=>$num+1, TYPE=>"if"));
 139
 140       } elsif (length($if) > @groups) {
 141         $errortext = UVmessage::get("RULES_TOOLONG", (NUM=>$num+1, TYPE=>"if"));
 142
 143       } elsif (length($then) < @groups) {
 144         $errortext = UVmessage::get("RULES_TOOSHORT", (NUM=>$num+1, TYPE=>"then"));
 145
 146       } elsif (length($then) > @groups) {
 147         $errortext = UVmessage::get("RULES_TOOLONG", (NUM=>$num+1, TYPE=>"then"));
 148       }
 149       die $errortext . ": $_\n\n" if ($errortext);
 150
 151       # check for correct characters in conditions
 152       if ($if !~ /^[JjNnEeSsHhIi\.]+$/) {
 153         die UVmessage::get ("RULES_INVCHARS", (NUM=>$num+1, TYPE=>"if")) . ": $if\n\n";
 154
 155       } elsif ($then !~ /^[JjNnEeSsHhIi\.]+$/) {
 156         die UVmessage::get ("RULES_INVCHARS",
 157                             (NUM=>$num+1, TYPE=>"if")) . ": $then\n\n";
 158       }
 159
 160       # Zur Speicherung der Regeln (to be translated):
 161       # - if_compl und then_compl sind die kompletten Bedingungen als Strings,
 162       #   werden fuer die Sprachausgabe der Regeln benoetigt
 163       # - zusaetzlich werden der if- und then-Teil fuer die einfachere
 164       #   Verarbeitung in zwei Teile gesplittet: Eine Positiv-Regex, die auf
 165       #   die Grossbuchstaben (explizite Forderungen, UND-Verknuepfungen)
 166       #   matched, und eine Negativ-Regex, die bei den Kleinbuchstaben
 167       #   (optionale Felder, ODER-Verknuepfungen) verwendet wird.
 168
 169       my %rule = ( if_compl   => $if,
 170                    if_pos     => make_regex_pos($if),
 171                    if_neg     => make_regex_neg($if),
 172                    then_compl => $then,
 173                    then_pos   => make_regex_pos($then),
 174                    then_neg   => make_regex_neg($then) );
 175
 176       push (@rules, \%rule);
 177
 178     }
 179   }
 180 }
 181
 182
 183 ##############################################################################
 184 # Generates a RegEx for positive matching of the rules                       #
 185 #                                                                            #
 186 # All lower case characters are replaced with dots, as they are to be        #
 187 # matched by the negativ RegEx. Furthermore the symbol S is replaced by [JN] #
 188 # and I is replaced by [EN] (for use in combined votings when only one       #
 189 # option may be accepted and the others must be rejected or abstained.       #
 190 # As a result we have a regular expression that can be matched against the   #
 191 # received votes.                                                            #
 192 ##############################################################################
 193
 194 sub make_regex_pos {
 195   my $pat = $_[0];
 196
 197   $pat =~ s/[hijens]/./g;
 198   $pat =~ s/S/[JN]/g;
 199   $pat =~ s/H/[EJ]/g;
 200   $pat =~ s/I/[EN]/g;
 201
 202   return $pat;
 203 }
 204
 205
 206 ##############################################################################
 207 # Generates a RegEx for negative matching of the rules                       #
 208 #                                                                            #
 209 # All upper case characters are replaced with dots, as they are to be        #
 210 # matched by the positiv RegEx. If lower case characters are found the       #
 211 # condition is reversed, so that we are able to match votes *not*            #
 212 # corresponding to this rule                                                 #
 213 ##############################################################################
 214
 215 sub make_regex_neg {
 216   my $pat = $_[0];
 217
 218   # upper case characters are replaced with dots
 219   # (are covered by make_regex_pos)
 220   $pat =~ s/[HIJENS]/./g;
 221
 222   # reverse lower case characters
 223   $pat =~ s/j/[NE]/g;
 224   $pat =~ s/n/[JE]/g;
 225   $pat =~ s/e/[JN]/g;
 226   $pat =~ s/s/E/g;
 227   $pat =~ s/h/N/g;
 228   $pat =~ s/i/J/g;
 229
 230   # If the string contained only upper case characters they are now all
 231   # replaced with dots and the RegEx would match everything, i.e. declare
 232   # every vote as invalid. In this case an empty pattern is returned.
 233   $pat =~ s/^\.+$//;
 234
 235   return $pat;
 236 }
 237
 238
 239 ##############################################################################
 240 # Check a voting for rule compliance                                         #
 241 # Parameters: Votes (Reference to Array)                                     #
 242 # Return value: Number of violated rule or 0 (everything OK)                 #
 243 # (Internally rules are saved with indexes starting at 0)                    #
 244 ##############################################################################
 245
 246 sub rule_check {
 247   my ($voteref) = @_;
 248
 249   # Turn array reference into a string
 250   my $vote = join ('', @$voteref);
 251
 252   # For compliance with the rules every rule has to be matched against the
 253   # the vote. If the IF clause matches but not the THEN clause the vote is
 254   # invalid and the rule number is returned.
 255
 256   for (my $n = 0; $n < @rules; $n++) {
 257     return $n+1 if ($vote =~ m/^$rules[$n]->{if_pos}$/ &&
 258                     $vote !~ m/^$rules[$n]->{if_neg}$/ &&
 259                 not($vote =~ m/^$rules[$n]->{then_pos}$/ &&
 260                     $vote !~ m/^$rules[$n]->{then_neg}$/ ));
 261   }
 262
 263   return 0;
 264 }
 265
 266
 267 ##############################################################################
 268 # Print rules in human readable format                                       #
 269 # Parameter: rule number                                                     #
 270 # Return value: rule text                                                    #
 271 ##############################################################################
 272
 273 sub rule_print {
 274   my ($n) = @_;
 275
 276   my $and = UVmessage::get ("RULES_AND");
 277   my $or = UVmessage::get ("RULES_OR");
 278   my $yes = UVmessage::get ("RULES_YES");
 279   my $no = UVmessage::get ("RULES_NO");
 280   my $abst = UVmessage::get ("RULES_ABSTAIN");
 281
 282   $n++;
 283   my $text = UVmessage::get ("RULES_RULE") . " #$n:\n";
 284   $text .= "  " . UVmessage::get ("RULES_IF") . "\n";
 285
 286   my @rule = split (//, $rules[$n-1]->{if_compl});
 287   my $firstrun = 1;
 288   my $fill = "";
 289
 290   for (my $i=0; $i<@rule; $i++) {
 291     my $text1 = "";
 292
 293     if ($rule[$i] eq 'J') {
 294       $fill = "    $and ";
 295       $text1 = UVmessage::get ("RULES_IFCLAUSE", (VOTE=>$yes, GROUP=>$groups[$i]));
 296     } elsif ($rule[$i] eq 'N') {
 297       $fill = "    $and ";
 298       $text1 = UVmessage::get ("RULES_IFCLAUSE", (VOTE=>$no, GROUP=>$groups[$i]));
 299     } elsif ($rule[$i] eq 'E') {
 300       $fill = "    $and ";
 301       $text1 = UVmessage::get ("RULES_IFCLAUSE", (VOTE=>$abst, GROUP=>$groups[$i]));
 302     } elsif ($rule[$i] eq 'S') {
 303       $fill = "    $and ";
 304       $text1 = UVmessage::get ("RULES_IFCLAUSE",
 305                                (VOTE=>"$yes $or $no", GROUP=>$groups[$i]));
 306     } elsif ($rule[$i] eq 'H') {
 307       $fill = "    $and ";
 308       $text1 = UVmessage::get ("RULES_IFCLAUSE",
 309                                (VOTE=>"$abst $or $yes", GROUP=>$groups[$i]));
 310     } elsif ($rule[$i] eq 'I') {
 311       $fill = "    $and ";
 312       $text1 = UVmessage::get ("RULES_IFCLAUSE",
 313                                (VOTE=>"$abst $or $no", GROUP=>$groups[$i]));
 314     } elsif ($rule[$i] eq 'j') {
 315       $fill = "    $or ";
 316       $text1 = UVmessage::get ("RULES_IFCLAUSE", (VOTE=>$yes, GROUP=>$groups[$i]));
 317     } elsif ($rule[$i] eq 'n') {
 318       $fill = "    $or ";
 319       $text1 = UVmessage::get ("RULES_IFCLAUSE", (VOTE=>$no, GROUP=>$groups[$i]));
 320     } elsif ($rule[$i] eq 'e') {
 321       $fill = "    $or ";
 322       $text1 = UVmessage::get ("RULES_IFCLAUSE", (VOTE=>$abst, GROUP=>$groups[$i]));
 323     } elsif ($rule[$i] eq 's') {
 324       $fill = "    $or ";
 325       $text1 = UVmessage::get ("RULES_IFCLAUSE",
 326                                (VOTE=>"$yes $or $no", GROUP=>$groups[$i]));
 327     } elsif ($rule[$i] eq 'h') {
 328       $fill = "    $or ";
 329       $text1 = UVmessage::get ("RULES_IFCLAUSE",
 330                                (VOTE=>"$abst $or $yes", GROUP=>$groups[$i]));
 331     } elsif ($rule[$i] eq 'i') {
 332       $fill = "    $or ";
 333       $text1 = UVmessage::get ("RULES_IFCLAUSE",
 334                                (VOTE=>"$abst $or $no", GROUP=>$groups[$i]));
 335     }
 336
 337     if ($text1) {
 338       if ($firstrun) {
 339         $text .= "    " . $text1 . "\n";
 340         $firstrun = 0;
 341       } else  {
 342         $text .= $fill . $text1 . "\n";
 343       }
 344     }
 345   }
 346
 347   @rule = split (//, $rules[$n-1]->{then_compl});
 348   $text .= "  ..." . UVmessage::get ("RULES_THEN") . "\n";
 349   $firstrun = 1;
 350
 351   for (my $i=0; $i<@rule; $i++) {
 352     my $text1 = "";
 353     if ($rule[$i] eq 'J') {
 354       $fill = "    $and ";
 355       $text1 = UVmessage::get ("RULES_THENCLAUSE", (VOTE=>$yes, GROUP=>$groups[$i]));
 356     } elsif ($rule[$i] eq 'N') {
 357       $fill = "    $and ";
 358       $text1 = UVmessage::get ("RULES_THENCLAUSE", (VOTE=>$no, GROUP=>$groups[$i]));
 359     } elsif ($rule[$i] eq 'E') {
 360       $fill = "    $and ";
 361       $text1 = UVmessage::get ("RULES_THENCLAUSE", (VOTE=>$abst, GROUP=>$groups[$i]));
 362     } elsif ($rule[$i] eq 'S') {
 363       $fill = "    $and ";
 364       $text1 = UVmessage::get ("RULES_THENCLAUSE",
 365                                (VOTE=>"$yes $or $no", GROUP=>$groups[$i]));
 366     } elsif ($rule[$i] eq 'H') {
 367       $fill = "    $and ";
 368       $text1 = UVmessage::get ("RULES_THENCLAUSE",
 369                                (VOTE=>"$abst $or $yes", GROUP=>$groups[$i]));
 370     } elsif ($rule[$i] eq 'I') {
 371       $fill = "    $and ";
 372       $text1 = UVmessage::get ("RULES_THENCLAUSE",
 373                                (VOTE=>"$abst $or $no", GROUP=>$groups[$i]));
 374     } elsif ($rule[$i] eq 'j') {
 375       $fill = "    $or ";
 376       $text1 = UVmessage::get ("RULES_THENCLAUSE", (VOTE=>$yes, GROUP=>$groups[$i]));
 377     } elsif ($rule[$i] eq 'n') {
 378       $fill = "    $or ";
 379       $text1 = UVmessage::get ("RULES_THENCLAUSE", (VOTE=>$no, GROUP=>$groups[$i]));
 380     } elsif ($rule[$i] eq 'e') {
 381       $fill = "    $or ";
 382       $text1 = UVmessage::get ("RULES_THENCLAUSE", (VOTE=>$abst, GROUP=>$groups[$i]));
 383     } elsif ($rule[$i] eq 's') {
 384       $fill = "    $or ";
 385       $text1 = UVmessage::get ("RULES_THENCLAUSE",
 386                                (VOTE=>"$yes $or $no", GROUP=>$groups[$i]));
 387     } elsif ($rule[$i] eq 'h') {
 388       $fill = "    $or ";
 389       $text1 = UVmessage::get ("RULES_THENCLAUSE",
 390                                (VOTE=>"$abst $or $yes", GROUP=>$groups[$i]));
 391     } elsif ($rule[$i] eq 'i') {
 392       $fill = "    $or ";
 393       $text1 = UVmessage::get ("RULES_THENCLAUSE",
 394                                (VOTE=>"$abst $or $no", GROUP=>$groups[$i]));
 395     }
 396
 397     if ($text1) {
 398       if ($firstrun) {
 399         $text .= "    " . $text1 . "\n";
 400         $firstrun = 0;
 401       } else  {
 402         $text .= $fill . $text1 . "\n";
 403       }
 404     }
 405   }
 406   return $text . "\n";
 407 }
 408
 409 1;