poll.pm

   1 #!/usr/bin/perl
   2 package IkiWiki::Plugin::poll;
   3
   4 use warnings;
   5 use strict;
   6 use IkiWiki 3.00;
   7 use Encode;
   8
   9 sub import {
  10         hook(type => "getsetup",   id => "poll", call => \&getsetup);
  11         hook(type => "preprocess", id => "poll", call => \&preprocess);
  12         hook(type => "scan",       id => "poll", call => \&scan);
  13         hook(type => "sessioncgi", id => "poll", call => \&sessioncgi);
  14  }
  15
  16 my %pagenum;
  17 sub getsetup () {
  18         return
  19          plugin =>
  20                  { safe => 1
  21                  , rebuild => undef
  22                  , section => "widget"
  23                  };
  24  }
  25 my $params_re
  26  = qr{
  27         (?>
  28                 (?>(?:[^\[\]]|\[[^\[]|\][^\]])+)
  29         |
  30                 (?'loop'
  31                         \[\[
  32                         (?>
  33                                 (?>(?:[^\[\]]|\[[^\[]|\][^\]])+)
  34                         |
  35                                 (?&loop)
  36                         )*
  37                         \]\]
  38                 )
  39         )*
  40  }x;
  41 sub scan (@) {
  42         my %params = @_;
  43         my $page = $params{page};
  44         my $content = $params{content};
  45         my $prefix = $config{prefix_directives} ? "!poll" : "poll";
  46         my $type = IkiWiki::pagetype($pagesources{$page});
  47         if (defined $type and $type eq "mdwn") {
  48                 my %polls = ();
  49                 while ($content =~ m{(\\?)\[\[\Q$prefix\E(\s+id="([^"]*)")?\s+($params_re)\s*\]\]}gs) {
  50                         my ($escape, $poll, $directive) = ($1, $3, $4);
  51                         next if $escape;
  52                         $poll = '' unless defined $poll;
  53                         error("poll id=`$poll' must match (|[a-z][a-z0-9_-]*) on page=`$page'")
  54                                 unless $poll =~              m/^(|[a-z][a-z0-9_-]*)$/;
  55                         my %poll = ();
  56                         while ($directive =~ m/(^|\s+)(\d+)(="([^"]*)")?\s+"?([^"]*)"?/gs) {
  57                                 my ($unknown_votes, $known_votes, $choice) = ($2, $4, $5);
  58                                 my @known_votes = defined $known_votes ? split(/\s+/, $known_votes) : ();
  59                                         $poll{$choice} =
  60                                          { unknown_votes => $unknown_votes
  61                                          , known_votes => \@known_votes
  62                                          };
  63                                 foreach my $user (@known_votes) {
  64                                         my $userpage = linkpage(($config{userdir}?$config{userdir}.'/':'').$user);
  65                                         add_link($page, $userpage);
  66                                  }
  67                          }
  68                         error("poll id=`$poll' already exists on page=`$page'")
  69                                 if exists $polls{$poll};
  70                         $polls{$poll} = \%poll;
  71                  }
  72                 $IkiWiki::pagestate{$page}{poll} = \%polls;
  73          }
  74  }
  75 sub preprocess (@) {
  76         my %params=
  77          ( open => "yes"
  78          , total => "yes"
  79          , percent => "yes"
  80          , expandable => "no"
  81          , @_ );
  82
  83         my $open=IkiWiki::yesno($params{open});
  84         my $showtotal=IkiWiki::yesno($params{total});
  85         my $showpercent=IkiWiki::yesno($params{percent});
  86         my $expandable=IkiWiki::yesno($params{expandable});
  87         my $num=++$pagenum{$params{page}}{$params{destpage}};
  88
  89         my %choices;
  90         my @choices;
  91         my $total=0;
  92         while (@_) {
  93                 my $unknown_votes = shift;
  94                 my $known_votes = shift;
  95                 next
  96                         unless $unknown_votes =~ /^\d+$/;
  97                 my @users = $known_votes ? split(/\s+/, $known_votes) : ();
  98                 my $choice = shift;
  99                 shift;
 100                 my $tot = ($unknown_votes + @users);
 101                 $choices{$choice} =
 102                  { unknown_votes => $unknown_votes
 103                  , users => \@users
 104                  , total => $tot
 105                  };
 106                 push @choices, $choice;
 107                 $total += $tot;
 108          }
 109         use URI::Escape;
 110         my $uri_page = URI::Escape::uri_escape_utf8($params{page}, '^A-Za-z0-9\-\._~/');
 111         my $ret="";
 112         foreach my $choice (@choices) {
 113                 if ($open && exists $config{cgiurl}) {
 114                         # use POST to avoid robots
 115                         $ret.="<form method=\"POST\" action=\"".IkiWiki::cgiurl()."\">\n";
 116                  }
 117                 $ret.="<dt class='choice'>";
 118                 my $percent = $total > 0 ? int($choices{$choice}{total} / $total * 100) : 0;
 119                 my $votes = $choices{$choice}{total};
 120                 $votes .= '/'.$total
 121                         if $showtotal;
 122                 $votes .= " ($percent%)"
 123                         if $showpercent;
 124                 if (@{$choices{$choice}{users}} > 0) {
 125                         $votes .= " : ".join(', ', map {
 126                                         my $userpage = linkpage(($config{userdir}?$config{userdir}.'/':'').$_);
 127                                         htmllink($params{page}, $params{destpage}, $userpage, linktext => pagetitle($_))
 128                                  } @{$choices{$choice}{users}});
 129                         $votes .= " + ".$choices{$choice}{unknown_votes}." "
 130                          . ($choices{$choice}{unknown_votes} > 1 ? gettext("unknowns") : gettext("unknown"))
 131                                 if $choices{$choice}{unknown_votes};
 132                  }
 133                 else {
 134                         $votes .= " : ".($choices{$choice}{unknown_votes}." ".gettext("unknowns"))
 135                                 if $choices{$choice}{unknown_votes};
 136                  }
 137                 if ($open && exists $config{cgiurl}) {
 138                         my $choice_escaped = URI::Escape::uri_escape_utf8($choice, '^A-Za-z0-9\ \-\._~/');
 139                         $ret.="<input type=\"hidden\" name=\"do\" value=\"poll\" />\n";
 140                         $ret.="<input type=\"hidden\" name=\"num\" value=\"$num\" />\n";
 141                         $ret.="<input type=\"hidden\" name=\"page\" value=\"$uri_page\" />\n";
 142                         $ret.="<input type=\"hidden\" name=\"choice\" value=\"$choice_escaped\" />\n";
 143                         $ret.="<input type=\"submit\" value=\"".gettext("vote")."\" />\n";
 144                  }
 145                 $ret.="<span class='description'>$choice</span>";
 146                 $ret.="</dt>";
 147                 $ret.="<dd class='votes'>";
 148                 $ret.=$votes;
 149                 $ret.="<hr class='poll' align=left width=\"$percent%\"/>\n";
 150                 if ($open && exists $config{cgiurl}) {
 151                         $ret.="</form>\n";
 152                  }
 153                 $ret.="</dd>\n";
 154          }
 155
 156         if ($expandable && $open && exists $config{cgiurl}) {
 157                 $ret.="<dt>";
 158                 $ret.="<form method=\"POST\" action=\"".IkiWiki::cgiurl()."\">\n";
 159                 $ret.="<input type=\"hidden\" name=\"do\" value=\"poll\" />\n";
 160                 $ret.="<input type=\"hidden\" name=\"num\" value=\"$num\" />\n";
 161                 $ret.="<input type=\"hidden\" name=\"page\" value=\"$uri_page\" />\n";
 162                 $ret.=gettext("Write in").": <input name=\"choice\" size=50 />\n";
 163                 $ret.="<input type=\"submit\" value=\"".gettext("vote")."\" />\n";
 164                 $ret.="</dt>\n";
 165                 $ret.="<dd>";
 166                 $ret.="</dd>\n";
 167                 $ret.="</form>\n";
 168                 $ret.="</p>\n";
 169          }
 170         return "<dl class='poll'>$ret</dl>";
 171  }
 172 sub sessioncgi ($$) {
 173         my $cgi=shift;
 174         my $session=shift;
 175         if (defined $cgi->param('do') && $cgi->param('do') eq "poll") {
 176                 my $choice = Encode::decode_utf8(URI::Escape::uri_unescape(IkiWiki::possibly_foolish_untaint($cgi->param('choice'))));
 177
 178                 if (! defined $choice || not length $choice) {
 179                         error("no choice specified");
 180                  }
 181                 my $num=$cgi->param('num');
 182                 if (! defined $num) {
 183                         error("no num specified");
 184                  }
 185                 my $page=Encode::decode_utf8(URI::Escape::uri_unescape(IkiWiki::possibly_foolish_untaint($cgi->param('page'))));
 186                 if (! defined $page || ! exists $pagesources{$page}) {
 187                         use Data::Dumper;
 188                         error("bad page name");
 189                  }
 190                 &IkiWiki::check_canedit($page, $cgi, $session);
 191
 192                 # Did they vote before? If so, let them change their vote,
 193                 # and check for dups.
 194                 my $choice_param="poll_choice_${page}_$num";
 195                 my $oldchoice=$session->param($choice_param);
 196                 #if (defined $oldchoice && $oldchoice eq $choice) {
 197                 #       # Same vote; no-op.
 198                 #       IkiWiki::redirect($cgi, urlto($page));
 199                 #       exit;
 200                 # }
 201                 my $prefix=$config{prefix_directives} ? "!poll" : "poll";
 202                 my $content=readfile(srcfile($pagesources{$page}));
 203                 # Now parse the content, find the right poll,
 204                 # and find the choice within it, and increment its number.
 205                 # If they voted before, decrement that one.
 206                 my $edit=sub {
 207                         my $escape=shift;
 208                         my $params=shift;
 209                         return $params
 210                                 if $escape;
 211                         if (--$num == 0) {
 212                                 my $vote = sub {
 213                                         my ($action, $unknown_votes, $known_votes) = @_;
 214                                         my $user = $session->param("name");
 215                                         my %users;
 216                                         foreach (split(/\s+/, $known_votes)) {
 217                                                 $users{$_} = 1;
 218                                          }
 219                                         if ($action eq 'add') {
 220                                                 if (defined $user) {
 221                                                         if (exists $users{$user} or (defined $oldchoice and $oldchoice eq $choice)) {
 222                                                                 delete $users{$user};
 223                                                                 $known_votes = join(' ', sort {lc $a <=> lc $b} (keys %users));
 224                                                          }
 225                                                         else {
 226                                                                 $known_votes = join(' ', sort {lc $a <=> lc $b} ($user, keys %users));
 227                                                          }
 228                                                  }
 229                                                 else {
 230                                                         $unknown_votes += 1;
 231                                                  }
 232                                          }
 233                                         elsif ($action eq 'del') {
 234                                                 if (defined $user) {
 235                                                         if (exists $users{$user}) {
 236                                                                 delete $users{$user};
 237                                                                 $known_votes = join(' ', sort {lc $a <=> lc $b} (keys %users));
 238                                                          }
 239                                                  }
 240                                                 else {
 241                                                         $unknown_votes = ($unknown_votes-1 >=0 ? $unknown_votes-1 : 0);
 242                                                  }
 243                                          }
 244                                         return $unknown_votes.($known_votes?"=\"$known_votes\"":"")
 245                                  };
 246                                 if ($params=~s/(^|\s+)(\d+)(="([^"]*)")?(\s+)"?\Q$choice\E"?(\s+|$)/$1.$vote->('add', $2, $4)."$5\"$choice\"".$6/es) {
 247                                  }
 248                                 elsif ($params=~/expandable=(\w+)/
 249                                     & &IkiWiki::yesno($1)) {
 250                                         $choice=~s/["\]\n\r]//g;
 251                                         $params.=" 1 \"$choice\""
 252                                                 if length $choice;
 253                                  }
 254                                 if (defined $oldchoice and not ($oldchoice eq $choice)) {
 255                                         $params=~s/(^|\s+)(\d+)(="([^"]*)")?(\s+)"?\Q$oldchoice\E"?(\s+|$)/$1.$vote->('del', $2, $4)."$5\"$oldchoice\"".$6/es;
 256                                  }
 257                          }
 258                         return "$params";
 259                  };
 260                 my $id='';
 261                 $content =~
 262                  s{
 263                         (?<escape>\\?)
 264                         \[\[\Q$prefix\E
 265                                 (?:(?<id_space>\s+)id="(?<id>[^"]*)")?
 266                                 (?<params_space>\s+)
 267                                 (?<params>$params_re)
 268                                 (?<end_space>\s*)
 269                         \]\]
 270                         }
 271                  {$id=$+{id};
 272                         $+{escape}
 273                         .'[['.$prefix
 274                                 .($+{id} eq ''?'':$+{id_space}.'id="'.$+{id}.'"')
 275                                 .$+{params_space}
 276                                 .$edit->($+{escape}, $+{params})
 277                                 .$+{end_space}
 278                         .']]'
 279                  }egsx;
 280
 281                 # Store their vote, update the page, and redirect to it.
 282                 writefile($pagesources{$page}, $config{srcdir}, $content);
 283                 if (defined $oldchoice and $choice eq $oldchoice) {
 284                         $session->param($choice_param, undef);
 285                         # TOTRY: $session->clear($choice_param);
 286                  }
 287                 else {
 288                         $session->param($choice_param, $choice);
 289                  }
 290                 IkiWiki::cgi_savesession($session);
 291                 if ($config{rcs}) {
 292                         IkiWiki::disable_commit_hook();
 293                         IkiWiki::rcs_commit
 294                          ( file    => $pagesources{$page}
 295                          , message => "poll vote: id=$id: $choice"
 296                          , session => $session
 297                          , token   => IkiWiki::rcs_prepedit($pagesources{$page})
 298                          );
 299                         IkiWiki::enable_commit_hook();
 300                         IkiWiki::rcs_update();
 301                  }
 302                 require IkiWiki::Render;
 303                 IkiWiki::refresh();
 304                 IkiWiki::saveindex();
 305                 # Need to set cookie in same http response that does the redir.
 306                 eval q{use CGI::Cookie};
 307                 error($@) if $@;
 308                 my $cookie = CGI::Cookie->new
 309                  ( -name  => $session->name
 310                  , -value => $session->id );
 311                 print $cgi->redirect
 312                  ( -cookie => $cookie
 313                  , -url    => urlto($page) );
 314                 exit;
 315          }
 316  }
 317 package IkiWiki::PageSpec;
 318         sub match_poll ($$;@) {
 319                 my ($page, $match, %params) = @_;
 320                 my $polls = $IkiWiki::pagestate{$page}{poll};
 321                 if (defined $polls and %$polls) {
 322                         my ($match_id, $match_user, $match_choice) = $match =~ m/^id=(.*?) user=(.*?) choice=(.*?)$/;
 323                         my $match_id_re = IkiWiki::glob2re($match_id?$match_id:'*');
 324                         my @polls = grep {$_ =~ $match_id_re} (keys %$polls);
 325                         return IkiWiki::FailReason->new("no poll match id=`$match_id'", $page => $IkiWiki::DEPEND_CONTENT)
 326                                 unless @polls > 0;
 327                         foreach my $poll (@polls) {
 328                                 my %poll = %{$polls->{$poll}};
 329                                 my $match_user_re   = IkiWiki::glob2re($match_user?$match_user:'*');
 330                                 my $match_choice_re = IkiWiki::glob2re($match_choice?$match_choice:'*');
 331                                 while (my ($choice, $data) = each %poll) {
 332                                         next unless $choice =~ $match_choice_re;
 333                                         if ($match_user eq '') {
 334                                                 if ($data->{unknown_votes} > 0) {
 335                                                         return IkiWiki::SuccessReason->new("unkown user has voted for choice=`$choice'", $page => $IkiWiki::DEPEND_CONTENT);
 336                                                  }
 337                                                 else {
 338                                                         return IkiWiki::FailReason->new("no unkown user has voted for choice=`$choice'", $page => $IkiWiki::DEPEND_CONTENT);
 339                                                  }
 340                                          }
 341                                         else {
 342                                                 foreach my $user (@{$data->{known_votes}}) {
 343                                                         next unless $user =~ $match_user_re;
 344                                                         return IkiWiki::SuccessReason->new("user=`$user' has voted for choice=`$choice'", $page => $IkiWiki::DEPEND_CONTENT);
 345                                                  }
 346                                          }
 347                                  }
 348                          }
 349                         return IkiWiki::FailReason->new("no user=`$match_user' has voted for choice=`$match_choice'", $page => $IkiWiki::DEPEND_CONTENT);
 350                  }
 351                 else {
 352                         return IkiWiki::FailReason->new("no poll", $page => $IkiWiki::DEPEND_CONTENT);
 353                  }
 354          }
 355
 356 1;