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