Initial checkin of personal version.
[usenet/usevote.git] / 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;
This page took 0.020018 seconds and 3 git commands to generate.