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 !~ /^[JjNnEeSsIi\.]+$/) {
 153         die UVmessage::get ("RULES_INVCHARS", (NUM=>$num+1, TYPE=>"if")) . ": $if\n\n";
 154
 155       } elsif ($then !~ /^[JjNnEeSsIi\.]+$/) {
 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/[jens]/./g;
 198   $pat =~ s/S/[JN]/g;
 199   $pat =~ s/I/[EN]/g;
 200
 201   return $pat;
 202 }
 203
 204
 205 ##############################################################################
 206 # Generates a RegEx for negative matching of the rules                       #
 207 #                                                                            #
 208 # All upper case characters are replaced with dots, as they are to be        #
 209 # matched by the positiv RegEx. If lower case characters are found the       #
 210 # condition is reversed, so that we are able to match votes *not*            #
 211 # corresponding to this rule                                                 #
 212 ##############################################################################
 213
 214 sub make_regex_neg {
 215   my $pat = $_[0];
 216
 217   # upper case characters are replaced with dots
 218   # (are covered by make_regex_pos)
 219   $pat =~ s/[JENS]/./g;
 220
 221   # reverse lower case characters
 222   $pat =~ s/j/[NE]/g;
 223   $pat =~ s/n/[JE]/g;
 224   $pat =~ s/e/[JN]/g;
 225   $pat =~ s/s/E/g;
 226   $pat =~ s/i/J/g;
 227
 228   # to be translated:
 229   # Falls keine Kleinbuchstaben vorkamen (es sind nur Punkte uebrig):
 230   # Wenn keine optionalen Forderungen vorhanden sind, wuerde der Regex
 231   # immer matchen und somit die Stimme immer als nicht passend erkannt
 232   # werden. Deswegen wird versucht auf den leeren String zu ueberpruefen,
 233   # was durch die Negation dazu fuehrt, dass die Stimme als passend
 234   # gewertet wird.
 235   $pat =~ s/^\.+$//;
 236
 237   return $pat;
 238 }
 239
 240
 241 ##############################################################################
 242 # Check a voting for rule compliance                                         #
 243 # Parameters: Votes (Reference to Array)                                     #
 244 # Return value: Number of violated rule or 0 (everything OK)                 #
 245 # (Internally rules are saved with indexes starting at 0)                    #
 246 ##############################################################################
 247
 248 sub rule_check {
 249   my ($voteref) = @_;
 250
 251   # Turn array reference into a string
 252   my $vote = join ('', @$voteref);
 253
 254   # For compliance with the rules every rule has to be matched against the
 255   # the vote. If the IF clause matches but not the THEN clause the vote is
 256   # invalid and the rule number is returned.
 257
 258   for (my $n = 0; $n < @rules; $n++) {
 259     return $n+1 if ($vote =~ m/^$rules[$n]->{if_pos}$/ &&
 260                     $vote !~ m/^$rules[$n]->{if_neg}$/ &&
 261                 not($vote =~ m/^$rules[$n]->{then_pos}$/ &&
 262                     $vote !~ m/^$rules[$n]->{then_neg}$/ ));
 263   }
 264
 265   return 0;
 266 }
 267
 268
 269 ##############################################################################
 270 # Print rules in human readable format                                       #
 271 # Parameter: rule number                                                     #
 272 # Return value: rule text                                                    #
 273 ##############################################################################
 274
 275 sub rule_print {
 276   my ($n) = @_;
 277
 278   my $and = UVmessage::get ("RULES_AND");
 279   my $or = UVmessage::get ("RULES_OR");
 280   my $yes = UVmessage::get ("RULES_YES");
 281   my $no = UVmessage::get ("RULES_NO");
 282   my $abst = UVmessage::get ("RULES_ABSTAIN");
 283
 284   $n++;
 285   my $text = UVmessage::get ("RULES_RULE") . " #$n:\n";
 286   $text .= "  " . UVmessage::get ("RULES_IF") . "\n";
 287
 288   my @rule = split (//, $rules[$n-1]->{if_compl});
 289   my $firstrun = 1;
 290   my $fill = "";
 291
 292   for (my $i=0; $i<@rule; $i++) {
 293     my $text1 = "";
 294
 295     if ($rule[$i] eq 'J') {
 296       $fill = "    $and ";
 297       $text1 = UVmessage::get ("RULES_IFCLAUSE", (VOTE=>$yes, GROUP=>$groups[$i]));
 298     } elsif ($rule[$i] eq 'N') {
 299       $fill = "    $and ";
 300       $text1 = UVmessage::get ("RULES_IFCLAUSE", (VOTE=>$no, GROUP=>$groups[$i]));
 301     } elsif ($rule[$i] eq 'E') {
 302       $fill = "    $and ";
 303       $text1 = UVmessage::get ("RULES_IFCLAUSE", (VOTE=>$abst, GROUP=>$groups[$i]));
 304     } elsif ($rule[$i] eq 'S') {
 305       $fill = "    $and ";
 306       $text1 = UVmessage::get ("RULES_IFCLAUSE",
 307                                (VOTE=>"$yes $or $no", GROUP=>$groups[$i]));
 308     } elsif ($rule[$i] eq 'I') {
 309       $fill = "    $and ";
 310       $text1 = UVmessage::get ("RULES_IFCLAUSE",
 311                                (VOTE=>"$abst $or $no", GROUP=>$groups[$i]));
 312     } elsif ($rule[$i] eq 'j') {
 313       $fill = "    $or ";
 314       $text1 = UVmessage::get ("RULES_IFCLAUSE", (VOTE=>$yes, GROUP=>$groups[$i]));
 315     } elsif ($rule[$i] eq 'n') {
 316       $fill = "    $or ";
 317       $text1 = UVmessage::get ("RULES_IFCLAUSE", (VOTE=>$no, GROUP=>$groups[$i]));
 318     } elsif ($rule[$i] eq 'e') {
 319       $fill = "    $or ";
 320       $text1 = UVmessage::get ("RULES_IFCLAUSE", (VOTE=>$abst, GROUP=>$groups[$i]));
 321     } elsif ($rule[$i] eq 's') {
 322       $fill = "    $or ";
 323       $text1 = UVmessage::get ("RULES_IFCLAUSE",
 324                                (VOTE=>"$yes $or $no", GROUP=>$groups[$i]));
 325     } elsif ($rule[$i] eq 'i') {
 326       $fill = "    $or ";
 327       $text1 = UVmessage::get ("RULES_IFCLAUSE",
 328                                (VOTE=>"$abst $or $no", GROUP=>$groups[$i]));
 329     }
 330
 331     if ($text1) {
 332       if ($firstrun) {
 333         $text .= "    " . $text1 . "\n";
 334         $firstrun = 0;
 335       } else  {
 336         $text .= $fill . $text1 . "\n";
 337       }
 338     }
 339   }
 340
 341   @rule = split (//, $rules[$n-1]->{then_compl});
 342   $text .= "  ..." . UVmessage::get ("RULES_THEN") . "\n";
 343   $firstrun = 1;
 344
 345   for (my $i=0; $i<@rule; $i++) {
 346     my $text1 = "";
 347     if ($rule[$i] eq 'J') {
 348       $fill = "    $and ";
 349       $text1 = UVmessage::get ("RULES_THENCLAUSE", (VOTE=>$yes, GROUP=>$groups[$i]));
 350     } elsif ($rule[$i] eq 'N') {
 351       $fill = "    $and ";
 352       $text1 = UVmessage::get ("RULES_THENCLAUSE", (VOTE=>$no, GROUP=>$groups[$i]));
 353     } elsif ($rule[$i] eq 'E') {
 354       $fill = "    $and ";
 355       $text1 = UVmessage::get ("RULES_THENCLAUSE", (VOTE=>$abst, GROUP=>$groups[$i]));
 356     } elsif ($rule[$i] eq 'S') {
 357       $fill = "    $and ";
 358       $text1 = UVmessage::get ("RULES_THENCLAUSE",
 359                                (VOTE=>"$yes $or $no", GROUP=>$groups[$i]));
 360     } elsif ($rule[$i] eq 'I') {
 361       $fill = "    $and ";
 362       $text1 = UVmessage::get ("RULES_THENCLAUSE",
 363                                (VOTE=>"$abst $or $no", GROUP=>$groups[$i]));
 364     } elsif ($rule[$i] eq 'j') {
 365       $fill = "    $or ";
 366       $text1 = UVmessage::get ("RULES_THENCLAUSE", (VOTE=>$yes, GROUP=>$groups[$i]));
 367     } elsif ($rule[$i] eq 'n') {
 368       $fill = "    $or ";
 369       $text1 = UVmessage::get ("RULES_THENCLAUSE", (VOTE=>$no, GROUP=>$groups[$i]));
 370     } elsif ($rule[$i] eq 'e') {
 371       $fill = "    $or ";
 372       $text1 = UVmessage::get ("RULES_THENCLAUSE", (VOTE=>$abst, GROUP=>$groups[$i]));
 373     } elsif ($rule[$i] eq 's') {
 374       $fill = "    $or ";
 375       $text1 = UVmessage::get ("RULES_THENCLAUSE",
 376                                (VOTE=>"$yes $or $no", GROUP=>$groups[$i]));
 377     } elsif ($rule[$i] eq 'i') {
 378       $fill = "    $or ";
 379       $text1 = UVmessage::get ("RULES_THENCLAUSE",
 380                                (VOTE=>"$abst $or $no", GROUP=>$groups[$i]));
 381     }
 382
 383     if ($text1) {
 384       if ($firstrun) {
 385         $text .= "    " . $text1 . "\n";
 386         $firstrun = 0;
 387       } else  {
 388         $text .= $fill . $text1 . "\n";
 389       }
 390     }
 391   }
 392   return $text . "\n";
 393 }
 394
 395 1;