[usenet/usevote.git] / UVrules.pm

# UVrules: Module with rule functions for usevote
# Used by uvvote.pl, UVconfig.pm

package UVrules;
 
use strict;
use vars qw (@ISA @EXPORT $VERSION @rules);
use UVconfig;
use UVmessage;
 
require Exporter;
@ISA = qw(Exporter);
@EXPORT = qw(@rules);
 
# Module version
$VERSION = "0.3"; 

# ---------------------------------------------------------------------
# Erlaeuterung zur Regelpruefung (to be translated)
# ---------------------------------------------------------------------
# Um Stimmen mit multiplen Abstimmungspunkten auf ihre Sinnfaelligkeit 
# pruefen zu koennen, koennen in Usevote verschiedenste Regeln
# fuer solche Pruefungen definiert werden. 
#
# Die Regeln bestehen aus zwei Teilen. Einer IF-Klausel und einer THEN-
# Klausel. Die IF-Klausel bestimmt, ob die Stimme mit der THEN-Klausel
# verglichen werden soll. Passt sie auf diese, ist die Stimme in Ordnung,
# wenn nicht liegt ein Fehler vor.
#
# Ein kleines Beispiel: "IF S.. THEN .SS"
# Wenn beim ersten Punkt mit Ja oder Nein gestimmt wurde, dann muss
# bei den anderen beiden Punkten auch ein Ja oder Nein vorliegen.
#
# Die Stimmabgabe JNE wuerde also gegen die obige Regel verstossen,
# JJN nicht. EEJ wuerde ebenfalls gueltig sein, da die Regel nicht unter
# die IF-Klausel faellt und somit keine Ueberpruefung der THEN-Klausel
# erfolgt.
#
#
# ---------------------------------------------------------------------
# Implementierung
# ---------------------------------------------------------------------
# Um eine moeglichst einfache Ueberpruefung der Stimmen vorzunehmen,
# bietet es sich an, aus den beiden Klauseln regulaere Ausdruecke zu
# generieren. Diese wuerden dann auf die Stimme angewandt werden.
# 
# Bei der Umwandlung in regulaere Audruecke kommt uns die Notation
# der Regeln bereits entgegen. So kann der Punkt als beliebige Stimme
# beibehalten werden. Die grossen Buchstaben bleiben ebenfalls bis
# auf S erhalten, da die zu pruefenden Stimmen aus den Buchstaben
# 'JNE' bestehen.
#
# So muessen wir zur Ueberpruefung von direkten Stimmen nur 'S' in
# eine Klasse mit [JN] und I in eine Klasse mit [EN] umwandeln.
#
# 'J..' => 'J..', 'NNE' => 'NNE', 'S..' => '[JN]..'
#
# Bei den indirekten Stimmabgaben wird es schon schwieriger. Hier 
# muessten alle Moeglichkeiten eines Strings gebaut werden, um zu
# testen ob mindestens eine Version matcht.
#
# '.jjj' => '.(j..|.j.|..j)
#
# Je komplexer die Regeln, um so mehr Moeglichkeiten muessten
# konstruiert werden, um einen geschlossenen regulaeren Ausdruck
# zu erhalten.
#
# Wir koennen den Regex aber auch einfach aufbauen, in dem wir
# nicht alle Faelle betrachten die moeglich sind, sondern nur die
# Faelle die nicht erlaubt sind. 
# 
# D.h. soll an einer Stelle ein Ja stehen, erlauben wir dort
# nur Nein und Enthaltungen. Passt eine Stimme auf diesen Regex,
# kann sie unmoeglich die Vorgabe enthalten.
# 
# 'nnnn' => '[JE][JE][JE][JE]'
#
# Besteht eine Stimme also nur aus Ja und Enthaltung, wissen wir
# das kein einziges Nein enthalten seien kann. Die Stimme passt
# also nicht auf unser Muster.
#
# Tritt hingegen nur ein einziges J auf, passt der regulaere Ausdruck
# nicht mehr, und wir wissen, dass die Stimme die Regel erfuellt.
#
# Wie wir sehen koennen, ist der negative Ausdruck leichter zu
# bilden als der positive. 
#
#
# Da eine Stimme nun sowohl aus direkten, als auch indirekten
# Stimmen bestehen kann (z.B. 'Jnnn..') muessen wir die Stimme
# zerlegen. Wir bilden einen positiven Regex fuer die Grossbuch-
# staben und einen negativen Regex fuer die kleinen.
#
# Passt eine Stimme dann auf den positiven Regex und nicht auf
# den negativen Regex, so entspricht sie der urspruenglichen
# Regel.
#
# Ein Beispiel: 'Sss..' (Der erste Punkt und der zweite oder dritte
# Punkt muessen ein Ja oder Nein sein.)
#
# positiver Regex: '[JN]...'	muss erfuellt werden
# negativer Regex: '.EE.'	darf nicht erfuellt werden
#
# JJNN => positiv matcht => negativ matcht nicht => Regel erfuellt
# ENJE => positiv matcht nicht => Regel nicht erfuellt
# NEEJ => positiv matcht => negativ matcht => Regel nicht erfuellt
#
#
# Mit Hilfe dieser Technik, lassen sich einfach Regex bilden, die
# ebenso einfach ueberprueft werden koennen.


