Add missing options to usevote.tpl.cfg
[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 !~ /^[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;
This page took 0.020252 seconds and 3 git commands to generate.