Initial checkin of personal version.
[usenet/usevote.git] / UVrules.pm
CommitLineData
ac7e2c54
TH
1# UVrules: Module with rule functions for usevote
2# Used by uvvote.pl, UVconfig.pm
3
4package UVrules;
5
6use strict;
7use vars qw (@ISA @EXPORT $VERSION @rules);
8use UVconfig;
9use UVmessage;
10
11require 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
117sub 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
a384e31e 152 if ($if !~ /^[JjNnEeSsIi\.]+$/) {
ac7e2c54
TH
153 die UVmessage::get ("RULES_INVCHARS", (NUM=>$num+1, TYPE=>"if")) . ": $if\n\n";
154
a384e31e 155 } elsif ($then !~ /^[JjNnEeSsIi\.]+$/) {
ac7e2c54
TH
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
194sub make_regex_pos {
195 my $pat = $_[0];
196
a384e31e 197 $pat =~ s/[jens]/./g;
ac7e2c54 198 $pat =~ s/S/[JN]/g;
ac7e2c54
TH
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
214sub make_regex_neg {
215 my $pat = $_[0];
216
217 # upper case characters are replaced with dots
218 # (are covered by make_regex_pos)
a384e31e 219 $pat =~ s/[JENS]/./g;
ac7e2c54
TH
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;
ac7e2c54
TH
226 $pat =~ s/i/J/g;
227
a384e31e
TH
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.
ac7e2c54
TH
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
248sub 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
275sub 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]));
ac7e2c54
TH
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]));
ac7e2c54
TH
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]));
ac7e2c54
TH
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]));
ac7e2c54
TH
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
3951;
This page took 0.026597 seconds and 4 git commands to generate.