##############################################################################
# Read usevote.rul and check rules for correct syntax                        #
##############################################################################
  
sub read_rulefile {
  @rules = ();

  open (RULES, "<$config{rulefile}")
    or die UVmessage::get("RULES_ERROPENFILE", (FILE => $config{rulefile})) . "\n\n";
 
  while (<RULES>) {
    chomp;
    s/#.*$//;  # delete comments
 
    # does line match correct if-then syntax?
    if (/^\s*if\s+(\S+)\s+then\s+(\S+)\s*$/) {
      my $if   = $1;
      my $then = $2;

      # $num contains the rule's array index
      my $num = @rules;
 
      # check for correct length of condition
      my $errortext;
      if (length($if) < @groups) {
        $errortext = UVmessage::get("RULES_TOOSHORT", (NUM=>$num+1, TYPE=>"if"));
 
      } elsif (length($if) > @groups) {
        $errortext = UVmessage::get("RULES_TOOLONG", (NUM=>$num+1, TYPE=>"if"));
 
      } elsif (length($then) < @groups) {
        $errortext = UVmessage::get("RULES_TOOSHORT", (NUM=>$num+1, TYPE=>"then"));
 
      } elsif (length($then) > @groups) {
        $errortext = UVmessage::get("RULES_TOOLONG", (NUM=>$num+1, TYPE=>"then"));
      }
      die $errortext . ": $_\n\n" if ($errortext);
 
      # check for correct characters in conditions
      if ($if !~ /^[JjNnEeSsHhIi\.]+$/) {
        die UVmessage::get ("RULES_INVCHARS", (NUM=>$num+1, TYPE=>"if")) . ": $if\n\n";

      } elsif ($then !~ /^[JjNnEeSsHhIi\.]+$/) {
        die UVmessage::get ("RULES_INVCHARS",
                            (NUM=>$num+1, TYPE=>"if")) . ": $then\n\n";
      }
 
      # Zur Speicherung der Regeln (to be translated):
      # - if_compl und then_compl sind die kompletten Bedingungen als Strings,
      #   werden fuer die Sprachausgabe der Regeln benoetigt
      # - zusaetzlich werden der if- und then-Teil fuer die einfachere
      #   Verarbeitung in zwei Teile gesplittet: Eine Positiv-Regex, die auf
      #   die Grossbuchstaben (explizite Forderungen, UND-Verknuepfungen)
      #   matched, und eine Negativ-Regex, die bei den Kleinbuchstaben
      #   (optionale Felder, ODER-Verknuepfungen) verwendet wird.

      my %rule = ( if_compl   => $if,
                   if_pos     => make_regex_pos($if),
                   if_neg     => make_regex_neg($if),
                   then_compl => $then,
                   then_pos   => make_regex_pos($then),
                   then_neg   => make_regex_neg($then) );
 
      push (@rules, \%rule);

    }
  }
}
 

