#
# TWiki WikiClone ($wikiversion has version info)
#
# Copyright (C) 2000-2001 Andrea Sterbini, a.sterbini@flashnet.it
# Copyright (C) 2001 Peter Thoeny, Peter@Thoeny.com
#
# This program is free software; you can redistribute it and/or
# modify it under the terms of the GNU General Public License
# as published by the Free Software Foundation; either version 2
# of the License, or (at your option) any later version.
#
# This program is distributed in the hope that it will be useful,
# but WITHOUT ANY WARRANTY; without even the implied warranty of
# MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
# GNU General Public License for more details, published at
# http://www.gnu.org/copyleft/gpl.html
#
# =========================
#
# This is the default TWiki plugin. Use EmptyPlugin.pm as a template
# for your own plugins; see TWiki.TWikiPlugins for details.
#
# Each plugin is a package that contains the subs:
#
# initPlugin ( $topic, $web, $user, $installWeb )
# commonTagsHandler ( $text, $topic, $web )
# startRenderingHandler( $text, $web )
# outsidePREHandler ( $text )
# insidePREHandler ( $text )
# endRenderingHandler ( $text )
#
# initPlugin is required, all other are optional.
# For increased performance, DISABLE handlers you don't need.
# Original Poll Plugin: Collects form-fill data at the end of the page,
# and allows results to be presented as polls etc.
#
# Modified so that this is a general-purpose form-fill mechanism, that:
# 1. Collects and manages data at the end of the topic.
# 2. Allows this information to be presented as table - with configurable
# row information (i.e which columns etc.) and total information.
# 3. Types of Totals: 1. sum() 2. counts()
# 4. pre-Formfill if 'id=rowid' is given as parameter (or in the topic data.)
# The data is read from appropriate row, and form values are pre-defined.
# 5. The data can be in one topic, and be used in another topic.
#
# TablePlugin will work fine with this.
#
# TODO:
# 1. Access control for pre-FormFill data. Only user who contributed information should be able to view his own information.
# 2. Mechanism to use "ID" independent of user ID. Currently the ID of each
# row is the user ID.
# 3. Mechanism to store attribute names rather than column IDs.
# Current mechanism depends upon ordering of information received by 'poll' command.
# 4. Ability to delete a specific row.
# =========================
package TWiki::Plugins::PollPlugin;
# =========================
use vars qw( $web $topic $user $installWeb $insidePOLLVARS $votes $vWeb $vTopic $selectedRowId $selectedRow);
# =========================
sub initPlugin
{
( $topic, $web, $user, $installWeb ) = @_;
my $cgi = &TWiki::Func::getCgiQuery();
if( $cgi ) {
$selectedRowId = $cgi->param( 'id' );
}
$vWeb=$web;
$vTopic=$topic;
return 1;
}
# =========================
sub commonTagsHandler
{
### my ( $text, $topic, $web ) = @_; # do not uncomment, use $_[0], $_[1]... instead
# print "DefaultPlugin::commonTagsHandler called
";
# $_[0] =~ s/%TOPICLIST%/&handleTopicList("")/geo;
# $_[0] =~ s/%TOPICLIST{([^%}]+)}%/&handleTopicList($1)/geo;
# ??? Need to know what this means here.
my ( $tmp, $tmp1, $votes ) = split /<\!\-\-TWikiPoll\-\->/, $_[0];
$_[0] =~ s/<\!\-\-TWikiPoll\-\->.*//gso ;
$_[0] =~ s/%POLLRESULTS%/&handlePollResults("",$votes)/geo ;
$_[0] =~ s/%POLLRESULTS{(.*)}%/&handlePollResults($1,$votes)/geo ;
$_[0] =~ s/%POLLVOTERS%/&handlePollVoters("",$votes)/geo ;
$_[0] =~ s/%POLLVOTERS{(.*)}%/&handlePollVoters($1,$votes)/geo ;
# do custom extension rule, like for example:
# $_[0] =~ s/%WIKIWEB%/$TWiki::wikiToolName.$web/go;
}
# =========================
sub DISABLEstartRenderingHandler
{
### my ( $text, $web ) = @_; # do not uncomment, use $_[0], $_[1] instead
# print "DefaultPlugin::startRenderingHandler called
";
# This handler is called by getRenderedVersion just before the line loop
}
# =========================
sub outsidePREHandler
{
### my ( $text ) = @_; # do not uncomment, use $_[0] instead
# This handler is called by getRenderedVersion, in loop outside of tag
# This is the place to define customized rendering rules
if ($insidePOLLVARS) {
if ( s/%ENDPOLLVARS%//o ) {
$insidePOLLVARS=0;
} else {
while ( s/\${id}/$selectedRowId/g ) {};
while ( s/\${(\w+)}/$selectedRow->[$1]/g ) {};
}
} elsif( s/%STARTPOLLVARS{(.*)}%//o ) {
my $attributes=$1;
my $aWeb = &TWiki::extractNameValuePair( $attributes, "web" ) || $web;
my $aTopic = &TWiki::extractNameValuePair( $attributes, "topic" ) || $topic;
my $id = &TWiki::extractNameValuePair( $attributes, "id" ) || $selectedRowId;
$selectedRowId=$id;
&populateSelectedRow($id);
# Get ID of the data. If not specified, check out cgi.
$insidePOLLVARS=1;
}
return $_[0];
}
# =========================
sub DISABLEinsidePREHandler
{
### my ( $text ) = @_; # do not uncomment, use $_[0] instead
}
# =========================
sub DISABLEendRenderingHandler
{
### my ( $text ) = @_; # do not uncomment, use $_[0] instead
# print "DefaultPlugin::endRenderingHandler called
";
# This handler is called by getRenderedVersion just after the line loop
}
# Given the ID, Populate the corresponsing row of table.
sub populateSelectedRow
{
my $id = shift;
my $aWeb = shift;
my $aTopic = shift;
my $votes = populateVotesTable($aWeb, $aTopic);
$selectedRow=$votes->{$id};
return ($selectedRow);
}
# Populate the Votes table given the web and topic name.
# $votes, $vWeb and $vTopic are globals.
sub populateVotesTable
{
my $aWeb = shift || $vWeb;
my $aTopic = shift || $vTopic;
if ( ($aWeb eq $vWeb) && ($aTopic eq $vTopic) && defined($votes) )
{
return $votes;
}
# Load the array it afresh
$votes = {};
my $text = &TWiki::Store::readWebTopic( $aWeb, $aTopic ) || "";
my ( $tmp, $tmp1, $votesStr ) = split /<\!\-\-TWikiPoll\-\->/, $text;
$votesStr =~ s/(\n|\r)+/\n/gso;
my @lines = split /\n/, $votesStr;
my ($u, $d, $i, $j, $line);
# keep only last user's vote
foreach $line ( grep { /^\s*\|.*\|\s*$/ } @lines ) {
my @items = ();
($i, $d, $u, @items) = split /\s*\|\s*/, $line;
$votes->{$u} = \@items ;
}
return $votes;
}
# =========================
sub handlePollResults {
my ( $attributes, $votes ) = @_;
my $aexequosep = &TWiki::extractNameValuePair( $attributes, "aexequosep" ) || ' ' ;
my $itemformat = &TWiki::extractNameValuePair( $attributes, "itemformat" ) || '$item' ;
my $lineformat = &TWiki::extractNameValuePair( $attributes, "lineformat" ) || '| $items | $count |' ;
my $limit = scalar &TWiki::extractNameValuePair( $attributes, "limit" ) || "5" ;
my $heading = &TWiki::extractNameValuePair( $attributes, "heading" ) ||
"| *Best $limit results* | *Votes* |" ;
my $aWeb = &TWiki::extractNameValuePair( $attributes, "web" ) || $web;
my $aTopic = &TWiki::extractNameValuePair( $attributes, "topic" ) || $topic;
# VinodKulkarni: Added rows and totals support.
my $tableHeading = &TWiki::extractNameValuePair( $attributes, "tableheading" ) || undef;
my $rowformat = &TWiki::extractNameValuePair( $attributes, "rowformat" ) || undef;
my $totalsformat = &TWiki::extractNameValuePair( $attributes, "totalsformat" ) || undef;
# Basic Work: Read and define array of results.
$votes=populateVotesTable($aWeb, $aTopic);
# Function 1: VinodKulkarni: Create and show a table in format requested.
if ($rowformat || $totalsformat ) {
my $str = $tableHeading; if ($str) { $str .= "\n" };
my $user;
# Prepare totals line: "... $counts($3) ...#
# Supports functions: $counts($column_name), $totals($column_name), ...
# For $counts, $show_only(3, $counts($column_name)) ...
if($totalsformat) {
$sums={};
$occurance={};
# Collect the names of fields for which totals are required.
$sums->{"id"}=0;
while ( $totalsformat =~ /\$sum{\s*\${(\w+)}\s*}/g ) {
$sums->{$1}=0;
}
while ( $totalsformat =~ /\$counts{\s*\${(\w+)}\s*}/g ) {
$occurance->{$1}={};
}
}
while ( ($id, $items_arr) = each %{$votes}) {
if( $rowformat ) {
$s=$rowformat; # can be null
while ( $s =~ s/\${id}/$id/g ) {};
while ( $s =~ s/\${(\w+)}/$items_arr->[$1]/g ) {};
$str .= $s . "\n";
}
$sums->{"id"}++;
if ( $totalsformat ) {
foreach $column (keys %{$sums}) {
$sums->{$column} += $items_arr->[$column];
}
}
if ( $occurance ) {
foreach $column (keys %{$occurance}) {
my $item = $items_arr->[$column];
# Increase its frequency by one.
$occurance->{$column}->{$item}++;
}
}
}
if($totalsformat) {
# Collect the names of fields for which totals are required.
$s=$totalsformat;
while ( $s =~ s/\$sum{\s*\${(\w+)}\s*}/$sums->{$1}/g ) {}
# Print occurances; for now simple, fixed format.
while ( $s =~ s/\$counts{\s*\${(\w+)}\s*}/&genCounts($1, $occurance)/geo ) {}
# How to present occurances? Use formatting again.
# $counts{${2}} - print all occurances of column 2. Choose default format.
# $count{$2, "veg"} - print value of "Veg" occurance in column 2.
# $count{$2, next} - print value of "Veg" occurance in column 2.
# $counts{${2:"$item_name\br"}} - Repeat the string for every item.
$str .= $s . "\n";
}
#return "\n$str\n";
return $str;
}
# End of table functionality
# Function 2: VinodKulkarni: Given ID, define all field values
# NOT IMPLEMENTED YET
# now count votes
my $total = 0;
my %counts = ();
while ( ($u, $i) = each %{$voted}) {
foreach $j ( @{$i} ) {
$counts{$j}++;
$total++;
}
}
# collects all ex-aequo together
my %exequo = ();
while ( ($i, $j) = each %counts) {
my $f = $itemformat || '$item';
$f =~ s/\$item/$i/g;
if ( ! defined( $exequo{$j} ) ) {
my @a = ();
$exequo{$j} = \@a;
}
push @{$exequo{$j}}, ($f);
}
# and finally produce table
$i = 0;
my $str = "$heading\n";
foreach $j ( reverse sort keys %exequo ) {
if ( $i < $limit ) {
$i++;
#my $items = join($aexequosep, @{$exequo{$j}});
my @items = @{$exequo{$j}};
#my $lf = "$lineformat";
my $perc = $j*100/$total;
for my $item (@items) {
#$lf =~ s/\$items/$items/g;
$lf =~ s/\$items/$item/g;
$lf =~ s/\$count/$j/g;
$lf =~ s/\$perc/$perc/g;
$str .= "$lf\n";
}
}
}
return $str;
}
sub genCounts
{
my $column=shift;
my $hash2d=shift;
my $str;
my $hash=$hash2d->{$column};
foreach $instance (keys %{$hash}) {
$str .= "$instance:" . $hash->{$instance} . "
";
}
return $str;
}
# =========================
sub handlePollVoters {
my ( $attributes, $votes ) = @_;
my $lineformat = &TWiki::extractNameValuePair( $attributes, "lineformat" ) || '| $user |' ;
my $aWeb = &TWiki::extractNameValuePair( $attributes, "web" ) || $web;
my $aTopic = &TWiki::extractNameValuePair( $attributes, "topic" ) || $topic;
my $tmp = "";
my $tmp1 = "";
if (! $votes ) {
my $text = &TWiki::Store::readWebTopic( $aWeb, $aTopic ) || "";
( $tmp, $tmp1, $votes ) = split /<\!\-\-TWikiPoll\-\->/, $text;
}
$votes =~ s/(\n|\r)+/\n/gso;
my @lines = split /\n/, $votes;
my %voters = ();
my ($u, $d, $i, $j, $line);
foreach $line ( grep { /^\s*\|.*\|\s*$/ } @lines ) {
my @items = ();
($i, $d, $u, @items) = split /\s*\|\s*/, $line;
$voters{$u} = 1 ;
}
my $heading = &TWiki::extractNameValuePair( $attributes, "heading" ) ||
"| *Voters* |" ;
# and finally produce table
my $str = "$heading\n";
foreach $u ( sort keys %voters ) {
my $s = "$lineformat";
$s =~ s/\$user/$u/g;
$str .= "$s\n";
}
return $str;
}
# =========================
1;