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