##############################################################################
# Generates a RegEx for positive matching of the rules                       #
#                                                                            #
# All lower case characters are replaced with dots, as they are to be        #
# matched by the negativ RegEx. Furthermore the symbol S is replaced by [JN] #
# and I is replaced by [EN] (for use in combined votings when only one       #
# option may be accepted and the others must be rejected or abstained.       #
# As a result we have a regular expression that can be matched against the   #
# received votes.                                                            #
##############################################################################
  
sub make_regex_pos {
  my $pat = $_[0];
 
  $pat =~ s/[hijens]/./g;
  $pat =~ s/S/[JN]/g;
  $pat =~ s/H/[EJ]/g;
  $pat =~ s/I/[EN]/g;
 
  return $pat;
}
 

##############################################################################
# Generates a RegEx for negative matching of the rules                       #
#                                                                            #
# All upper case characters are replaced with dots, as they are to be        #
# matched by the positiv RegEx. If lower case characters are found the       #
# condition is reversed, so that we are able to match votes *not*            #
# corresponding to this rule                                                 #
##############################################################################
  
sub make_regex_neg {
  my $pat = $_[0];
 
  # upper case characters are replaced with dots
  # (are covered by make_regex_pos)
  $pat =~ s/[HIJENS]/./g;
 
  # reverse lower case characters
  $pat =~ s/j/[NE]/g;
  $pat =~ s/n/[JE]/g;
  $pat =~ s/e/[JN]/g;
  $pat =~ s/s/E/g;
  $pat =~ s/h/N/g;
  $pat =~ s/i/J/g;
 
  # If the string contained only upper case characters they are now all
  # replaced with dots and the RegEx would match everything, i.e. declare
  # every vote as invalid. In this case an empty pattern is returned.
  $pat =~ s/^\.+$//;
 
  return $pat;
}
 

##############################################################################
# Check a voting for rule compliance                                         #
# Parameters: Votes (Reference to Array)                                     #
# Return value: Number of violated rule or 0 (everything OK)                 #
# (Internally rules are saved with indexes starting at 0)                    #
##############################################################################

sub rule_check {
  my ($voteref) = @_;

  # Turn array reference into a string
  my $vote = join ('', @$voteref);

  # For compliance with the rules every rule has to be matched against the
  # the vote. If the IF clause matches but not the THEN clause the vote is
  # invalid and the rule number is returned.

  for (my $n = 0; $n < @rules; $n++) {
    return $n+1 if ($vote =~ m/^$rules[$n]->{if_pos}$/ &&
                    $vote !~ m/^$rules[$n]->{if_neg}$/ &&
                not($vote =~ m/^$rules[$n]->{then_pos}$/ &&
                    $vote !~ m/^$rules[$n]->{then_neg}$/ ));
  }
 
  return 0;
} 


##############################################################################
# Print rules in human readable format                                       #
# Parameter: rule number                                                     #
# Return value: rule text                                                    #
##############################################################################
 
