#!/usr/bin/perl use strict; use warnings; $| = 1; # -------------------- Konfiguration ------------------------ # Der folgende Pfad zur Datendatei muss ggf. angepasst werden # Die Datei muss fuer den HTTP-Server schreibbar # sein (z.B. chown www-data poll.dat; chmod 644 poll.dat) my $poll = "/tmp/poll.dat"; # -------------------- Konfiguration ------------------------ # Globale Werte my $numalt = 0; # Anzahl Antwortalternativen my $quest = ''; # Text der Frage my @text = (); # Alternativen-Texte my @voting = (); # Wahlhaeufigkeiten der Alternativen my %FORM = (); # Hash fuer Formulardaten # und los geht's print "Content-type: text/html\n\n"; # Parameter lesen und Datei laden load(); ParseForm(); my $action = $FORM{'submit'}; my $vote = $FORM{'vote'}; # was ist zu tun? if (defined($action)) { # Formular wurde ausgefuellt if (defined($vote)) { # Abstimmung --> Datei aktualisieren, Ergebnisanzeig update(); result(); } else # nur Ergebnisanzeige { result() if ($action =~ /Resultat/); } } else # Aufruf ohne Daten --> Formular zeigen { show_form(); } sub show_form { # Formular generieren my $i; # HTML-Vorspann ausgeben, danach zuerst die Frage und # dann die Antwortalternativen print qq~ Poll

~; # Antworten ausgeben for ($i = 1; $i < $numalt; $i++) { print qq~ ~; } # HTML-Nachspann print qq~
$quest
$text[0]
$text[$i]
~; } sub load { # Konfigurationsdatei einlesen my $i = 0; my $line = ''; open(DATA,'<',$poll) || die("Cannot open $poll for reading: $!"); # Datei fuer Zugriff sperren flock(DATA, 2); # exclusive lock $line = ; chomp($line); ($quest,$numalt) = split(/:/,$line); for ($i = 0; $i < $numalt; $i++) { $line = ; chomp($line); ($text[$i], $voting[$i]) = split(/:/,$line); } flock(DATA, 8); # unlock # Zugriff wieder frei geben close(DATA); } sub update { # Abstimmergebnis aktualisieren my $i = 0; $voting[$vote]++; # update votings # geaenderte Datei komplett neu schreiben open(DATA,">$poll") || die("Cannot open $poll for writing"); flock(DATA, 2); # exclusive lock print DATA $quest . ":" . $numalt . "\n"; for ($i = 0; $i < $numalt; $i++) { print DATA $text[$i]. ':' . $voting[$i] . "\n"; } flock(DATA, 8); # unlock close (DATA); } sub result { # Abstimmergebnis ausgeben my $i = 0; my $ip = 0; my $sum = 0; # Summe my @percent = (); # Prozentsaetze der Antworten # Gesamtsumme ermitteln for ($i = 0; $i < $numalt; $i++) { $sum = $sum + $voting[$i]; } # Prozentualen Anteil der Alternativen errechnen for ($i = 0; $i < $numalt; $i++) { $percent[$i] = 0.00; if ($voting[$i] > 0) { $percent[$i] = sprintf("%5.2f",($voting[$i]*100/$sum)); } } # Ergebnis huebsch ausgeben print qq~ Poll

Vielen Dank für Ihre Teilnahme an der Abstimmung zur Frage
$quest.

~; } sub ParseForm { my ($buffer, @pairs, $pair, $name, $value); # Read in text if ($ENV{'REQUEST_METHOD'} eq "POST") { read(STDIN, $buffer, $ENV{'CONTENT_LENGTH'}); } else { $buffer = $ENV{'QUERY_STRING'}; } @pairs = split(/&/, $buffer); foreach $pair (@pairs) { # Name-Wert-Paare trennen ($name, $value) = split(/=/, $pair); # Leerzeichen wieder einsetzen $value =~ tr/+/ /; # URL-codierte Zeichen (%xx) ersetzen $value =~ s/%([a-fA-F0-9][a-fA-F0-9])/pack("C", hex($1))/eg; # im hash speichern if (defined $FORM{$name}) # vermutlich checkbox { $FORM{$name} = $FORM{$name} . ", " . $value; } else { $FORM{$name} = $value; } } }