=================================================================== RCS file: lib/TWiki/Plugins/VotePlugin/Core.pm,v retrieving revision 1.1 diff -u -r1.1 lib/TWiki/Plugins/VotePlugin/Core.pm --- lib/TWiki/Plugins/VotePlugin/Core.pm 2006/12/14 11:15:04 1.1 +++ lib/TWiki/Plugins/VotePlugin/Core.pm 2006/12/14 18:19:32 @@ -31,6 +31,20 @@ } ############################################################################### +# Stole this from TWiki.pm. Should be in Func.pm +sub isTrue { + my( $value, $default ) = @_; + + $default ||= 0; + + return $default unless defined( $value ); + + $value =~ s/^\s*(.*?)\s*$/$1/gi; + $value =~ s/off//gi; + $value =~ s/no//gi; + return ( $value ) ? 1 : 0; +} + sub handleVote { my ($web, $topic, $args) = @_; @@ -43,6 +57,8 @@ my $theColor = &TWiki::Func::extractNameValuePair($args, 'color') || ''; my $theBgColor = &TWiki::Func::extractNameValuePair($args, 'bgcolor') || ''; my $theLimit = &TWiki::Func::extractNameValuePair($args, 'limit') || '-1'; + my $theFreq = &TWiki::Func::extractNameValuePair($args, 'freq') || 'once'; + my $isAnon = isTrue(&TWiki::Func::extractNameValuePair($args, 'anon') || 'on'); my @theSelects = (); my @theOptions = (); @@ -85,6 +101,8 @@ $result .= "
\n"; $result .= "\n"; + $result .= "\n"; + $result .= "\n"; $result .= "\n"; my %selectOptions; @@ -153,8 +171,17 @@ close VOTES; } + my $showVoters = ($theStyle =~ /voters/) && (! $isAnon); + my $showList = ($theStyle =~ /list/) && (! $isAnon); + my $showBar = ($theStyle =~ /bar/); + my $showPerc = ($theStyle =~ /perc/); + my $showTotal = ($theStyle =~ /total/); + my $showSum = ($theStyle =~ /sum/); + # collect statistics my %keyValueFreq; + my %keyValueVoters; + my %voterValue; my %totalVotes; foreach my $voter (keys %votes) { foreach my $key (keys %{$votes{$voter}}) { @@ -164,6 +191,9 @@ # count frequency of a key $keyValueFreq{$key}{$value}++; + # create voterlist if wanted + $keyValueVoters{$key}{$value}.=" $voter" if $showVoters; + # count nr votes for a key $totalVotes{$key}++; } @@ -182,7 +212,11 @@ } else { $result .= "|||\n"; } - $result .= "| *$key* || \n"; + $result .= "| *$key* ||"; + if ($showVoters) { + $result .= " *Who* |"; + } + $result .= "\n"; $n = $theLimit; foreach my $value (sort {$keyValueFreq{$key}{$b} <=> $keyValueFreq{$key}{$a}} keys %{$keyValueFreq{$key}}) { last if $n == 0; @@ -190,7 +224,7 @@ $result .= "| $value | "; my $freq = $keyValueFreq{$key}{$value}; my $perc = int(1000 * $freq / $totalVotes{$key}) / 10; - if ($theStyle =~ /bar/) { + if ($showBar) { $result .= '
' . '
'; - if ($theStyle =~ /perc/) { + if ($showPerc) { $result .= "$perc\%"; if ($theStyle =~ /total/) { $result .= " ($freq)"; } - } elsif ($theStyle =~ /total/) { + } elsif ($showTotal) { $result .= "$freq"; } else { $result .= ' '; } $result .= '
'; - } elsif ($theStyle =~ /perc/) { + } elsif ($showPerc) { $result .= $perc . '%'; - if ($theStyle =~ /total/) { + if ($showTotal) { $result .= " ($freq)"; } } else { $result .= $freq; } + if ($showVoters) { + $result .= " |$keyValueVoters{$key}{$value}"; + } $result .= " |\n"; } - if ($theStyle =~ /sum/) { - $result .= "|||\n"; - $result .= "| $totalVotes{$key} votes ||\n"; + if ($showSum) { + if ($showVoters) { + $result .= "||||\n"; + $result .= "| $totalVotes{$key} votes |||\n"; + } else { + $result .= "|||\n"; + $result .= "| $totalVotes{$key} votes ||\n"; + } + } + if ($showList) { + $result .= "\n*List of votes*\n| *Who* | *What* |\n"; + foreach my $voter (keys %votes) { + $result .= "| $voter |"; + foreach my $key (keys %{$votes{$voter}}) { + my $value = $votes{$voter}{$key}; + # SMELL need to encode value in html-safe form + $result .= " $value |"; + } + $result .= "\n"; + } } } $result .= "\n"; @@ -249,7 +303,17 @@ $formData->{id} = "" if ! $formData->{id}; $formData->{id} = &securityFilter($formData->{id}); + # SMELL this function should re-parse the topic to see if the poll exists + # and to extract the parameters from there + my $theFreq = $formData->{freq}; + my $isAnon = ($formData->{anon} != 0); + # create the attachment directory for this topic + # SMELL this should be handled by the store subsystem! + # see TWiki:Codev.RecommendedStorageOfPluginData + # SMELL this setup means anybody can attach a set of votes, no? + # SMELL this setup means that if you don't have a .htaccess file, + # anybody can read the votes file my $attachPath = &TWiki::Func::getPubDir() . "/$web/$topic"; my $votesFile = &getVotesFile($web, $topic, $formData->{id}); if(-e $attachPath) { @@ -270,14 +334,27 @@ if ($debug) { $host = int(rand(100)); # for testing } else { - $host = md5_base64("$ENV{REMOTE_ADDR}$user$date"); + if ($theFreq eq 'once') { + if ($isAnon) { + $host = md5_base64("$user"); + } else { + $host = $user; + } + } else { + # REMOTE_ADDR lets user vote once per IP, but it's slightly more anonymous + if ($isAnon) { + $host = md5_base64("$ENV{REMOTE_ADDR}$user$date"); + } else { + $host = "$user $date"; + } + } } # write the votes print VOTES "$date|$host"; &writeDebug("keys=" . join(",", keys %{$formData})); foreach my $key (keys %{$formData}) { - next if $key eq "id"; + next if $key eq "id" or $key eq "anon" or $key eq "freq"; &writeDebug("$key=$formData->{$key}"); print VOTES "|$key=$formData->{$key}" } =================================================================== RCS file: data/TWiki/VotePlugin.txt,v retrieving revision 1.1 diff -u -r1.1 data/TWiki/VotePlugin.txt --- data/TWiki/VotePlugin.txt 2006/12/14 18:12:02 1.1 +++ data/TWiki/VotePlugin.txt 2006/12/14 18:14:06 @@ -1,4 +1,4 @@ - +%META:TOPICINFO{author="wmertens" date="1166120046" format="1.1" reprev="1.2" version="1.2"}%