sub rule_print {
  my ($n) = @_;

  my $and = UVmessage::get ("RULES_AND");
  my $or = UVmessage::get ("RULES_OR");
  my $yes = UVmessage::get ("RULES_YES");
  my $no = UVmessage::get ("RULES_NO");
  my $abst = UVmessage::get ("RULES_ABSTAIN");

  $n++;
  my $text = UVmessage::get ("RULES_RULE") . " #$n:\n";
  $text .= "  " . UVmessage::get ("RULES_IF") . "\n";
 
  my @rule = split (//, $rules[$n-1]->{if_compl});
  my $firstrun = 1;
  my $fill = "";
 
  for (my $i=0; $i<@rule; $i++) {
    my $text1 = "";

    if ($rule[$i] eq 'J') {
      $fill = "    $and ";
      $text1 = UVmessage::get ("RULES_IFCLAUSE", (VOTE=>$yes, GROUP=>$groups[$i]));
    } elsif ($rule[$i] eq 'N') {
      $fill = "    $and ";
      $text1 = UVmessage::get ("RULES_IFCLAUSE", (VOTE=>$no, GROUP=>$groups[$i]));
    } elsif ($rule[$i] eq 'E') {
      $fill = "    $and ";
      $text1 = UVmessage::get ("RULES_IFCLAUSE", (VOTE=>$abst, GROUP=>$groups[$i]));
    } elsif ($rule[$i] eq 'S') {
      $fill = "    $and ";
      $text1 = UVmessage::get ("RULES_IFCLAUSE",
                               (VOTE=>"$yes $or $no", GROUP=>$groups[$i]));
    } elsif ($rule[$i] eq 'H') {
      $fill = "    $and ";
      $text1 = UVmessage::get ("RULES_IFCLAUSE",
                               (VOTE=>"$abst $or $yes", GROUP=>$groups[$i]));
    } elsif ($rule[$i] eq 'I') {
      $fill = "    $and ";
      $text1 = UVmessage::get ("RULES_IFCLAUSE",
                               (VOTE=>"$abst $or $no", GROUP=>$groups[$i]));
    } elsif ($rule[$i] eq 'j') {
      $fill = "    $or ";
      $text1 = UVmessage::get ("RULES_IFCLAUSE", (VOTE=>$yes, GROUP=>$groups[$i]));
    } elsif ($rule[$i] eq 'n') {
      $fill = "    $or ";
      $text1 = UVmessage::get ("RULES_IFCLAUSE", (VOTE=>$no, GROUP=>$groups[$i]));
    } elsif ($rule[$i] eq 'e') {
      $fill = "    $or ";
      $text1 = UVmessage::get ("RULES_IFCLAUSE", (VOTE=>$abst, GROUP=>$groups[$i]));
    } elsif ($rule[$i] eq 's') {
      $fill = "    $or ";
      $text1 = UVmessage::get ("RULES_IFCLAUSE",
                               (VOTE=>"$yes $or $no", GROUP=>$groups[$i]));
    } elsif ($rule[$i] eq 'h') {
      $fill = "    $or ";
      $text1 = UVmessage::get ("RULES_IFCLAUSE",
                               (VOTE=>"$abst $or $yes", GROUP=>$groups[$i]));
    } elsif ($rule[$i] eq 'i') {
      $fill = "    $or ";
      $text1 = UVmessage::get ("RULES_IFCLAUSE",
                               (VOTE=>"$abst $or $no", GROUP=>$groups[$i]));
    }
 
    if ($text1) {
      if ($firstrun) {
        $text .= "    " . $text1 . "\n";
        $firstrun = 0;
      } else  {
        $text .= $fill . $text1 . "\n";
      }
    }
  }
 
  @rule = split (//, $rules[$n-1]->{then_compl});
  $text .= "  ..." . UVmessage::get ("RULES_THEN") . "\n";
  $firstrun = 1;
 
  for (my $i=0; $i<@rule; $i++) {
    my $text1 = "";
    if ($rule[$i] eq 'J') {
      $fill = "    $and ";
      $text1 = UVmessage::get ("RULES_THENCLAUSE", (VOTE=>$yes, GROUP=>$groups[$i]));
    } elsif ($rule[$i] eq 'N') {
      $fill = "    $and ";
      $text1 = UVmessage::get ("RULES_THENCLAUSE", (VOTE=>$no, GROUP=>$groups[$i]));
    } elsif ($rule[$i] eq 'E') {
      $fill = "    $and ";
      $text1 = UVmessage::get ("RULES_THENCLAUSE", (VOTE=>$abst, GROUP=>$groups[$i]));
    } elsif ($rule[$i] eq 'S') {
      $fill = "    $and ";
      $text1 = UVmessage::get ("RULES_THENCLAUSE",
                               (VOTE=>"$yes $or $no", GROUP=>$groups[$i]));
    } elsif ($rule[$i] eq 'H') {
      $fill = "    $and ";
      $text1 = UVmessage::get ("RULES_THENCLAUSE",
                               (VOTE=>"$abst $or $yes", GROUP=>$groups[$i]));
    } elsif ($rule[$i] eq 'I') {
      $fill = "    $and ";
      $text1 = UVmessage::get ("RULES_THENCLAUSE",
                               (VOTE=>"$abst $or $no", GROUP=>$groups[$i]));
    } elsif ($rule[$i] eq 'j') {
      $fill = "    $or ";
      $text1 = UVmessage::get ("RULES_THENCLAUSE", (VOTE=>$yes, GROUP=>$groups[$i]));
    } elsif ($rule[$i] eq 'n') {
      $fill = "    $or ";
      $text1 = UVmessage::get ("RULES_THENCLAUSE", (VOTE=>$no, GROUP=>$groups[$i]));
    } elsif ($rule[$i] eq 'e') {
      $fill = "    $or ";
      $text1 = UVmessage::get ("RULES_THENCLAUSE", (VOTE=>$abst, GROUP=>$groups[$i]));
    } elsif ($rule[$i] eq 's') {
      $fill = "    $or ";
      $text1 = UVmessage::get ("RULES_THENCLAUSE",
                               (VOTE=>"$yes $or $no", GROUP=>$groups[$i]));
    } elsif ($rule[$i] eq 'h') {
      $fill = "    $or ";
      $text1 = UVmessage::get ("RULES_THENCLAUSE",
                               (VOTE=>"$abst $or $yes", GROUP=>$groups[$i]));
    } elsif ($rule[$i] eq 'i') {
      $fill = "    $or ";
      $text1 = UVmessage::get ("RULES_THENCLAUSE",
                               (VOTE=>"$abst $or $no", GROUP=>$groups[$i]));
    }
 
    if ($text1) {
      if ($firstrun) {
        $text .= "    " . $text1 . "\n";
        $firstrun = 0;
      } else  {
        $text .= $fill . $text1 . "\n";
      }
    }
  }
  return $text . "\n";
}

1;
Commit	Line	Data
ac7e2c54 TH	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 (/^\sif\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
b00b7d6d	152	if ($if !~ /^[JjNnEeSsHhIi\.]+$/) {
ac7e2c54 TH	153	die UVmessage::get ("RULES_INVCHARS", (NUM=>$num+1, TYPE=>"if")) . ": $if\n\n";
ac7e2c54 TH	154
b00b7d6d	155	} elsif ($then !~ /^[JjNnEeSsHhIi\.]+$/) {
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
	194	sub make_regex_pos {
	195	my $pat = $_[0];
	196
b00b7d6d	197	$pat =~ s/[hijens]/./g;
ac7e2c54	198	$pat =~ s/S/[JN]/g;
b00b7d6d	199	$pat =~ s/H/[EJ]/g;
ac7e2c54 TH	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)
b00b7d6d	220	$pat =~ s/[HIJENS]/./g;
ac7e2c54 TH	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;
b00b7d6d	227	$pat =~ s/h/N/g;
ac7e2c54 TH	228	$pat =~ s/i/J/g;
ac7e2c54 TH	229
b00b7d6d TH	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.
ac7e2c54 TH	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]));
b00b7d6d TH	306	} elsif ($rule[$i] eq 'H') {
	307	$fill = " $and ";
	308	$text1 = UVmessage::get ("RULES_IFCLAUSE",
	309	(VOTE=>"$abst $or $yes", GROUP=>$groups[$i]));
ac7e2c54 TH	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]));
b00b7d6d TH	327	} elsif ($rule[$i] eq 'h') {
	328	$fill = " $or ";
	329	$text1 = UVmessage::get ("RULES_IFCLAUSE",
	330	(VOTE=>"$abst $or $yes", GROUP=>$groups[$i]));
ac7e2c54 TH	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]));
b00b7d6d TH	366	} elsif ($rule[$i] eq 'H') {
	367	$fill = " $and ";
	368	$text1 = UVmessage::get ("RULES_THENCLAUSE",
	369	(VOTE=>"$abst $or $yes", GROUP=>$groups[$i]));
ac7e2c54 TH	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]));
b00b7d6d TH	387	} elsif ($rule[$i] eq 'h') {
	388	$fill = " $or ";
	389	$text1 = UVmessage::get ("RULES_THENCLAUSE",
	390	(VOTE=>"$abst $or $yes", GROUP=>$groups[$i]));
ac7e2c54 TH	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;