EOP
}
##################################################################
# Survey Pages
##################################################################
sub PrintBooth {
my ($config_file) = @_;
my $ip = $ENV{"REMOTE_ADDR"};
my $host = $ENV{"REMOTE_HOST"};
my $type = $config->{"type"};
my %vote2score;
my %ip2score2vote = ReadVotes($config->{"votes"});
my @score = reverse sort {$SCORE2WEIGHT{$a}<=>$SCORE2WEIGHT{$b};}
keys %SCORE2WEIGHT;
if ($ip2score2vote{$ip}) {
print " You have already voted.
\n";
print $cgi->startform( "post", $cgi_url, $CGI::URL_ENCODED),"\n";
print qq( Currently there are no votes. \n";
print " ";
print " Number of Votes ";
print " \n";
print " $type \n";
foreach my $score (@scores) {
print " $score \n";
}
print " score ";
print " \n";
my $index = 0;
foreach my $vote (@votes) {
$index++;
my $total = $vote2total{$vote};
print " ";
print " $index ";
print $vote;
print " ";
foreach my $score (@scores) {
my $freq = $vote2score2freq{$vote}{$score};
$freq = 0 if (!$freq);
print " $freq ";
}
print " $total ";
print " \n";
}
my $num_ips = keys %ip2score2vote;
print " \n";
print " weight \n";
foreach my $score (@scores) {
print " $SCORE2WEIGHT{$score} \n";
}
print " \n";
print " total votes ";
print " ";
print " $num_ips \n";
print "
\n";
print " error: multiple votes \n";
print " found for $vote. Only the first will be used\n";
}
$seen_vote{$vote}++;
}
}
my $ip = $ENV{"REMOTE_ADDR"};
my $votes_file = $config->{"votes"};
my %ip2score2vote = ReadVotes($votes_file);
my $ip_already_found;
if (defined $ip2score2vote{$ip}) {
$ip_already_found = 1;
$ip2score2vote{$ip} = {};
}
foreach my $score (sort {$a<=>$b;} keys %score2vote) {
$ip2score2vote{$ip}{$score} = $score2vote{$score};
}
#$if (defined $ip_already_found) {
my %ip2bin;
foreach my $ip (keys %ip2score2vote) {
my $bin = unpack("N",inet_aton($ip));
$ip2bin{$ip} = $bin;
}
rename $votes_file, $votes_file.".bkup";
open(OUT, ">$votes_file")
|| DieHtml("Unable to open `$votes_file':$!");
flock(OUT, $FLOCK_EX);
foreach my $ip (sort {$ip2bin{$ip}<=>$ip2bin{$ip};} keys
%ip2score2vote) {
foreach my $score (sort {$a<=>$b;} keys %{$ip2score2vote{$ip}}) {
print OUT "$ip:$score $ip2score2vote{$ip}{$score}\n";
}
}
flock(OUT, $FLOCK_UN);
close OUT;
=cut
} else {
open(OUT, ">>$votes_file")
|| DieHtml("Unable to open `$votes_file':$!");
flock(OUT, $FLOCK_EX);
foreach my $score (sort {$a<=>$b;} keys %score2vote) {
if ($score2vote{$score} =~ /[^\s]/) {
print OUT "$ip:$score $score2vote{$score}\n";
}
}
flock(OUT, $FLOCK_UN);
close OUT;
}
=cut
chmod 0664, $votes_file;
chmod 0664, $votes_file.".bkup";
return %ip2score2vote;
}
############################################
sub ReadVotes {
my ($filename) = @_;
unless (-f $filename) {
return;
}
open (IN, "<$filename")
|| DieHtml("Unable to open votes file `$filename':$!");
flock(IN, $FLOCK_SH);
my %ip2score2vote;
my $linenum = 0;
while () {
s/#.*//g;
$linenum++;
if (/([^:]+):(\d+)\s+(.+)/) {
my ($ip, $score, $vote) = ($1, $2, $3);
$vote =~ s/^$USER_DEFINED_STRING//;
$vote =~ s/^\s+//;
$vote =~ s/\s+$//;
$ip2score2vote{$ip}{$score} = $vote;
} else {
chop;
print " parse error `$filename'[$linenum]".$_
." \n";
foreach my $top_vote (@votes) {
print " $top_vote ";
my @votes = reverse sort {
$top_vote2vote2total{$top_vote}{$a}
<=> $top_vote2vote2total{$top_vote}{$b}}
keys %{$top_vote2vote2total{$top_vote}};
shift @votes;
foreach my $vote (@votes) {
print " $vote ";
}
print " \n";
}
print "
\n";
}
sub PrintRelationship {
my %ip2score2vote = @_;
my %vote2score;
my %paths;
my @scores = reverse sort {$SCORE2WEIGHT{$a}<=>$SCORE2WEIGHT{$b};}
keys %SCORE2WEIGHT;
foreach my $ip (keys %ip2score2vote) {
my $top_vote = $ip2score2vote{$ip}{$scores[0]};
if (defined $top_vote) { # && $top_vote =~ /Boo/) {
my $current = \%paths;
foreach my $score (@scores) {
my $vote = $ip2score2vote{$ip}{$score};
unless (defined $vote) {
$vote = "none";
}
unless (defined $current->{$vote}) {
$current->{$vote} = {};
}
$current = $current->{$vote};
$current->{"\0num_votes"}++;
$vote2score{$vote} += $SCORE2WEIGHT{$score};
}
}
}
SetNumChildren(\%paths);
my @col;
CreateRows(0, \@col, \%paths);
PrintRows(\@col);
}
sub SetNumChildren {
my ($paths,$parent, $space) = @_;
my $height;
foreach my $child (keys %{$paths}) {
unless ($child =~ /^\0/) {
$height += SetNumChildren($paths->{$child},$child, $space.".");
}
}
if ($height == 0) {
$height = 1;
}
#print "$space $parent ($height)\n";
foreach my $col (@{$row}) {
print "";
foreach my $values (@{$col}) {
my ($vote, $hieght, $num_votes) = @{$values};
print " $vote ($num_votes) \n";
}
print " ";
}
print "
\n";
}
##################################################################
# Configuration File
##################################################################
sub ProcessConfig {
my ($filename) = @_;
unless (defined $filename) {
DieHtml("There must be a configuration file");
}
$filename =~ s/^\.\.//g;
$filename = "configs/$filename";
open (IN, "<$filename")
|| DieHtml("Unable to open config file `$filename':$!");
my %config;
my $linenum = 0;
while () {
$linenum++;
s/#.*//g;
if (/([^=]+)=(.+)/) {
my ($key, $value) = ($1, $2);
$key =~ y/A-Z/a-z/;
if ($key =~ /url/) {
if ($value =~ /^\s+(\d+)\s+(.*)/) {
my ($index, $value) = ($1, $2);
$config{$key}{$index} = $value;
} else {
print ""
." Unable to parse `$filename'[$linenum] $_"
." Error: @_