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