2006-11-26 20:46:11 +01:00
|
|
|
#!/usr/bin/perl
|
|
|
|
package IkiWiki::Plugin::poll;
|
|
|
|
|
|
|
|
use warnings;
|
|
|
|
use strict;
|
2008-12-23 22:34:19 +01:00
|
|
|
use IkiWiki 3.00;
|
Fixes for behavior changes in perl 5.10's CGI
Something has changed in CGI.pm in perl 5.10. It used to not care
if STDIN was opened using :utf8, but now it'll mis-encode utf-8 values
when used that way by ikiwiki. Now I have to binmode(STDIN) before
instantiating the CGI object.
In 57bba4dac132a06729eeec809f5e1a5adf829806, I changed from decoding
CGI::Formbuilder fields to utf-8, to decoding cgi parameters before setting
up the form object. As of perl 5.10, that approach no longer has any effect
(reason unknown). To get correctly encoded values in FormBuilder forms,
they must once again be decoded after the form is set up.
As noted in 57bba4da, this can cause one set of problems for
formbuilder_setup hooks if decode_form_utf8 is called before the hooks, and
a different set if it's called after. To avoid both sets of problems, call
it both before and after. (Only remaining problem is the sheer ugliness and
inefficiency of that..)
I think that these changes will also work with older perl versions, but I
haven't checked.
Also, in the case of the poll plugin, the cgi parameter needs to be
explcitly decoded before it is used to handle utf-8 values. (This may have
always been broken, not sure if it's related to perl 5.10 or not.)
2008-05-13 02:40:59 +02:00
|
|
|
use Encode;
|
2006-11-26 20:46:11 +01:00
|
|
|
|
2008-12-17 21:22:16 +01:00
|
|
|
sub import {
|
2008-08-03 23:20:21 +02:00
|
|
|
hook(type => "getsetup", id => "poll", call => \&getsetup);
|
2006-11-26 20:46:11 +01:00
|
|
|
hook(type => "preprocess", id => "poll", call => \&preprocess);
|
2008-02-03 06:26:00 +01:00
|
|
|
hook(type => "sessioncgi", id => "poll", call => \&sessioncgi);
|
2008-12-17 21:22:16 +01:00
|
|
|
}
|
2006-11-26 20:46:11 +01:00
|
|
|
|
2008-12-17 21:22:16 +01:00
|
|
|
sub getsetup () {
|
2008-08-03 23:20:21 +02:00
|
|
|
return
|
|
|
|
plugin => {
|
|
|
|
safe => 1,
|
|
|
|
rebuild => undef,
|
2010-02-12 12:35:52 +01:00
|
|
|
section => "widget",
|
2008-08-03 23:20:21 +02:00
|
|
|
},
|
2008-12-17 21:22:16 +01:00
|
|
|
}
|
2008-08-03 23:20:21 +02:00
|
|
|
|
2006-11-26 20:46:11 +01:00
|
|
|
my %pagenum;
|
2008-12-17 21:22:16 +01:00
|
|
|
sub preprocess (@) {
|
2006-11-26 20:46:11 +01:00
|
|
|
my %params=(open => "yes", total => "yes", percent => "yes", @_);
|
|
|
|
|
2008-08-12 21:48:44 +02:00
|
|
|
my $open=IkiWiki::yesno($params{open});
|
2008-07-12 18:01:08 +02:00
|
|
|
my $showtotal=IkiWiki::yesno($params{total});
|
|
|
|
my $showpercent=IkiWiki::yesno($params{percent});
|
2006-11-26 20:46:11 +01:00
|
|
|
$pagenum{$params{page}}++;
|
|
|
|
|
|
|
|
my %choices;
|
|
|
|
my @choices;
|
|
|
|
my $total=0;
|
|
|
|
while (@_) {
|
|
|
|
my $key=shift;
|
|
|
|
my $value=shift;
|
|
|
|
|
|
|
|
next unless $key =~ /^\d+/;
|
|
|
|
|
|
|
|
my $num=$key;
|
|
|
|
$key=shift;
|
|
|
|
$value=shift;
|
|
|
|
|
|
|
|
$choices{$key}=$num;
|
|
|
|
push @choices, $key;
|
|
|
|
$total+=$num;
|
|
|
|
}
|
|
|
|
|
|
|
|
my $ret="";
|
|
|
|
foreach my $choice (@choices) {
|
2006-12-14 20:04:42 +01:00
|
|
|
if ($open && exists $config{cgiurl}) {
|
2006-12-18 17:11:51 +01:00
|
|
|
# use POST to avoid robots
|
2010-11-23 01:12:17 +01:00
|
|
|
$ret.="<form method=\"POST\" action=\"".IkiWiki::cgiurl()."\">\n";
|
2006-12-14 20:04:42 +01:00
|
|
|
}
|
2006-11-26 21:23:23 +01:00
|
|
|
my $percent=$total > 0 ? int($choices{$choice} / $total * 100) : 0;
|
2006-12-14 20:04:42 +01:00
|
|
|
$ret.="<p>\n";
|
2006-11-26 21:56:46 +01:00
|
|
|
if ($showpercent) {
|
2006-12-14 20:04:42 +01:00
|
|
|
$ret.="$choice ($percent%)\n";
|
2006-11-26 20:46:11 +01:00
|
|
|
}
|
|
|
|
else {
|
2006-12-14 20:04:42 +01:00
|
|
|
$ret.="$choice ($choices{$choice})\n";
|
|
|
|
}
|
|
|
|
if ($open && exists $config{cgiurl}) {
|
|
|
|
$ret.="<input type=\"hidden\" name=\"do\" value=\"poll\" />\n";
|
|
|
|
$ret.="<input type=\"hidden\" name=\"num\" value=\"$pagenum{$params{page}}\" />\n";
|
|
|
|
$ret.="<input type=\"hidden\" name=\"page\" value=\"$params{page}\" />\n";
|
|
|
|
$ret.="<input type=\"hidden\" name=\"choice\" value=\"$choice\" />\n";
|
2006-12-29 05:38:40 +01:00
|
|
|
$ret.="<input type=\"submit\" value=\"".gettext("vote")."\" />\n";
|
2006-11-26 20:46:11 +01:00
|
|
|
}
|
2006-12-14 20:04:42 +01:00
|
|
|
$ret.="</p>\n<hr class=poll align=left width=\"$percent%\"/>\n";
|
2006-11-26 20:46:11 +01:00
|
|
|
if ($open && exists $config{cgiurl}) {
|
2006-12-14 20:04:42 +01:00
|
|
|
$ret.="</form>\n";
|
2006-11-26 20:46:11 +01:00
|
|
|
}
|
|
|
|
}
|
|
|
|
if ($showtotal) {
|
2006-12-29 05:38:40 +01:00
|
|
|
$ret.="<span>".gettext("Total votes:")." $total</span>\n";
|
2006-11-26 20:46:11 +01:00
|
|
|
}
|
|
|
|
return "<div class=poll>$ret</div>";
|
2008-12-17 21:22:16 +01:00
|
|
|
}
|
2006-11-26 20:46:11 +01:00
|
|
|
|
2008-12-17 21:22:16 +01:00
|
|
|
sub sessioncgi ($$) {
|
2006-11-26 20:46:11 +01:00
|
|
|
my $cgi=shift;
|
2008-02-03 06:26:00 +01:00
|
|
|
my $session=shift;
|
2006-11-26 20:46:11 +01:00
|
|
|
if (defined $cgi->param('do') && $cgi->param('do') eq "poll") {
|
Fixes for behavior changes in perl 5.10's CGI
Something has changed in CGI.pm in perl 5.10. It used to not care
if STDIN was opened using :utf8, but now it'll mis-encode utf-8 values
when used that way by ikiwiki. Now I have to binmode(STDIN) before
instantiating the CGI object.
In 57bba4dac132a06729eeec809f5e1a5adf829806, I changed from decoding
CGI::Formbuilder fields to utf-8, to decoding cgi parameters before setting
up the form object. As of perl 5.10, that approach no longer has any effect
(reason unknown). To get correctly encoded values in FormBuilder forms,
they must once again be decoded after the form is set up.
As noted in 57bba4da, this can cause one set of problems for
formbuilder_setup hooks if decode_form_utf8 is called before the hooks, and
a different set if it's called after. To avoid both sets of problems, call
it both before and after. (Only remaining problem is the sheer ugliness and
inefficiency of that..)
I think that these changes will also work with older perl versions, but I
haven't checked.
Also, in the case of the poll plugin, the cgi parameter needs to be
explcitly decoded before it is used to handle utf-8 values. (This may have
always been broken, not sure if it's related to perl 5.10 or not.)
2008-05-13 02:40:59 +02:00
|
|
|
my $choice=decode_utf8($cgi->param('choice'));
|
2006-11-26 20:46:11 +01:00
|
|
|
if (! defined $choice) {
|
|
|
|
error("no choice specified");
|
|
|
|
}
|
|
|
|
my $num=$cgi->param('num');
|
|
|
|
if (! defined $num) {
|
|
|
|
error("no num specified");
|
|
|
|
}
|
|
|
|
my $page=IkiWiki::possibly_foolish_untaint($cgi->param('page'));
|
|
|
|
if (! defined $page || ! exists $pagesources{$page}) {
|
|
|
|
error("bad page name");
|
|
|
|
}
|
|
|
|
|
|
|
|
# Did they vote before? If so, let them change their vote,
|
|
|
|
# and check for dups.
|
|
|
|
my $choice_param="poll_choice_${page}_$num";
|
|
|
|
my $oldchoice=$session->param($choice_param);
|
|
|
|
if (defined $oldchoice && $oldchoice eq $choice) {
|
|
|
|
# Same vote; no-op.
|
2010-11-29 20:07:26 +01:00
|
|
|
IkiWiki::redirect($cgi, urlto($page));
|
2006-11-26 21:50:46 +01:00
|
|
|
exit;
|
2006-11-26 20:46:11 +01:00
|
|
|
}
|
|
|
|
|
2008-02-05 22:14:38 +01:00
|
|
|
my $prefix=$config{prefix_directives} ? "!poll" : "poll";
|
|
|
|
|
2006-11-26 20:46:11 +01:00
|
|
|
my $content=readfile(srcfile($pagesources{$page}));
|
|
|
|
# Now parse the content, find the right poll,
|
|
|
|
# and find the choice within it, and increment its number.
|
|
|
|
# If they voted before, decrement that one.
|
|
|
|
my $edit=sub {
|
|
|
|
my $escape=shift;
|
|
|
|
my $params=shift;
|
2008-02-05 22:14:38 +01:00
|
|
|
return "\\[[$prefix $params]]" if $escape;
|
2006-11-26 21:50:46 +01:00
|
|
|
if (--$num == 0) {
|
|
|
|
$params=~s/(^|\s+)(\d+)\s+"?\Q$choice\E"?(\s+|$)/$1.($2+1)." \"$choice\"".$3/se;
|
|
|
|
if (defined $oldchoice) {
|
2006-11-26 21:53:29 +01:00
|
|
|
$params=~s/(^|\s+)(\d+)\s+"?\Q$oldchoice\E"?(\s+|$)/$1.($2-1 >=0 ? $2-1 : 0)." \"$oldchoice\"".$3/se;
|
2006-11-26 20:46:11 +01:00
|
|
|
}
|
|
|
|
}
|
2008-02-05 22:14:38 +01:00
|
|
|
return "[[$prefix $params]]";
|
2006-11-26 20:46:11 +01:00
|
|
|
};
|
2008-02-05 22:14:38 +01:00
|
|
|
$content =~ s{(\\?)\[\[\Q$prefix\E\s+([^]]+)\s*\]\]}{$edit->($1, $2)}seg;
|
2006-11-26 20:46:11 +01:00
|
|
|
|
|
|
|
# Store their vote, update the page, and redirect to it.
|
|
|
|
writefile($pagesources{$page}, $config{srcdir}, $content);
|
|
|
|
$session->param($choice_param, $choice);
|
|
|
|
IkiWiki::cgi_savesession($session);
|
|
|
|
$oldchoice=$session->param($choice_param);
|
|
|
|
if ($config{rcs}) {
|
2007-02-21 10:04:59 +01:00
|
|
|
IkiWiki::disable_commit_hook();
|
2010-06-23 23:35:21 +02:00
|
|
|
IkiWiki::rcs_commit(
|
|
|
|
file => $pagesources{$page},
|
|
|
|
message => "poll vote ($choice)",
|
|
|
|
token => IkiWiki::rcs_prepedit($pagesources{$page}),
|
|
|
|
session => $session,
|
|
|
|
);
|
2007-02-21 10:04:59 +01:00
|
|
|
IkiWiki::enable_commit_hook();
|
|
|
|
IkiWiki::rcs_update();
|
2006-11-26 20:46:11 +01:00
|
|
|
}
|
2007-02-21 09:55:28 +01:00
|
|
|
require IkiWiki::Render;
|
|
|
|
IkiWiki::refresh();
|
|
|
|
IkiWiki::saveindex();
|
|
|
|
|
2006-11-26 20:46:11 +01:00
|
|
|
# Need to set cookie in same http response that does the
|
|
|
|
# redir.
|
|
|
|
eval q{use CGI::Cookie};
|
|
|
|
error($@) if $@;
|
|
|
|
my $cookie = CGI::Cookie->new(-name=> $session->name, -value=> $session->id);
|
|
|
|
print $cgi->redirect(-cookie => $cookie,
|
2010-11-29 20:07:26 +01:00
|
|
|
-url => urlto($page));
|
2006-11-26 20:46:11 +01:00
|
|
|
exit;
|
|
|
|
}
|
2008-12-17 21:22:16 +01:00
|
|
|
}
|
2006-11-26 20:46:11 +01:00
|
|
|
|
|
|
|
1
|