Add RuleOrder to prevent conflict with markup.pl.

duckduckgo-search.pl and duckduckgo-search.t based on google-search.pl
and google-search.t to use DuckDuckGo for the search action via a
redirect.

contrib/info-ref

@@ -1,21 +1,17 @@
 #!/usr/bin/perl
-# Copyright (C) 2005, 2006, 2007  Alex Schroeder <alex@emacswiki.org>
+# Copyright (C) 2005, 2006, 2007, 2012  Alex Schroeder <alex@gnu.org>
 #
-# This program is free software; you can redistribute it and/or modify
-# it under the terms of the GNU General Public License as published by
-# the Free Software Foundation; either version 2 of the License, or
-# (at your option) any later version.
+# This program is free software: you can redistribute it and/or modify it under
+# the terms of the GNU General Public License as published by the Free Software
+# Foundation, either version 3 of the License, or (at your option) any later
+# version.
 #
-# This program is distributed in the hope that it will be useful,
-# but WITHOUT ANY WARRANTY; without even the implied warranty of
-# MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
-# GNU General Public License for more details.
+# This program is distributed in the hope that it will be useful, but WITHOUT
+# ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or FITNESS
+# FOR A PARTICULAR PURPOSE. See the GNU General Public License for more details.
 #
-# You should have received a copy of the GNU General Public License
-# along with this program; if not, write to the
-#    Free Software Foundation, Inc.
-#    59 Temple Place, Suite 330
-#    Boston, MA 02111-1307 USA
+# You should have received a copy of the GNU General Public License along with
+# this program. If not, see <http://www.gnu.org/licenses/>.
 
 use strict;
 use warnings;
@@ -38,6 +34,42 @@ my %indexes = (
 	       => 'GNU Emacs Lisp reference manual, Index',
 	       'http://www.gnu.org/software/emacs/manual/html_node/elisp/index.html'
 	       => 'GNU Emacs Lisp reference manual, Top Menu',
+	       'http://www.gnu.org/software/emacs/manual/html_node/message/Index.html'
+	       => 'Message Manual, Index',
+	       'http://www.gnu.org/software/emacs/manual/html_node/gnus/Index.html'
+	       => 'The Gnus Newsreader, Index',
+	       'http://www.gnu.org/software/emacs/manual/html_node/cl/Function-Index.html'
+	       => 'Common Lisp Extensions, Function Index',
+	       'http://www.gnu.org/software/emacs/manual/html_node/ccmode/Variable-Index.html'
+	       => 'CC Mode Manual, Variable Index',
+	       'http://www.gnu.org/software/emacs/manual/html_node/ccmode/Concept-and-Key-Index.html'
+	       => 'CC Mode Manual, Command and Function Index',
+	       'http://www.gnu.org/software/emacs/manual/html_node/org/Index.html'
+	       => 'Org Mode Manual, Index',
+	       'http://www.gnu.org/software/auctex/manual/auctex/Function-Index.html'
+	       => 'AUCTeX Manual, Function Index',
+	       'http://www.gnu.org/software/auctex/manual/auctex/Variable-Index.html'
+	       => 'AUCTeX Manual, Variable Index',
+	       'http://www.gnu.org/software/auctex/manual/auctex/Concept-Index.html'
+	       => 'AUCTeX Manual, Concept Index',
+	       'http://www.gnu.org/software/texinfo/manual/texinfo/html_node/index.html'
+	       => 'Texinfo, Command and Variable Index',
+	       'http://www.gnu.org/software/texinfo/manual/texinfo/html_node/General-Index.html'
+	       => 'Texinfo, General Index',
+	       'http://www.gnu.org/software/texinfo/manual/info/html_node/Index.html'
+	       => 'Info, Index',
+	       'http://www.gnu.org/software/emacs/manual/html_node/dired-x/Command-Index.html'
+	       => 'Dired Extra, Function Index',
+	       'http://www.gnu.org/software/emacs/manual/html_node/dired-x/Variable-Index.html'
+	       => 'Dired Extra, Variable Index',
+	       'http://www.gnu.org/software/coreutils/manual/html_node/Concept-index.html'
+	       => 'Coreutils, Index',
+	       'http://www.gnu.org/software/diffutils/manual/html_node/Index.html'
+	       => 'Diffutils, Index',
+	       'http://www.gnu.org/software/findutils/manual/html_node/find_html/Primary-Index.html'
+	       => 'Findutils, Primary Index',
+	       'http://www.gnu.org/software/emacs/manual/html_node/ediff/Index.html'
+	       => 'Edfiff, Index',
 	      );
 
 my $db = '/org/org.emacswiki/htdocs/emacs/info-ref.dat';
@@ -63,7 +95,9 @@ sub ProcessRequest {
 sub ShowForm {
   print $q->header, $q->start_html,
     $q->start_form, "Index entry: ", $q->textfield('find'), $q->submit, $q->end_form,
-    $q->p('$Id: info-ref,v 1.1 2007/07/13 23:20:57 as Exp $'),
+    $q->p($q->a({-href=>"http://www.emacswiki.org/scripts/info-ref"}, "Source"), $q->br(),
+	  'Last DB update: ', TimeToText((stat($db))[9]),
+	  ' (' . $q->a({-href=>$q->url . '?init=1'}, "update") . ')'),
     $q->end_html;
 }
 
@@ -74,9 +108,11 @@ sub Find {
   foreach my $line (split(/$nl/, $data)) {
     my ($key, $rest) = split(/$fs/, $line);
     $map{$key} = ();
-    foreach my $a (split(/$gs/, $rest)) {
-      my ($link, $label) = split(/$rs/, $a);
-      $map{$key}{$link} = $label;
+    if ($rest) {
+      foreach my $a (split(/$gs/, $rest)) {
+	my ($link, $label) = split(/$rs/, $a);
+	$map{$key}{$link} = $label;
+      }
     }
   }
   my @links = keys %{$map{$str}};
@@ -150,7 +186,7 @@ sub GetRaw {
   return unless eval { require LWP::UserAgent; };
   my $ua = LWP::UserAgent->new;
   my $response = $ua->get($uri);
-  return $response->content;
+  return $response->decoded_content;
 }
 
 sub ReadFile {
@@ -189,3 +225,18 @@ sub ReportError { # fatal!
   print $q->start_html, $q->h2($errmsg), $q->end_html;
   exit (1);
 }
+
+sub CalcDay {
+  my ($sec, $min, $hour, $mday, $mon, $year) = gmtime(shift);
+  return sprintf('%4d-%02d-%02d', $year+1900, $mon+1, $mday);
+}
+
+sub CalcTime {
+  my ($sec, $min, $hour, $mday, $mon, $year) = gmtime(shift);
+  return sprintf('%02d:%02d UTC', $hour, $min);
+}
+
+sub TimeToText {
+  my $t = shift;
+  return CalcDay($t) . ' ' . CalcTime($t);
+}

contrib/twitter

@@ -0,0 +1,51 @@
+#!/usr/bin/perl
+# Copyright (C) 2009, 2012  Alex Schroeder <alex@gnu.org>
+#
+# This program is free software: you can redistribute it and/or modify it under
+# the terms of the GNU General Public License as published by the Free Software
+# Foundation, either version 3 of the License, or (at your option) any later
+# version.
+#
+# This program is distributed in the hope that it will be useful, but WITHOUT
+# ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or FITNESS
+# FOR A PARTICULAR PURPOSE. See the GNU General Public License for more details.
+#
+# You should have received a copy of the GNU General Public License along with
+# this program. If not, see <http://www.gnu.org/licenses/>.
+
+use CGI qw/:standard/;
+use CGI::Carp qw(fatalsToBrowser);
+use LWP::UserAgent;
+use XML::RSS;
+
+if (not param('feed')) {
+  print header(),
+    start_html('Description Stripping'),
+    h1('Description Stripping'),
+    p('Removes the description of an article if it matches the title. This is most useful for Twitter and other microblogging services.'),
+    p('Example input:', code('http://api.twitter.com/1/statuses/user_timeline.rss?screen_name=kensanata')),
+    start_form(-method=>'GET'),
+    p('Feed: ', textfield('feed', '', 40), checkbox('Strip username'),
+      submit()),
+    end_form(),
+    end_html();
+  exit;
+}
+
+$ua = LWP::UserAgent->new;
+$request = HTTP::Request->new('GET', param('feed'));
+$response = $ua->request($request);
+$data = $response->content;
+exit unless $data;
+
+print header(-type=>$response->content_type);
+
+$rss = new XML::RSS;
+$rss->parse($data);
+
+foreach my $i (@{$rss->{items}}) {
+  $i->{description} = undef if $i->{description} eq $i->{title};
+  $i->{title} =~ s/^.*?: // if param('Strip username');
+}
+
+print $rss->as_string;

css/alex-2012.css

@@ -1,15 +1,18 @@
+@font-face {
+	  font-family: 'Garamond';
+	  font-style: normal;
+	  font-weight: 400;
+	  src: local('Garamond'), local('GaramondNo8'), local('EB Garamond'), local('EBGaramond'), url(https://themes.googleusercontent.com/static/fonts/ebgaramond/v4/kYZt1bJ8UsGAPRGnkXPeFdIh4imgI8P11RFo6YPCPC0.woff) format('woff');
+}
+
 body, rss {
-    font-family: Garamond, GaramondNo8, "Bookman Old Style", Cochin, Baskerville, serif;
+    font-family: Garamond, serif;
     font-size: 16pt;
     line-height: 20pt;
     margin:1em 3em;
     padding:0;
 }
 
-body.sans {
-    font-family: Franklin Gothic Book, Corbel, Arial, sans-serif;
-}
-
 /* headings: we can use larger sizes if we use a lighter color.
    we cannot inherit the font-family because header and footer use a narrow font. */
 
@@ -176,7 +179,6 @@ div.sister hr {
 }
 div.sister img {
     border:none;
-    background-color:#ffe;
 }
 
 div.near, div.definition {
@@ -194,9 +196,6 @@ div.sidebar ul {
 
 /* replacements, features */
 
-del {
-    color: #666;
-}
 ins {
     color: #b33;
     text-decoration: none;
@@ -390,69 +389,69 @@ p.table + p { clear:both; }
 
 @media print {
     body {
-	font-size:   12pt;
-	line-height: 13pt;
-	color:       #000;
-	background-color: #fff;
-    }
+		font-size:   12pt;
+		line-height: 13pt;
+		color:       #000;
+		background-color: #fff;
+	}
     
     /* hide all the crap */
     div.diff, div.diff+hr, div.refer, div.near, div.definition, div.sister,
     div.cal, div.footer, span.specialdays, span.gotobar, a.edit, a.number span,
     div.rc form, form.tiny, p.comment {
-	display:none;
+		display:none;
     }
     a,
     a:visited,
     div.content a.near:link, 
     div.content a.near:visited,
     div.content a.near:active {
-	color:inherit;
-	font-weight: bold;
+		color:inherit;
+		font-weight: bold;
     }
     div.content a.feed {
-	display: none;
+		display: none;
     }
     div.content a.book,
     div.content a.movie {
-	text-decoration: none;
+		text-decoration: none;
     }
     a cite {
-	font-style: italic;
+		font-style: italic;
     }
     /* no difference */
     pre, code, tt {
-	font-size: inherit;
-	line-height: inherit;
+		font-size: inherit;
+		line-height: inherit;
     }
     /* no dotted underlines */ 
     acronym, abbr {
-	border: none;
-	text-decoration: none;
+		border: none;
+		text-decoration: none;
     }
     /* headings */
     h1 {
-	color:       inherit;
-	margin-top:  2em;
-    }
-    h2 {
-	color:inherit;
-	margin: 1em 0;
-	font-variant: small-caps;
-    }
-    h3 {
-	font-weight:inherit;
-	font-style:italic;
-	color:inherit;
-	margin: 1em 0;
-    }
-    h1 a, h2 a, h3 a {
-	color: inherit;
-    }
-    div.journal h1 a:visited,
-    div.journal h2 a:visited,
-    div.journal h3 a:visited {
-	color: inherit;
+		color:       inherit;
+		margin-top:  2em;
+	}
+	h2 {
+		color:inherit;
+		margin: 1em 0;
+		font-variant: small-caps;
+	}
+	h3 {
+		font-weight:inherit;
+		font-style:italic;
+		color:inherit;
+		margin: 1em 0;
+	}
+	h1 a, h2 a, h3 a {
+		color: inherit;
+	}
+	div.journal h1 a:visited,
+	div.journal h2 a:visited,
+	div.journal h3 a:visited {
+		color: inherit;
     }
 }
 

css/emacs.css

@@ -249,7 +249,7 @@ dd, li {
 
 /* elisp files and other scripts for download */
 
-p.download a {
+p.download a, a.download {
     padding: 0.5em;
     color: black;
     text-decoration: none;

modules/banned-regexps.pl

@@ -0,0 +1,84 @@
+# Copyright (C) 2012  Alex Schroeder <alex@gnu.org>
+#
+# This program is free software; you can redistribute it and/or modify it under
+# the terms of the GNU General Public License as published by the Free Software
+# Foundation; either version 3 of the License, or (at your option) any later
+# version.
+#
+# This program is distributed in the hope that it will be useful, but WITHOUT
+# ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or FITNESS
+# FOR A PARTICULAR PURPOSE. See the GNU General Public License for more details.
+#
+# You should have received a copy of the GNU General Public License along with
+# this program. If not, see <http://www.gnu.org/licenses/>.
+
+package OddMuse;
+
+$ModulesDescription .= '<p><a href="http://git.savannah.gnu.org/cgit/oddmuse.git/tree/modules/banned-regexps.pl">banned-regexps.pl</a>, see <a href="http://www.oddmuse.org/cgi-bin/oddmuse/Banning_Regular_Expressions">Banning Regular Expressions</a></p>';
+
+=h1 Compatibility
+
+This extension works with logbannedcontent.pl.
+
+=h1 Example content for the BannedRegexps page:
+
+    # This page lists regular expressions that prevent the saving of a page.
+    # The regexps are matched against any page or comment submitted.
+    # The format is simple: # comments to the end of the line. Empty lines are ignored.
+    # Everything else is a regular expression. If the regular expression is followed by
+    # a comment, this is used as the explanation when a user is denied editing. If the
+    # comment starts with a date, this date is not included in the explanation.
+    # The date could help us decide which regular expressions to delete in the future.
+    # In other words:
+    # ^\s*([^#]+?)\s*(#\s*(\d\d\d\d-\d\d-\d\d\s*)?(.*))?$
+    # Group 1 is the regular expression to use.
+    # Group 4 is the explanation to use.
+
+    порно # 2012-12-31 Russian porn
+    <a\s+href=["']?http # 2012-12-31 HTML anchor tags usually mean spam
+    \[url= # 2012-12-31 bbCode links usually mean spam
+    \s+https?:\S+[ .\r\n]*$ # 2012-12-31 ending with a link usually means spam
+    (?s)\s+https?:\S+.*\s+https?:\S+.*\s+https?:\S+.* # 2012-12-31 three naked links usually mean spam
+
+=cut
+
+use vars qw($BannedRegexps);
+
+$BannedRegexps = 'BannedRegexps';
+
+push(@MyInitVariables, sub {
+       $AdminPages{$BannedRegexps} = 1;
+       $LockOnCreation{$BannedRegexps} = 1;
+       $PlainTextPages{$BannedRegexps} = 1;
+     });
+
+*RegexpOldBannedContent = *BannedContent;
+*BannedContent = *RegexpNewBannedContent;
+
+# the above also changes the mapping for the variable!
+$BannedContent = $RegexpOldBannedContent;
+
+sub RegexpNewBannedContent {
+  my $str = shift;
+  my $rule = RegexpOldBannedContent($str, @_);
+  if (not $rule) {
+    foreach (split(/\n/, GetPageContent($BannedRegexps))) {
+      next unless m/^\s*([^#]+?)\s*(#\s*(\d\d\d\d-\d\d-\d\d\s*)?(.*))?$/;
+      my ($regexp, $comment, $re) = ($1, $4, undef);
+      eval { $re = qr/$regexp/i; };
+      if (defined($re) && $str =~ $re) {
+	my $group1 = $1;
+	my $explanation = ($group1
+			   ? Tss('Regular expression "%1" matched "%2" on this page.', QuoteHtml($regexp), $group1)
+			   : Ts('Regular expression "%s" matched on this page.', QuoteHtml($regexp)));
+        $rule = $explanation . ' '
+          . ($comment ? Ts('Reason: %s.', $comment) : T('Reason unknown.')) . ' '
+          . Ts('See %s for more information.', GetPageLink($BannedRegexps));
+        last;
+      }
+    }
+  }
+  LogWrite($rule) if $rule and $BannedFile;
+  return $rule if $rule;
+  return 0;
+}

modules/bbcode.pl

@@ -1,17 +1,16 @@
-# Copyright (C) 2007, 2008  Alex Schroeder <alex@gnu.org>
+# Copyright (C) 2007, 2008, 2013  Alex Schroeder <alex@gnu.org>
 #
-# This program is free software; you can redistribute it and/or modify
-# it under the terms of the GNU General Public License as published by
-# the Free Software Foundation; either version 3 of the License, or
-# (at your option) any later version.
+# This program is free software; you can redistribute it and/or modify it under
+# the terms of the GNU General Public License as published by the Free Software
+# Foundation; either version 3 of the License, or (at your option) any later
+# version.
 #
-# This program is distributed in the hope that it will be useful,
-# but WITHOUT ANY WARRANTY; without even the implied warranty of
-# MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
-# GNU General Public License for more details.
+# This program is distributed in the hope that it will be useful, but WITHOUT
+# ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or FITNESS
+# FOR A PARTICULAR PURPOSE. See the GNU General Public License for more details.
 #
-# You should have received a copy of the GNU General Public License
-# along with this program.  If not, see <http://www.gnu.org/licenses/>.
+# You should have received a copy of the GNU General Public License along with
+# this program. If not, see <http://www.gnu.org/licenses/>.
 
 $ModulesDescription .= '<p><a href="http://git.savannah.gnu.org/cgit/oddmuse.git/tree/modules/bbcode.pl">bbcode.pl</a>, see <a href="http://www.oddmuse.org/cgi-bin/oddmuse/bbCode_Extension">bbCode Extension</a></p>';
 
@@ -37,6 +36,10 @@ sub bbCodeRule {
 				. qq{font-style: normal;"}); }
     elsif ($tag eq 's' or $tag eq 'strike') {
       return AddHtmlEnvironment('del'); }
+    elsif ($tag eq 'sub') {
+      return AddHtmlEnvironment('sub'); }
+    elsif ($tag eq 'sup') {
+      return AddHtmlEnvironment('sup'); }
     elsif ($tag eq 'color') {
       return AddHtmlEnvironment('em', qq{style="color: $option; }
 				. qq{font-style: normal;"}); }
@@ -96,7 +99,7 @@ sub bbCodeRule {
     %translate = qw{b b i i u em color em size em font span url a
 		    quote blockquote h1 h1 h2 h2 h3 h3 h4 h4 h5 h5
 		    h6 h6 center div left div right div list ul
-		    s del strike del highlight strong};
+		    s del strike del sub sub sup sup highlight strong};
     # closing a block level element closes all elements
     if ($bbBlock eq $translate{$tag}) {
       /\G([ \t]*\n)*/cg; # eat whitespace after closing block level element

modules/creole.pl

@@ -391,7 +391,7 @@ sub CreoleRule {
       my $is_right_justified = $3;
 
       # Now that we've retrieved all numbered matches, match another lookahead.
-      my $is_left_justified = m/\G(?=.*?[ \t]+\|)/;
+      my $is_left_justified = m/\G(?=[^\n|]*?[ \t]+\|)/;
       my $attributes = $column_span == 1 ? '' : qq{colspan="$column_span"};
 
          if ($is_left_justified and

modules/duckduckgo-search.pl

@@ -0,0 +1,49 @@
+# Copyright (C) 2007–2013  Alex Schroeder <alex@gnu.org>
+#
+# This program is free software: you can redistribute it and/or modify it under
+# the terms of the GNU General Public License as published by the Free Software
+# Foundation, either version 3 of the License, or (at your option) any later
+# version.
+#
+# This program is distributed in the hope that it will be useful, but WITHOUT
+# ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or FITNESS
+# FOR A PARTICULAR PURPOSE. See the GNU General Public License for more details.
+#
+# You should have received a copy of the GNU General Public License along with
+# this program. If not, see <http://www.gnu.org/licenses/>.
+
+$ModulesDescription .= '<p><a href="http://git.savannah.gnu.org/cgit/oddmuse.git/tree/modules/duckduckgo-search.pl">duckduckgo-search.pl</a>, see <a href="http://www.oddmuse.org/cgi-bin/oddmuse/Use_DuckDuckGo_For_Searches">Use DuckDuckGo For Searches</a></p>';
+
+use vars qw($DuckDuckGoSearchDomain);
+
+$DuckDuckGoSearchDomain = undef;
+
+$Action{search} = \&DoDuckDuckGoSearch;
+
+push(@MyInitVariables, \&DuckDuckGoSearchInit);
+
+sub DuckDuckGoSearchInit {
+  # If $ScriptName does not contain a hostname, this extension will
+  # have no effect. Domain regexp based on RFC 2396 section 3.2.2.
+  if (!$DuckDuckGoSearchDomain) {
+    my $alpha = '[a-zA-Z]';
+    my $alphanum = '[a-zA-Z0-9]';
+    my $alphanumdash = '[-a-zA-Z0-9]';
+    my $domainlabel = "$alphanum($alphanumdash*$alphanum)?";
+    my $toplabel = "$alpha($alphanumdash*$alphanum)?";
+    if ($ScriptName =~ m!^(https?://)?([^/]+\.)?($domainlabel\.$toplabel)\.?(:|/|\z)!) {
+      $DuckDuckGoSearchDomain = $3;
+    }
+  }
+  if ($DuckDuckGoSearchDomain
+      and GetParam('search', undef)
+      and not GetParam('action', undef)
+      and not GetParam('old', 0)) {
+    SetParam('action', 'search');
+  }
+}
+
+sub DoDuckDuckGoSearch {
+  my $search = GetParam('search', undef);
+  print $q->redirect({-uri=>"https://www.duckduckgo.com/?q=$search+site%3A$DuckDuckGoSearchDomain"});
+}

modules/fractions.pl

@@ -0,0 +1,60 @@
+# Copyright (C) 2013  Alex Schroeder <alex@gnu.org>
+#
+# This program is free software; you can redistribute it and/or modify
+# it under the terms of the GNU General Public License as published by
+# the Free Software Foundation; either version 3 of the License, or
+# (at your option) any later version.
+#
+# This program is distributed in the hope that it will be useful,
+# but WITHOUT ANY WARRANTY; without even the implied warranty of
+# MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
+# GNU General Public License for more details.
+#
+# You should have received a copy of the GNU General Public License
+# along with this program. If not, see <http://www.gnu.org/licenses/>.
+
+$ModulesDescription .= '<p><a href="http://git.savannah.gnu.org/cgit/oddmuse.git/tree/modules/fractions.pl">fractions.pl</a>, see <a href="http://www.oddmuse.org/cgi-bin/oddmuse/Fractions">Fractions</a></p>';
+
+push(@MyRules, \&FractionsRule);
+
+# usage: ^1/32
+sub FractionsRule {
+  if (/\G\^([0-9]+)\/([0-9]+)/cg) {
+    if    ($1 == 1 and $2 == 4)  { return "\&#x00bc;"; }
+    elsif ($1 == 1 and $2 == 2)  { return "\&#x00bd;"; }
+    elsif ($1 == 3 and $2 == 4)  { return "\&#x00be;"; }
+    elsif ($1 == 1 and $2 == 7)  { return "\&#x2150;"; }
+    elsif ($1 == 1 and $2 == 9)  { return "\&#x2151;"; }
+    elsif ($1 == 1 and $2 == 10) { return "\&#x2152;"; }
+    elsif ($1 == 1 and $2 == 3)  { return "\&#x2153;"; }
+    elsif ($1 == 2 and $2 == 3)  { return "\&#x2154;"; }
+    elsif ($1 == 1 and $2 == 5)  { return "\&#x2155;"; }
+    elsif ($1 == 2 and $2 == 5)  { return "\&#x2156;"; }
+    elsif ($1 == 3 and $2 == 5)  { return "\&#x2157;"; }
+    elsif ($1 == 4 and $2 == 5)  { return "\&#x2158;"; }
+    elsif ($1 == 1 and $2 == 6)  { return "\&#x2159;"; }
+    elsif ($1 == 5 and $2 == 6)  { return "\&#x215a;"; }
+    elsif ($1 == 1 and $2 == 8)  { return "\&#x215b;"; }
+    elsif ($1 == 3 and $2 == 8)  { return "\&#x215c;"; }
+    elsif ($1 == 5 and $2 == 8)  { return "\&#x215d;"; }
+    elsif ($1 == 7 and $2 == 8)  { return "\&#x215e;"; }
+    else {
+      my $html;
+      # superscripts
+      for my $char (split(//, $1)) {
+	if    ($char eq '1') { $html .= "\&#x00b9;"; }
+	elsif ($char eq '2') { $html .= "\&#x00b2;"; }
+	elsif ($char eq '3') { $html .= "\&#x00b3;"; }
+	else                 { $html .= "\&#x207$char;"; }
+      }
+      # fraction slash
+      $html .= '&#x2044;';
+      # subscripts
+      for my $char (split(//, $2)) {
+	$html .= "\&#x208$char;";
+      }
+      return $html;
+    }
+  }
+  return undef;
+}

modules/git.pl

@@ -133,26 +133,50 @@ sub GitNewDeletePage {
 
 push(@MyMaintenance, \&GitCleanup);
 
+$Action{git} = \&DoGitCleanup;
+
+sub DoGitCleanup {
+  UserIsAdminOrError();
+  print GetHeader('', 'Git', '');
+  print $q->start_div({-class=>'content git'});
+  RequestLockOrError();
+  print $q->p(T('Main lock obtained.')), '<p>',
+    T('Cleaning up git repository');
+  GitCleanup();
+  ReleaseLock();
+  print $q->p(T('Main lock released.')), $q->end_div();
+  PrintFooter();
+}
+
 sub GitCleanup {
   if (-d $GitRepo) {
+    print $q->p("Git cleanup starting");
+    AllPagesList();
     # delete all the files including all the files starting with a dot
     opendir(DIR, $GitRepo) or ReportError("cannot open directory $GitRepo: $!");
     foreach my $file (readdir(DIR)) {
-      next if $file eq '.git' or $file eq '.' or $file eq '..';
-      unlink "$GitRepo/$file" or ReportError("cannot delete $GitRepo/$file: $!");
+      my $name = $file;
+      utf8::decode($name); # filenames are bytes
+      next if $file eq '.git' or $file eq '.' or $file eq '..' or $IndexHash{$name};
+      print $q->p("Deleting left over file $name");
+      unlink "$GitRepo/$file" or ReportError("cannot delete $GitRepo/$name: $!");
     }
     closedir DIR;
-    # write all the files again
-    foreach my $id (AllPagesList()) {
+    # write all the files again, just to be sure
+    print $q->p("Rewriting all the files, just to be sure");
+    foreach my $id (@IndexList) {
       OpenPage($id);
       WriteStringToFile("$GitRepo/$id", $Page{text});
     }
     # run git!
     chdir($GitRepo); # important for all the git commands that follow!
     # add any new files
+    print $q->p("Adding new files, if any");
     GitRun('add', '.');
     # commit the new state
-    GitRun('commit', '--quiet', '-a', '-m', 'maintenance job',
-	   "--author=Oddmuse <$GitMail>");
+    print $q->p("Committing changes, if any");
+    # try to protect against mysterious crashes
+    print $q->pre(`$GitBinary commit --quiet -a -m 'maintenance job' --author=Oddmuse <$GitMail>` . ' ');
+    print $q->p("Git done");
   }
 }

modules/google-custom-search.pl

@@ -50,7 +50,7 @@ sub NewGoogleCustomGetSearchLink {
 
 sub NewGoogleCustomGetHeader {
   my $html = OldGoogleCustomGetHeader(@_);
-  $form .= qq {
+  my $form = qq {
 <!-- Google CSE Search Box Begins  -->
 <form class="tiny" action="http://www.google.com/cse" id="searchbox_004774160799092323420:6-ff2s0o6yi"><p>
 <input type="hidden" name="cx" value="004774160799092323420:6-ff2s0o6yi" />

modules/list-banned-content.pl

@@ -0,0 +1,63 @@
+# Copyright (C) 2012  Alex Schroeder <alex@gnu.org>
+#
+# This program is free software; you can redistribute it and/or modify it under
+# the terms of the GNU General Public License as published by the Free Software
+# Foundation; either version 3 of the License, or (at your option) any later
+# version.
+#
+# This program is distributed in the hope that it will be useful, but WITHOUT
+# ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or FITNESS
+# FOR A PARTICULAR PURPOSE. See the GNU General Public License for more details.
+#
+# You should have received a copy of the GNU General Public License along with
+# this program. If not, see <http://www.gnu.org/licenses/>.
+
+$ModulesDescription .= '<p><a href="http://git.savannah.gnu.org/cgit/oddmuse.git/tree/modules/list-banned-content.pl">list-banned-content.pl</a>, see <a href="http://www.oddmuse.org/cgi-bin/oddmuse/BannedContent">Index Extension</a></p>';
+
+$Action{'list-banned-content'} = \&DoListBannedContent;
+
+sub DoListBannedContent {
+  print GetHeader('', T('Banned Content'), '');
+  my @pages = AllPagesList();
+  my %url_regexps;
+  my %text_regexps;
+  foreach (split(/\n/, GetPageContent($BannedContent))) {
+    next unless m/^\s*([^#]+?)\s*(#\s*(\d\d\d\d-\d\d-\d\d\s*)?(.*))?$/;
+    $url_regexps{qr($1)} = $4;
+  }
+  foreach (split(/\n/, GetPageContent($BannedRegexps))) {
+    next unless m/^\s*([^#]+?)\s*(#\s*(\d\d\d\d-\d\d-\d\d\s*)?(.*))?$/;
+    $text_regexps{qr($1)} = $4;
+  }
+  print '<div class="content banned"><p>';
+  print $BannedContent . ': ' . scalar(keys(%url_regexps)) . $q->br() . "\n";
+  print $BannedRegexps . ': ' . scalar(keys(%text_regexps)) . $q->br() . "\n";
+ PAGE: foreach my $id (@pages) {
+    OpenPage($id);
+    my @urls = $str =~ /$FullUrlPattern/go;
+    foreach my $url (@urls) {
+      foreach my $re (keys %url_regexps) {
+	if ($url =~ $re) {
+	  print GetPageLink($id) . ': '
+	    . Tss('Rule "%1" matched "%2" on this page.', $re, $url) . ' '
+	      . ($url_regexps{$re}
+		 ? Ts('Reason: %s.', $url_regexps{$re})
+		 : T('Reason unknown.')) . $q->br() . "\n";
+	  next PAGE;
+	}
+      }
+    }
+    foreach my $re (keys %text_regexps) {
+      if ($Page{text} =~ $re) {
+	print GetPageLink($id) . ': '
+	  . Tss('Rule "%1" matched on this page.', $re) . ' '
+	    . ($text_regexps{$re}
+	       ? Ts('Reason: %s.', $text_regexps{$re})
+	       : T('Reason unknown.')) . $q->br() . "\n";
+	next PAGE;
+      }
+    }
+  }
+  print '</p></div>';
+  PrintFooter();
+}

modules/logbannedcontent.pl

@@ -20,25 +20,31 @@ use vars qw($BannedFile);
 
 $BannedFile = "$DataDir/spammer.log" unless defined $BannedFile;
 
-*OldBannedContent = *BannedContent;
-*BannedContent = *LogBannedContent;
-$BannedContent = $OldBannedContent; # copy variable
+*LogOldBannedContent = *BannedContent;
+*BannedContent = *LogNewBannedContent;
+$BannedContent = $LogOldBannedContent; # copy variable
 
-sub LogBannedContent {
+sub LogNewBannedContent {
   my $str = shift;
-  my $rule = OldBannedContent($str);
-  if ($rule) {
-    my $visitor = $ENV{'REMOTE_ADDR'};
-    ($sec, $min, $hr, $mday, $mon, $year, $wday, $yday, $isdst) = localtime(time);
-    $year=$year+1900;
-    $mon += 1;
-    # Fix for 0's
-    $mon = sprintf("%02d", $mon);
-    $mday = sprintf("%02d", $mday);
-    $sec = sprintf("%02d", $sec);
-    $min = sprintf("%02d", $min);
-    $hr = sprintf("%02d", $hr);
-    AppendStringToFile($BannedFile, "$year/$mon/$mday\t$hr:$min:$sec\t$visitor: $OpenPageName - $rule\n");
-  }
+  my $rule = LogOldBannedContent($str);
+  LogWrite($rule) if $rule;
   return $rule;
 }
+
+*LogOldUserIsBanned = *UserIsBanned;
+*UserIsBanned = *LogNewUserIsBanned;
+
+sub LogNewUserIsBanned {
+  my $str = shift;
+  my $rule = LogOldUserIsBanned($str);
+  LogWrite(Ts('Host or IP matched %s', $rule)) if $rule;
+  return $rule;
+}
+
+sub LogWrite {
+  my $rule = shift;
+  my $id = $OpenPageName || GetId();
+  AppendStringToFile($BannedFile,
+		     join("\t", TimeToW3($Now), $ENV{'REMOTE_ADDR'}, $id, $rule)
+		     . "\n");
+}

modules/mail.pl

@@ -102,7 +102,7 @@ sub MailIsSubscribed {
   # open the DB file
   require DB_File;
   tie %h, "DB_File", $MailFile;
-  my %subscribers = map {$_=>1} split(/$FS/, $h{$id});
+  my %subscribers = map {$_=>1} split(/$FS/, UrlDecode($h{UrlEncode($id)}));
   untie %h;
   return $subscribers{$mail};
 }
@@ -179,13 +179,13 @@ sub MailDeletePage {
   my $id = shift;
   require DB_File;
   tie %h, "DB_File", $MailFile;
-  foreach my $mail (split(/$FS/, delete $h{$id})) {
-    my %subscriptions = map {$_=>1} split(/$FS/, $h{$mail});
+  foreach my $mail (split(/$FS/, UrlDecode(delete $h{UrlEncode($id)}))) {
+    my %subscriptions = map {$_=>1} split(/$FS/, UrlDecode($h{UrlEncode($mail)}));
     delete $subscriptions{$id};
     if (%subscriptions) {
-      $h{$mail} = join($FS, keys %subscriptions);
+      $h{UrlEncode($mail)} = UrlEncode(join($FS, keys %subscriptions));
     } else {
-      delete $h{$mail};
+      delete $h{UrlEncode($mail)};
     }
   }
   untie %h;
@@ -256,7 +256,7 @@ sub MailSubscription {
   return unless $mail;
   require DB_File;
   tie %h, "DB_File", $MailFile;
-  my @result = split(/$FS/, $h{$mail});
+  my @result = split(/$FS/, UrlDecode($h{UrlEncode($mail)}));
   untie %h;
   return sort @result;
 }
@@ -283,15 +283,16 @@ sub DoMailSubscriptionList {
       '<ul>';
   }
   require DB_File;
+
   tie %h, "DB_File", $MailFile;
-  foreach my $key (sort keys %h) {
-    my @values = sort split(/$FS/, $h{$key});
+  foreach my $encodedkey (sort keys %h) {
+    my @values = sort split(/$FS/, UrlDecode($h{$encodedkey}));
+    my $key = UrlDecode($encodedkey);
     if ($raw) {
       print join(' ', $key, @values) . "\n";
     } else {
         print $q->li(Ts('%s: ', MailLink($key, @values)),
-		     join(' ', map { MailLink($_, $key) }
-			  sort split(/$FS/, $h{$key})));
+		     join(' ', map { MailLink($_, $key) } @values));
     }
   }
   print '</ul></div>' unless $raw;
@@ -363,16 +364,16 @@ sub MailSubscribe {
   require DB_File;
   tie %h, "DB_File", $MailFile;
   # add to the mail entry
-  my %subscriptions = map {$_=>1} split(/$FS/, $h{$mail});
+  my %subscriptions = map {$_=>1} split(/$FS/, UrlDecode($h{UrlEncode($mail)}));
   for my $id (@pages) {
     $subscriptions{$id} = 1;
   }
-  $h{$mail} = join($FS, keys %subscriptions);
+  $h{UrlEncode($mail)} = UrlEncode(join($FS, keys %subscriptions));
   # add to the page entries
   for my $id (@pages) {
-    my %subscribers = map {$_=>1} split(/$FS/, $h{$id});
+    my %subscribers = map {$_=>1} split(/$FS/, UrlDecode($h{UrlEncode($id)}));
     $subscribers{$mail} = 1;
-    $h{$id} = join($FS, keys %subscribers);
+    $h{UrlEncode($id)} = UrlEncode(join($FS, keys %subscribers));
   }
   untie %h;
   # changes made will affect how pages look
@@ -420,53 +421,67 @@ sub MailUnsubscribe {
   return unless $mail and @pages;
   require DB_File;
   tie %h, "DB_File", $MailFile;
-  my %subscriptions = map {$_=>1} split(/$FS/, $h{$mail});
+  my %subscriptions = map {$_=>1} split(/$FS/, UrlDecode($h{UrlEncode($mail)}));
   foreach my $id (@pages) {
     delete $subscriptions{$id};
     # take care of reverse lookup
-    my %subscribers = map {$_=>1} split(/$FS/, $h{$id});
+    my %subscribers = map {$_=>1} split(/$FS/, UrlDecode($h{UrlEncode($id)}));
     delete $subscribers{$mail};
     if (%subscribers) {
-      $h{$id} = join($FS, keys %subscribers);
+      $h{UrlEncode($id)} = UrlEncode(join($FS, keys %subscribers));
     } else {
-      delete $h{$id};
+      delete $h{UrlEncode($id)};
     }
   }
   if (%subscriptions) {
-    $h{$mail} = join($FS, keys %subscriptions);
+    $h{UrlEncode($mail)} = UrlEncode(join($FS, keys %subscriptions));
   } else {
-    delete $h{$mail} unless %subscriptions;
+    delete $h{UrlEncode($mail)} unless %subscriptions;
   }
   untie %h;
   # changes made will affect how pages look
   SetParam('sub', GetParam('sub', 0) + 1);
 }
 
-=head1 Sending Mail
+=head1 Migrate
 
-The actual sending of emails depends on setting the appropriate
-options.
-
-C<$MailServer>: This defaults to localhost. If you have Oddmuse
-installed on a full server that includes an SMTP server such as
-sendmail or postfix, you might get away with not setting any of the
-variables.
-
-C<$MailUser>: Chances are you will need to authenticate before you can
-send an email via your mail server. Specify the name here.
-
-C<$MailPassword>: Specify the password here.
-
-C<$MailFrom>: Often mail servers know which email addresses they
-serve. If somebody else tries to use them, they'll return an error
-saying that "relaying is not allowed". If you are allowed to use the
-mail server, use this option to set the appropriate sender address.
-
-Example setup:
-
-    $MailServer = 'smtp.google.com';
-    $MailUser = 'kensanata';
-    $MailPassword = '*secret*';
-    $MailFrom = 'kensanata@gmail.com';
+The mailmigrate action will migrate your subscription list from the
+old format to the new format. This is necessary because these days
+because the keys and values of the DB_File are URL encoded.
 
 =cut
+
+$Action{'migrate-subscriptions'} = \&DoMailMigration;
+
+sub DoMailMigration {
+  UserIsAdminOrError();
+  print GetHeader('', T('Migrating Subscriptions')),
+    $q->start_div({-class=>'content mailmigrate'});
+
+  require DB_File;
+
+  tie %h, "DB_File", $MailFile;
+  my $found = 0;
+  foreach my $key (keys %h) {
+    if (index($key, '@') != -1) {
+      $found = 1;
+      last;
+    }
+  }
+
+  if (not $found) {
+    print $q->p(T('No non-migrated email addresses found, migration not necessary.'));
+  } else {
+    my %n;
+    foreach my $key (sort keys %h) {
+      my $value = $h{$key};
+      my @values = sort split(/$FS/, $value);
+      $n{UrlEncode($key)} = join($FS, map { UrlEncode($_) } @values);
+    }
+    %h = %n;
+    print $q->p(Ts('Migrated %s rows.', scalar(keys %n)));
+  }
+  print '</div>';
+  untie %h;
+  PrintFooter();
+}

modules/markup.pl

@@ -144,6 +144,8 @@ sub MarkupRule {
     return CloseHtmlEnvironments()
       . MarkupTag($MarkupLines{UnquoteHtml($tag)}, $str)
       . AddHtmlEnvironment('p');
+  } elsif (%MarkupSingles and m/$markup_singles_re/gc) {
+    return $MarkupSingles{UnquoteHtml($1)};
   } elsif (%MarkupForcedPairs and m/$markup_forced_pairs_re/gc) {
     my $tag = $1;
     my $start = $tag;
@@ -170,8 +172,6 @@ sub MarkupRule {
     }
   } elsif (%MarkupPairs and m/$markup_pairs_re/gc) {
     return MarkupTag($MarkupPairs{UnquoteHtml($1)}, $2);
-  } elsif (%MarkupSingles and m/$markup_singles_re/gc) {
-    return $MarkupSingles{UnquoteHtml($1)};
   } elsif ($MarkupPairs{'/'} and m|\G~/|gc) {
     return '~/'; # fix ~/elisp/ example
   } elsif ($MarkupPairs{'/'} and m|\G(/[-A-Za-z0-9\x{0080}-\x{fffd}/]+/$words/)|gc) {

modules/national-days-de.pl

@@ -64,6 +64,7 @@ $ModulesDescription .= '<p><a href="http://git.savannah.gnu.org/cgit/oddmuse.git
   '4-17' => 'Syrien: Abzug der letzten französischen Mandatstruppen 1946',
   '4-18' => 'Simbabwe: Erlangung der Unabhängigkeit',
   '4-19' => 'Jahrestag der Papstwahl (Benedikt XVI.)',
+  '4-25' => 'Italien: Tag der Befreiung 1945',
   '4-26' => 'Tansania: Jahrestag der Vereinigung von Tanganjika und Sansibar 1964',
   '4-27' => 'Afghanistan: Tag der Revolution, Sierra Leone: Erlangung der Unabhängigkeit 1961, Südafrika: Tag der ersten freien Wahlen 1994, Togo: Erlangung der Unabhängigkeit 1960',
   '4-30' => 'Niederlande: Königinnentag',

modules/national-days.pl

@@ -51,6 +51,7 @@ $ModulesDescription .= '<p><a href="http://git.savannah.gnu.org/cgit/oddmuse.git
    '4-17' => 'Syria, National Day',
    '4-18' => 'Zimbabwe, National Day',
    '4-19' => 'Sierra Leone, Republic Day',
+   '4-25' => 'Italy, Liberation Day',
    '4-26' => 'Tanzania, Union Day, Israel, Independence Day',
    '4-27' => 'Federal Republic of Yugoslavia, National Day, Togo, Togolais National Day, South Africa, Freedom Day',
    '4-30' => 'The Netherlands, Official Birthday of Her Majesty Queen Beatrix',
@@ -66,7 +67,7 @@ $ModulesDescription .= '<p><a href="http://git.savannah.gnu.org/cgit/oddmuse.git
    '5-26' => 'Georgia, National Day',
    '5-28' => 'Ethiopia, National Day, Azerbaijan, National Day',
    '6-1' => 'Samoa, Independence Day',
-   '6-2' => 'Italy, Foundation of the Republic',
+   '6-2' => 'Italy, Republic Day',
    '6-4' => 'Tonga, Emancipation Day',
    '6-6' => 'Sweden, National Day',
    '6-10' => 'Portugal, Portugal Day, Camões Day and Day of Portuguese Communities',

modules/tags.pl

@@ -127,10 +127,10 @@ sub NewTagSave { # called within a lock!
   # an encoded string; the alternative would be to use a form of
   # freeze and thaw.
   foreach my $tag (keys %tag) {
-    my %file = map {$_=>1} split(/$FS/, $h{$tag});
+    my %file = map {$_=>1} split(/$FS/, UrlDecode($h{UrlEncode($tag)}));
     if (not $file{$id}) {
       $file{$id} = 1;
-      $h{$tag} = join($FS, keys %file);
+      $h{UrlEncode($tag)} = UrlEncode(join($FS, keys %file));
     }
   }
 
@@ -138,16 +138,16 @@ sub NewTagSave { # called within a lock!
   # tags used. This allows us to delete the references that no longer
   # show up without looping through them all. The files are indexed
   # with a starting underscore because this is an illegal tag name.
-  foreach my $tag (split (/$FS/, $h{"_$id"})) {
+  foreach my $tag (split (/$FS/, UrlDecode($h{UrlEncode("_$id")}))) {
     # If the tag we're looking at is no longer listed, we have work to
     # do.
     if (!$tag{$tag}) {
-      my %file = map {$_=>1} split(/$FS/, $h{$tag});
+      my %file = map {$_=>1} split(/$FS/, UrlDecode($h{UrlEncode($tag)}));
       delete $file{$id};
       if (%file) {
-	$h{$tag} = join($FS, keys %file);
+	$h{UrlEncode($tag)} = UrlEncode(join($FS, keys %file));
       } else {
-	delete $h{$tag};
+	delete $h{UrlEncode($tag)};
       }
     }
   }
@@ -155,9 +155,9 @@ sub NewTagSave { # called within a lock!
   # Store the new reverse lookup of all the tags used on the current
   # page. If no more tags appear on this page, delete the entry.
   if (%tag) {
-    $h{"_$id"} = join($FS, keys %tag);
+    $h{UrlEncode("_$id")} = UrlEncode(join($FS, keys %tag));
   } else {
-    delete $h{"_$id"};
+    delete $h{UrlEncode("_$id")};
   }
 
   untie %h;
@@ -183,18 +183,18 @@ sub NewTagDeletePage { # called within a lock!
   # For each file in our hash, we have a reverse lookup of all the
   # tags used. This allows us to delete the references that no longer
   # show up without looping through them all.
-  foreach my $tag (split (/$FS/, $h{"_$id"})) {
-    my %file = map {$_=>1} split(/$FS/, $h{$tag});
+  foreach my $tag (split (/$FS/, UrlDecode($h{UrlEncode("_$id")}))) {
+    my %file = map {$_=>1} split(/$FS/, UrlDecode($h{UrlEncode($tag)}));
     delete $file{$id};
     if (%file) {
-      $h{$tag} = join($FS, keys %file);
+      $h{UrlEncode($tag)} = UrlEncode(join($FS, keys %file));
     } else {
-      delete $h{$tag};
+      delete $h{UrlEncode($tag)};
     }
   }
 
   # Delete reverse lookup entry.
-  delete $h{"_$id"};
+  delete $h{UrlEncode("_$id")};
   untie %h;
 
   # Return any error codes?
@@ -217,8 +217,7 @@ sub TagFind {
   tie %h, "DB_File", $TagFile;
   my %page;
   foreach my $tag (@tags) {
-    foreach my $id (split(/$FS/, $h{lc($tag)})) {
-      utf8::decode($id);
+    foreach my $id (split(/$FS/, UrlDecode($h{UrlEncode(lc($tag))}))) {
       $page{$id} = 1;
     }
   }
@@ -292,20 +291,20 @@ sub TagCloud {
   my $max = 0;
   my $min = 0;
   my %count = ();
-  foreach my $tag (grep !/^_/, keys %h) {
-    $count{$tag} = split(/$FS/, $h{$tag});
-    $max = $count{$tag} if $count{$tag} > $max;
-    $min = $count{$tag} if not $min or $count{$tag} < $min;
+  foreach my $encoded_tag (grep !/^_/, keys %h) {
+    $count{$encoded_tag} = split(/$FS/, $h{$encoded_tag});
+    $max = $count{$encoded_tag} if $count{$encoded_tag} > $max;
+    $min = $count{$encoded_tag} if not $min or $count{$encoded_tag} < $min;
   }
   untie %h;
-  foreach my $tag (sort keys %count) {
-    my $n = $count{$tag};
-    print $q->a({-href  => "$ScriptName?search=tag:" . UrlEncode($tag),
+  foreach my $encoded_tag (sort keys %count) {
+    my $n = $count{$encoded_tag};
+    print $q->a({-href  => "$ScriptName?search=tag:" . $encoded_tag,
 		 -title => $n,
 		 -style => 'font-size: '
 		 . int(80+120*($max == $min ? 1 : ($n-$min)/($max-$min)))
 		 . '%;',
-		}, NormalToFree($tag)), T(' ... ');
+		}, NormalToFree(UrlDecode($encoded_tag))), T(' ... ');
   }
   print '</p></div>';
   PrintFooter();
@@ -352,21 +351,18 @@ sub DoTagsReindex {
        $Page{text} =~ m/\[\[tag:$FreeLinkPattern\|([^]|]+)\]\]/g);
     next unless %tag;
 
-    # utf8::encode($id);
-    # back to bytes for the following installation:
-    # This is perl, v5.10.1 (*) built for i486-linux-gnu-thread-multi
-    # (with 56 registered patches, see perl -V for more detail)
-    # (FIXME: get rid of this call, or explain why no UTF-8 can be stored in %h)
-
     # For each tag we list the files tagged. Add the current file for
     # all tags.
     foreach my $tag (keys %tag) {
-      $h{$tag} = $h{$tag} ? $h{$tag} . $FS . $id : $id;
+      my $encoded_tag = UrlEncode($tag);
+      $h{$encoded_tag} = $h{$encoded_tag}
+	? $h{$encoded_tag} . UrlEncode($FS . $id)
+	: UrlEncode($id);
     }
 
     # Store the reverse lookup of all the tags used on the current
     # page.
-    $h{"_$id"} = join($FS, keys %tag);
+    $h{UrlEncode("_$id")} = UrlEncode(join($FS, keys %tag));
   }
 
   untie %h;
@@ -391,8 +387,8 @@ sub TagList {
   # open the DB file
   require DB_File;
   tie %h, "DB_File", $TagFile;
-  foreach my $id (sort keys %h) {
-    print "$id: " . join(', ', split(/$FS/, $h{$id})) . "\n";
+  foreach my $id (sort map { UrlDecode($_) } keys %h) {
+    print "$id: " . join(', ', split(/$FS/, UrlDecode($h{UrlEncode($id)}))) . "\n";
   }
   untie %h;
 }
@@ -416,7 +412,7 @@ sub TagsMenu {
 
 =head1 COPYRIGHT AND LICENSE
 
-Copyright (C) 2005, 2009  Alex Schroeder <alex@gnu.org>
+Copyright (C) 2005, 2009, 2013  Alex Schroeder <alex@gnu.org>
 
 This program is free software; you can redistribute it and/or modify
 it under the terms of the GNU General Public License as published by

modules/tex.pl

@@ -170,6 +170,10 @@ $TexRe = qr{$TexRe};
 
 push(@MyRules, \&TexRule);
 
+# use of -- conflicts with MarkupRules such as the following:
+# $MarkupForcedPairs{'--'} = 'del';
+$RuleOrder{\&TexRule} = 160;
+
 sub TexRule {
   if (m/\G$TexRe/goc) {
     return $Tex{$1};

modules/timezone.pl

@@ -25,7 +25,9 @@ $defaultTZ = 'UTC';
 $CookieParameters{time} = '';
 
 sub TZget {
-  my $dt = DateTime->from_epoch(epoch=>shift);
+  my $ts = shift;
+  $ts = 0 if not defined($ts);
+  my $dt = DateTime->from_epoch(epoch=>$ts);
   my $tz = GetParam('time', '');
   # setting time= will use the (defined) empty string, so avoid that
   $tz = $defaultTZ unless $tz;

modules/toc-js.pl

@@ -0,0 +1,98 @@
+# Copyright (C) 2013  Alex Schroeder <alex@gnu.org>
+#
+# This program is free software; you can redistribute it and/or modify it under
+# the terms of the GNU General Public License as published by the Free Software
+# Foundation; either version 3 of the License, or (at your option) any later
+# version.
+#
+# This program is distributed in the hope that it will be useful, but WITHOUT
+# ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or FITNESS
+# FOR A PARTICULAR PURPOSE. See the GNU General Public License for more details.
+#
+# You should have received a copy of the GNU General Public License along with
+# this program. If not, see <http://www.gnu.org/licenses/>.
+
+package OddMuse;
+
+$ModulesDescription .= '<p><a href="http://git.savannah.gnu.org/cgit/oddmuse.git/tree/modules/toc-js.pl">toc-js.pl</a>, see <a href="http://www.oddmuse.org/cgi-bin/oddmuse/Javascript_Table_of_Contents_Extension">Javascript Table of Contents Extension</a></p>';
+
+use vars qw($TocOutlineLibrary);
+
+$TocOutlineLibrary = 'http://h5o.googlecode.com/files/outliner.0.5.0.62.js';
+
+# Add the dojo script to edit pages.
+push (@MyInitVariables, \&TocScript);
+
+sub TocScript {
+  # cookie is not initialized yet so we cannot use GetParam
+  # Cross browser compatibility: http://www.tek-tips.com/faqs.cfm?fid=4862
+  # HTML5 Outlines: http://blog.tremily.us/posts/HTML5_outlines/
+  # Required library: http://code.google.com/p/h5o/
+  if (GetParam('action', 'browse') eq 'browse') {
+    $HtmlHeaders .= qq{
+<script type="text/javascript" src="$TocOutlineLibrary"></script>
+<script type="text/javascript">
+
+  function addOnloadEvent(fnc) {
+    if ( typeof window.addEventListener != "undefined" )
+      window.addEventListener( "load", fnc, false );
+    else if ( typeof window.attachEvent != "undefined" ) {
+      window.attachEvent( "onload", fnc );
+    }
+    else {
+      if ( window.onload != null ) {
+	var oldOnload = window.onload;
+	window.onload = function ( e ) {
+	  oldOnload( e );
+	  window[fnc]();
+	};
+      }
+      else
+	window.onload = fnc;
+    }
+  }
+
+  var initToc=function() {
+
+    var outline = HTML5Outline(document.body);
+    if (outline.sections.length == 1) {
+      outline.sections = outline.sections[0].sections;
+    }
+
+    if (outline.sections.length > 1
+	|| outline.sections.length == 1
+           && outline.sections[0].sections.length > 0) {
+
+      var toc = document.getElementById('toc');
+
+      if (!toc) {
+	var divs = document.getElementsByTagName('div');
+	for (var i = 0; i < divs.length; i++) {
+	  if (divs[i].getAttribute('class') == 'toc') {
+	    toc = divs[i];
+	    break;
+	  }
+	}
+      }
+
+      if (!toc) {
+	var h2 = document.getElementsByTagName('h2')[0];
+	if (h2) {
+	  toc = document.createElement('div');
+	  toc.setAttribute('class', 'toc');
+	  h2.parentNode.insertBefore(toc, h2);
+	}
+      }
+
+      if (toc) {
+        var html = outline.asHTML(true);
+        toc.innerHTML = html;
+      }
+    }
+  }
+
+  addOnloadEvent(initToc);
+  </script>
+};
+  }
+}

modules/translations/spanish-utf8.pl

@@ -498,7 +498,7 @@ Interlinks:
 Too many connections by %s
 Demasiadas conexiones por %s
 Please do not fetch more than %1 pages in %2 seconds.
-Por favor, no visites más de %1 páginas en %s segundos.
+Por favor, no visites más de %1 páginas en %2 segundos.
 Check whether the web server can create the directory %s and whether it can create files in it.
 Comprueba si el servidor web puede crear el directorio %s y si puede crear archivos en él. 
 Copy one of the following stylesheets to %s:

rc2mail.pl

@@ -148,9 +148,12 @@ sub send_file {
   warn "No content for $title\n" unless $item->{description};
   my $link = $item->{link};
   my $sub = "$root?action=subscriptions";
-  print $fh qq(<p>Visit <a href="$link">$title</a>)
+  my $text = qq(<p>Visit <a href="$link">$title</a>)
     . qq( or <a href="$sub">manage your subscriptions</a>.</p><hr />)
     . $item->{description};
+  # prevent 501 Syntax error - line too long
+  $text =~ s/<(p|h[1-6]|[duo]l|pre|li|form|div|blockquote|hr|table|tr)>/\r\n<$1>/gi;
+  print $fh $text;
   $fh->close;
   foreach my $subscriber (@subscribers) {
     send_mail($subscriber, $title, $fh);

t/creole.t

@@ -1,5 +1,5 @@
 #!/usr/bin/env perl
-# Copyright (C) 2006, 2007, 2008, 2009  Alex Schroeder <alex@gnu.org>
+# Copyright (C) 2006-2013  Alex Schroeder <alex@gnu.org>
 #
 # This program is free software; you can redistribute it and/or modify
 # it under the terms of the GNU General Public License as published by
@@ -16,7 +16,7 @@
 
 require 't/test.pl';
 package OddMuse;
-use Test::More tests => 107;
+use Test::More tests => 108;
 clear_pages();
 
 add_module('creole.pl');
@@ -159,6 +159,8 @@ CamelCaseLink
 ~ does not escape whitespace
 foo ~bar
 foo bar
+| 1|foo |
+<table class="user"><tr><td align="right">1</td><td>foo </td></tr></table>
 EOT
 
 xpath_run_tests(split('\n',<<'EOT'));

t/diff.t

@@ -1,27 +1,31 @@
-# Copyright (C) 2006  Alex Schroeder <alex@emacswiki.org>
+# Copyright (C) 2006-2013  Alex Schroeder <alex@gnu.org>
+
+# This program is free software: you can redistribute it and/or modify it under
+# the terms of the GNU General Public License as published by the Free Software
+# Foundation, either version 3 of the License, or (at your option) any later
+# version.
 #
-# This program is free software; you can redistribute it and/or modify
-# it under the terms of the GNU General Public License as published by
-# the Free Software Foundation; either version 2 of the License, or
-# (at your option) any later version.
+# This program is distributed in the hope that it will be useful, but WITHOUT
+# ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or FITNESS
+# FOR A PARTICULAR PURPOSE. See the GNU General Public License for more details.
 #
-# This program is distributed in the hope that it will be useful,
-# but WITHOUT ANY WARRANTY; without even the implied warranty of
-# MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
-# GNU General Public License for more details.
-#
-# You should have received a copy of the GNU General Public License
-# along with this program; if not, write to the
-#    Free Software Foundation, Inc.
-#    59 Temple Place, Suite 330
-#    Boston, MA 02111-1307 USA
+# You should have received a copy of the GNU General Public License along with
+# this program. If not, see <http://www.gnu.org/licenses/>.
 
 require 't/test.pl';
 package OddMuse;
-use Test::More tests => 21;
+use Test::More tests => 25;
+use utf8;
 
 clear_pages();
 
+# encoding stuff
+update_page('dash', "- en ‘dash’\n");
+update_page('dash', "- en ‘dash’\n— em “dash”\n");
+test_page(get_page('action=browse diff=1 id=dash'),
+	  '<div class="new"><p>&gt; — em “dash”</p></div>',
+	  '- en ‘dash’ — em “dash”');
+
 # Highlighting differences
 update_page('xah', "When we judge people in society, often, we can see people's true nature not by the official defenses and behaviors, but by looking at the statistics (past records) of their behavior and the circumstances it happens.\n"
 	    . "For example, when we look at the leader in human history. Great many of them have caused thousands and millions of intentional deaths. Some of these leaders are hated by many, yet great many of them are adored and admired and respected... (ok, i'm digressing...)\n");
@@ -54,11 +58,13 @@ test_page(get_page('action=history id=david'),
 	  'Revision 4', 'fourth revision');
 # using diffrevision=1 will make sure that the third revision is not shown
 xpath_test(get_page('action=browse diff=1 id=david revision=2 diffrevision=1'),
+	   '//p[@class="summary"][text()="Summary: second revision"]',
 	   '//div[@class="old"]/p/strong[text()="first"]',
 	   '//div[@class="new"]/p/strong[text()="second"]',
 	   '//div[@class="content browse"]/p[text()="this is the second revision"]');
 # check with cache = 0
 xpath_test(get_page('action=browse diff=1 id=david revision=2 diffrevision=1 cache=0'),
+	   '//p[@class="summary"][text()="Summary: second revision"]',
 	   '//div[@class="old"]/p/strong[text()="first"]',
 	   '//div[@class="new"]/p/strong[text()="second"]',
 	   '//div[@class="content browse"]/p[text()="this is the second revision"]');

t/duckduckgo-search.t

@@ -0,0 +1,55 @@
+# Copyright (C) 2007–2013  Alex Schroeder <alex@gnu.org>
+#
+# This program is free software: you can redistribute it and/or modify it under
+# the terms of the GNU General Public License as published by the Free Software
+# Foundation, either version 3 of the License, or (at your option) any later
+# version.
+#
+# This program is distributed in the hope that it will be useful, but WITHOUT
+# ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or FITNESS
+# FOR A PARTICULAR PURPOSE. See the GNU General Public License for more details.
+#
+# You should have received a copy of the GNU General Public License along with
+# this program. If not, see <http://www.gnu.org/licenses/>.
+
+require 't/test.pl';
+package OddMuse;
+use Test::More tests => 9;
+clear_pages();
+
+add_module('duckduckgo-search.pl');
+
+DuckDuckGoSearchInit();
+is($DuckDuckGoSearchDomain, undef, 'No $ScriptName');
+
+$DuckDuckGoSearchDomain = undef;
+$ScriptName = 'http://www.communitywiki.org/en';
+DuckDuckGoSearchInit();
+is($DuckDuckGoSearchDomain, 'communitywiki.org', $ScriptName);
+
+$DuckDuckGoSearchDomain = undef;
+$ScriptName = 'http://www.community.org:80/';
+DuckDuckGoSearchInit();
+is($DuckDuckGoSearchDomain, 'community.org', $ScriptName);
+
+$DuckDuckGoSearchDomain = undef;
+$ScriptName = 'http://www.communitywiki.org';
+DuckDuckGoSearchInit();
+is($DuckDuckGoSearchDomain, 'communitywiki.org', $ScriptName);
+
+$DuckDuckGoSearchDomain = undef;
+$ScriptName = 'http://emacswiki.org/cgi-bin/emacs';
+DuckDuckGoSearchInit();
+is($DuckDuckGoSearchDomain, 'emacswiki.org', $ScriptName);
+
+$DuckDuckGoSearchDomain = undef;
+$ScriptName = 'http://localhost/wiki.pl';
+DuckDuckGoSearchInit();
+isnt($DuckDuckGoSearchDomain, 'localhost', $ScriptName);
+
+test_page(get_page('search=alex'),
+	  '<title>Wiki: Search for: alex</title>');
+AppendStringToFile($ConfigFile, "\$ScriptName = 'http://emacswiki.org/';\n");
+test_page(get_page('search=alex'),
+	  'Status: 302',
+	  'Location: https://www.duckduckgo.com/\?q=alex\+site%3Aemacswiki\.org');

t/encoding.t

@@ -84,7 +84,7 @@ AppendStringToFile($ConfigFile, "use utf8;\n\$CookieParameters{ärger} = 1;\n");
 test_page(get_page('action=browse id=Test %C3%A4rger=hallo'),
 	  'Set-Cookie: Wiki=%C3%A4rger%251ehallo');
 
-# this causes wide character in print somehow? otherwise harmless
+# create a test page to test the output in various ways
 test_page(update_page("Russian", "Русский Hello"),
 	  "Русский");
 

t/fix-encoding.t

@@ -14,17 +14,27 @@
 
 require 't/test.pl';
 package OddMuse;
-use Test::More tests => 8;
+use Test::More tests => 12;
 use utf8; # tests contain UTF-8 characters and it matters
 
 clear_pages();
 add_module('fix-encoding.pl');
 
-# make sure the menu only shows up if it applies to a page
+# make sure no menu shows if no page is provided
 
 test_page_negative(get_page('action=admin'), 'action=fix-encoding');
+
+# make sure no menu shows up if the page does not exists
+
 test_page(get_page('action=admin id=foo'), 'action=fix-encoding;id=foo');
 
+# make sure nothing is saved if the page does not exist
+
+test_page(get_page('action=fix-encoding id=Example'),
+	  'Location: http://localhost/wiki.pl/Example');
+
+test_page_negative(get_page('action=rc showedit=1'), 'fix encoding');
+
 # make sure nothing is saved if there is no change
 
 test_page(update_page('Example', 'Pilgerstätte für die Göttin'),
@@ -35,9 +45,15 @@ test_page(get_page('action=fix-encoding id=Example'),
 
 test_page_negative(get_page('action=rc showedit=1'), 'fix encoding');
 
+# the menu shows up if the page exists
+
+test_page(get_page('action=admin id=Example'),
+	  'action=fix-encoding;id=Example');
+
 # here is an actual page you need to fix
 
-test_page(update_page('Example', 'Pilgerstätte für die Göttin', 'borked encoding'),
+test_page(update_page('Example', 'Pilgerstätte für die Göttin',
+		      'borked encoding'),
 	  'Pilgerstätte für die Göttin');
 
 test_page(get_page('action=fix-encoding id=Example'),
@@ -45,3 +61,5 @@ test_page(get_page('action=fix-encoding id=Example'),
 
 test_page(get_page('Example'),
 	  'Pilgerstätte für die Göttin');
+
+test_page(get_page('action=rc showedit=1'), 'fix encoding');

t/mail.t

@@ -15,13 +15,40 @@
 
 require 't/test.pl';
 package OddMuse;
-use Test::More tests => 45;
+use utf8; # tests contain UTF-8 characters and it matters
+use Test::More tests => 52;
 
 clear_pages();
 
 AppendStringToFile($ConfigFile, "\$CommentsPrefix = 'Comments on ';\n");
 
 add_module('mail.pl');
+Init(); # set $MailFile
+
+# tests migration
+require DB_File;
+tie %h, "DB_File", $MailFile;
+$h{'alex@gnu.org'} = 'Unregelmässige_Spieler';
+$h{'Unregelmässige_Spieler'} = 'alex@gnu.org';
+untie %h;
+
+test_page(get_page('action=migrate-subscriptions pwd=foo'),
+	  'Migrated 2 rows');
+test_page(get_page('action=migrate-subscriptions pwd=foo'),
+	  'migration not necessary');
+
+test_page(get_page('action=subscriptionlist pwd=foo raw=1'),
+	  'alex@gnu.org Unregelmässige_Spieler',
+	  'Unregelmässige_Spieler alex@gnu.org');
+
+# make a test with a character that cannot be Latin-1 encoded
+# ★ #x2605 => xE2 #x98 #x85 in UTF-8
+test_page(get_page('title=Comments_on_%e2%98%85 aftertext=test username=Alex '
+		 . 'mail=berta@example.com notify=1'),
+	  'Set-Cookie:.*mail%251eberta%40example.com');
+test_page(get_page('action=subscriptionlist pwd=foo raw=1'),
+	  'Comments_on_★ berta@example.com',
+	  'berta@example.com Comments_on_★');
 
 # edit page
 $page = get_page('Comments_on_Foo');

t/tags.t

@@ -45,24 +45,24 @@ xpath_run_tests(split('\n',<<'EOT'));
 EOT
 
 update_page('Brilliant', 'Gameologists [[tag:podcast]] [[tag:mag]]');
-update_page('Pödgecäst', 'Another [[tag:podcast]]');
+update_page('Pödgecäst´s', 'Another [[tag:podcast]]');
 update_page('Alex', 'Me! [[tag:Old School]]');
 
 # open the DB file
 require DB_File;
 tie %h, "DB_File", $TagFile;
 
-%tag = map {$_=>1} split($FS, $h{"_Brilliant"});
+%tag = map {$_=>1} split($FS, UrlDecode($h{UrlEncode("_Brilliant")}));
 ok($tag{podcast}, 'Brilliant page tagged podcast');
 ok($tag{mag}, 'Brilliant page tagged mag');
-%tag = map {$_=>1} split($FS, $h{"_Pödgecäst"});
-ok($tag{podcast}, 'Pödgecäst page tagged podcast');
-%file = map {$_=>1} split($FS, $h{"podcast"});
+%tag = map {$_=>1} split($FS, UrlDecode($h{UrlEncode("_Pödgecäst´s")}));
+ok($tag{podcast}, 'Pödgecäst´s page tagged podcast');
+%file = map {$_=>1} split($FS, UrlDecode($h{UrlEncode("podcast")}));
 ok($file{Brilliant}, 'Tag podcast applies to page Brilliant');
-ok($file{Pödgecäst}, 'Tag podcast applies to page Pödgecäst');
-%file = map {$_=>1} split($FS, $h{"mag"});
+ok($file{"Pödgecäst´s"}, 'Tag podcast applies to page Pödgecäst´s');
+%file = map {$_=>1} split($FS, UrlDecode($h{UrlEncode("mag")}));
 ok($file{Brilliant}, 'Tag mag applies to page Brilliant');
-%file = map {$_=>1} split($FS, $h{"old_school"});
+%file = map {$_=>1} split($FS, UrlDecode($h{UrlEncode("old_school")}));
 ok($file{Alex}, 'Tag Old School applies to page Alex');
 
 # close the DB file before making changes via the wiki!
@@ -73,12 +73,12 @@ update_page('Brilliant', 'Gameologists [[tag:mag]]');
 # reopen changed file
 tie %h, "DB_File", $TagFile;
 
-%tag = map {$_=>1} split($FS, $h{"_Brilliant"});
+%tag = map {$_=>1} split($FS, UrlDecode($h{UrlEncode("_Brilliant")}));
 ok(!$tag{podcast}, 'Brilliant page no longer tagged podcast');
 ok($tag{mag}, 'Brilliant page still tagged mag');
-%file = map {$_=>1} split($FS, $h{"podcast"});
+%file = map {$_=>1} split($FS, UrlDecode($h{UrlEncode("podcast")}));
 ok(!$file{Brilliant}, 'Tag podcast no longer applies to page Brilliant');
-ok($file{Pödgecäst}, 'Tag podcast still applies to page Pödgecäst');
+ok($file{"Pödgecäst´s"}, 'Tag podcast still applies to page Pödgecäst´s');
 
 # close the DB file before making changes via the wiki!
 untie %h;
@@ -88,8 +88,8 @@ DeletePage('Brilliant');
 # reopen changed file
 tie %h, "DB_File", $TagFile;
 
-ok(!$h{_Brilliant}, 'Brilliant page no longer exists');
-ok(!exists($h{mag}), 'No page tagged mag exists');
+ok(!$h{UrlEncode("_Brilliant")}, 'Brilliant page no longer exists');
+ok(!exists($h{UrlEncode("mag")}), 'No page tagged mag exists');
 
 # close the DB file before making changes via the wiki!
 untie %h;
@@ -101,46 +101,46 @@ update_page('Jeff', 'a blog [[tag:Old School]]');
 
 # ordinary search finds Alex
 $page = get_page('search=podcast raw=1');
-test_page($page, qw(Pödgecäst Brilliant Sons Alex));
+test_page($page, qw(Pödgecäst´s Brilliant Sons Alex));
 
 # tag search skips Alex
 $page = get_page('search=tag:podcast raw=1');
-test_page($page, qw(Pödgecäst Brilliant Sons));
+test_page($page, qw(Pödgecäst´s Brilliant Sons));
 test_page_negative($page, qw(Alex));
 
 # tag search is case insensitive
 $page = get_page('search=tag:PODCAST raw=1');
-test_page($page, qw(Pödgecäst Brilliant Sons));
+test_page($page, qw(Pödgecäst´s Brilliant Sons));
 test_page_negative($page, qw(Alex));
 
 # exclude tag search skips Brilliant
 $page = get_page('search=-tag:mag raw=1');
-test_page($page, qw(Pödgecäst Sons Alex));
+test_page($page, qw(Pödgecäst´s Sons Alex));
 test_page_negative($page, qw(Brilliant));
 
 # combine include and exclude tag search to exclude both Alex and
 # Brilliant
 $page = get_page('search=tag:podcast%20-tag:mag raw=1');
-test_page($page, qw(Pödgecäst Sons));
+test_page($page, qw(Pödgecäst´s Sons));
 test_page_negative($page, qw(Brilliant Alex));
 
 # combine ordinary search with include and exclude tag search to
 # exclude both Alex and Brilliant
 $page = get_page('search=kryos%20tag:podcast%20-tag:mag raw=1');
 test_page($page, qw(Sons));
-test_page_negative($page, qw(Pödgecäst Brilliant Alex));
+test_page_negative($page, qw(Pödgecäst´s Brilliant Alex));
 
 # search for a tag containing spaces
 $page = get_page('search=tag:old_school raw=1');
 test_page($page, qw(Jeff));
-test_page_negative($page, qw(Sons Pödgecäst Brilliant Alex));
+test_page_negative($page, qw(Sons Pödgecäst´s Brilliant Alex));
 
 test_page(get_page('action=reindex pwd=foo'),
-	  qw(Pödgecäst Brilliant Sons Alex));
+	  qw(Pödgecäst´s Brilliant Sons Alex));
 
 # tag search skips Alex -- repeat test after reindexing
 $page = get_page('search=tag:podcast raw=1');
-test_page($page, qw(Pödgecäst Brilliant Sons));
+test_page($page, qw(Pödgecäst´s Brilliant Sons));
 test_page_negative($page, qw(Alex));
 
 add_module('near-links.pl');
@@ -160,7 +160,7 @@ test_page_negative($page, qw(AlexSchroeder Foo));
 
 # check journal pages
 $page = update_page('Podcasts', '<journal "." search tag:podcast>');
-test_page($page, qw(Pödgecäst Brilliant Sons));
+test_page($page, qw(Pödgecäst´s Brilliant Sons));
 test_page_negative($page, qw(Alex Foo));
 
 # check the tag cloud
@@ -177,4 +177,4 @@ AppendStringToFile($ConfigFile, "\$LocalNamesCollect = 1;\n");
 update_page('LocalNames', 'test');
 update_page('Alex', 'is a [[tag:podcast]] after all');
 $page = get_page('search=tag:podcast raw=1');
-test_page($page, qw(Pödgecäst Brilliant Sons Alex));
+test_page($page, qw(Pödgecäst´s Brilliant Sons Alex));

t/test.pl

@@ -18,6 +18,12 @@ use XML::LibXML;
 use utf8;
 use vars qw($raw);
 
+# Test::More explains how to fix wide character in print issues
+my $builder = Test::More->builder;
+binmode $builder->output,         ":utf8";
+binmode $builder->failure_output, ":utf8";
+binmode $builder->todo_output,    ":utf8";
+
 # Import the functions
 
 $raw = 0;       # capture utf8 is the default
@@ -94,7 +100,6 @@ sub name {
   $_ = shift;
   s/\n/\\n/g;
   $_ = '...' . substr($_, -60) if length > 63;
-  utf8::encode($_);
   return $_;
 }
 
@@ -138,8 +143,8 @@ sub run_macro_tests {
 
 # one string, many tests
 sub test_page {
-  my $page = shift;
-  foreach my $test (@_) {
+  my ($page, @tests) = @_;
+  foreach my $test (@tests) {
     like($page, qr($test), name($test));
   }
 }

wiki.pl

@@ -1,5 +1,5 @@
 #! /usr/bin/perl
-# Copyright (C) 2001-2012
+# Copyright (C) 2001-2013
 #     Alex Schroeder <alex@gnu.org>
 # Copyleft      2008 Brian Curry <http://www.raiazome.com>
 # ... including lots of patches from the UseModWiki site
@@ -797,6 +797,7 @@ sub UrlEncode {
 sub UrlDecode {
   my $str = shift;
   $str =~ s/%([0-9a-f][0-9a-f])/chr(hex($1))/ge;
+  utf8::decode($str); # make internal string
   return $str;
 }
 
@@ -811,7 +812,7 @@ sub GetRaw {
   return unless eval { require LWP::UserAgent; };
   my $ua = LWP::UserAgent->new;
   my $response = $ua->get($uri);
-  return $response->content if $response->is_success;
+  return $response->decoded_content if $response->is_success;
 }
 
 sub DoJournal {
@@ -1022,7 +1023,7 @@ sub GetRss {
   }
   my @need_cache = keys %todo;
   if (keys %todo > 1) {   # try parallel access if available
-    eval { # see code example in LWP::Parallel, not LWP::Parllel::UserAgent (no callbacks here)
+    eval { # see code example in LWP::Parallel, not LWP::Parallel::UserAgent (no callbacks here)
       require LWP::Parallel::UserAgent;
       my $pua = LWP::Parallel::UserAgent->new();
       foreach my $uri (keys %todo) {
@@ -1034,7 +1035,7 @@ sub GetRss {
       my $entries = $pua->wait();
       foreach (keys %$entries) {
 	my $uri = $entries->{$_}->request->uri;
-	$data{$uri} = $entries->{$_}->response->content;
+	$data{$uri} = $entries->{$_}->response->decoded_content;
       }
     }
   }
@@ -1161,11 +1162,12 @@ sub GetPageOrEditLink { # use GetPageLink and GetEditLink if you know the result
 }
 
 sub GetPageLink { # use if you want to force a link to local pages, whether it exists or not
-  my ($id, $name, $class) = @_;
+  my ($id, $name, $class, $accesskey) = @_;
   $id = FreeToNormal($id);
   $name = $id unless $name;
   $class .= ' ' if $class;
-  return ScriptLink(UrlEncode($id), NormalToFree($name), $class . 'local');
+  return ScriptLink(UrlEncode($id), NormalToFree($name), $class . 'local',
+		    undef, undef, $accesskey);
 }
 
 sub GetEditLink {   # shortcut
@@ -1389,7 +1391,7 @@ sub BrowseResolvedPage {
 sub BrowsePage {
   my ($id, $raw, $comment, $status) = @_;
   OpenPage($id);
-  my ($text, $revision) = GetTextRevision(GetParam('revision', ''));
+  my ($text, $revision, $summary) = GetTextRevision(GetParam('revision', ''));
   $text = $NewText unless $revision or $Page{revision}; # new text for new pages
   # handle a single-level redirect
   my $oldId = GetParam('oldid', '');
@@ -1421,7 +1423,7 @@ sub BrowsePage {
   print GetHeader($id, NormalToFree($id), $oldId, undef, $status);
   my $showDiff = GetParam('diff', 0);
   if ($UseDiff && $showDiff) {
-    PrintHtmlDiff($showDiff, GetParam('diffrevision', $revision), $revision, $text);
+    PrintHtmlDiff($showDiff, GetParam('diffrevision', $revision), $revision, $text, $summary);
     print $q->hr();
   }
   PrintPageContent($text, $revision, $comment);
@@ -1500,7 +1502,7 @@ sub GetRcLines { # starttime, hash of seen pages to use as a second return value
   my %following = ();
   my @result = ();
   # check the first timestamp in the default file, maybe read old log file
-  open(F, '<:encoding(UTF-8)', $RcFile);
+  open(F, '<:utf8', $RcFile);
   my $line = <F>;
   my ($ts) = split(/$FS/o, $line); # the first timestamp in the regular rc file
   if (not $ts or $ts > $starttime) { # we need to read the old rc file, too
@@ -1586,7 +1588,7 @@ sub GetRcLinesFor {
         rcclusteronly rcfilteronly match lang followup);
   # parsing and filtering
   my @result = ();
-  open(F, '<:encoding(UTF-8)', $file) or return ();
+  open(F, '<:utf8', $file) or return ();
   while (my $line = <F>) {
     chomp($line);
     my ($ts, $id, $minor, $summary, $host, $username, $revision,
@@ -1995,8 +1997,7 @@ sub DoHistory {
     }
     @html = (GetFormStart(undef, 'get', 'history'),
        $q->p($q->submit({-name=>T('Compare')}),
-       # don't use $q->hidden here, the sticky action
-       # value will be used instead
+       # don't use $q->hidden here!
        $q->input({-type=>'hidden',-name=>'action',-value=>'browse'}),
        $q->input({-type=>'hidden', -name=>'diff', -value=>'1'}),
        $q->input({-type=>'hidden', -name=>'id', -value=>$id})),
@@ -2108,26 +2109,47 @@ sub DoRollback {
 
 sub DoAdminPage {
   my ($id, @rest) = @_;
-  my @menu = (ScriptLink('action=index', T('Index of all pages'), 'index'),
-        ScriptLink('action=version', T('Wiki Version'), 'version'),
-        ScriptLink('action=unlock', T('Unlock Wiki'), 'unlock'),
-        ScriptLink('action=password', T('Password'), 'password'),
-        ScriptLink('action=maintain', T('Run maintenance'), 'maintain'));
+  my @menu = ();
+  push(@menu, ScriptLink('action=index',
+			 T('Index of all pages'), 'index'))
+    if $Action{index};
+  push(@menu, ScriptLink('action=version',
+			 T('Wiki Version'), 'version'))
+    if $Action{version};
+  push(@menu, ScriptLink('action=unlock',
+			 T('Unlock Wiki'), 'unlock'))
+    if $Action{unlock};
+  push(@menu, ScriptLink('action=password',
+			 T('Password'), 'password'))
+    if $Action{password};
+  push(@menu, ScriptLink('action=maintain',
+			 T('Run maintenance'), 'maintain'))
+    if $Action{maintain};
   if (UserIsAdmin()) {
-    push(@menu, ScriptLink('action=clear', T('Clear Cache'), 'clear'));
-    if (-f "$DataDir/noedit") {
-      push(@menu, ScriptLink('action=editlock;set=0', T('Unlock site'), 'editlock 0'));
-    } else {
-      push(@menu, ScriptLink('action=editlock;set=1', T('Lock site'), 'editlock 1'));
+    push(@menu, ScriptLink('action=clear',
+			   T('Clear Cache'), 'clear'))
+      if $Action{clear};
+    if ($Action{editlock}) {
+      if (-f "$DataDir/noedit") {
+	push(@menu, ScriptLink('action=editlock;set=0',
+			      T('Unlock site'), 'editlock 0'));
+      } else {
+	push(@menu, ScriptLink('action=editlock;set=1',
+			       T('Lock site'), 'editlock 1'));
+      }
     }
-    if ($id) {
+    if ($id and $Action{pagelock}) {
       my $title = NormalToFree($id);
       if (-f GetLockedPageFile($id)) {
-	push(@menu, ScriptLink('action=pagelock;set=0;id=' . UrlEncode($id),
-			       Ts('Unlock %s', $title), 'pagelock 0'));
+	push(@menu, ScriptLink('action=pagelock;set=0;id='
+			       . UrlEncode($id),
+			       Ts('Unlock %s', $title),
+			       'pagelock 0'));
       } else {
-	push(@menu, ScriptLink('action=pagelock;set=1;id=' . UrlEncode($id),
-			       Ts('Lock %s', $title), 'pagelock 1'));
+	push(@menu, ScriptLink('action=pagelock;set=1;id='
+			       . UrlEncode($id),
+			       Ts('Lock %s', $title),
+			       'pagelock 1'));
       }
     }
   }
@@ -2398,9 +2420,9 @@ sub GetFooterLinks {
   if ($id and $rev ne 'history' and $rev ne 'edit') {
     if ($CommentsPrefix) {
       if ($id =~ /^$CommentsPrefix(.*)/o) {
-	push(@elements, GetPageLink($1, undef, 'original'));
+	push(@elements, GetPageLink($1, undef, 'original', T('a')));
       } else {
-	push(@elements, GetPageLink($CommentsPrefix . $id, undef, 'comment'));
+	push(@elements, GetPageLink($CommentsPrefix . $id, undef, 'comment', T('c')));
       }
     }
     if (UserCanEdit($id, 0)) {
@@ -2487,14 +2509,14 @@ sub GetGotoBar {    # ignore $id parameter
 }
 
 sub PrintHtmlDiff {
-  my ($type, $old, $new, $text) = @_;
+  my ($type, $old, $new, $text, $summary) = @_;
   my $intro = T('Last edit');
   my $diff = GetCacheDiff($type == 1 ? 'major' : 'minor');
   # compute old revision if cache is disabled or no cached diff is available
   if (not $old and (not $diff or GetParam('cache', $UseCache) < 1)) {
     if ($type == 1) {
       $old = $Page{lastmajor} - 1;
-      ($text, $new) = GetTextRevision($Page{lastmajor}, 1)
+      ($text, $new, $summary) = GetTextRevision($Page{lastmajor}, 1)
 	unless $new or $Page{lastmajor} == $Page{revision};
     } elsif ($new) {
       $old = $new - 1;
@@ -2502,6 +2524,7 @@ sub PrintHtmlDiff {
       $old = $Page{revision} - 1;
     }
   }
+  $summary = $q->p({-class=>'summary'}, T('Summary:') . ' ' . $summary) if $summary;
   if ($old > 0) { # generate diff if the computed old revision makes sense
     $diff = GetKeptDiff($text, $old);
     $intro = Tss('Difference between revision %1 and %2', $old,
@@ -2512,7 +2535,7 @@ sub PrintHtmlDiff {
   }
   $diff =~ s!<p><strong>(.*?)</strong></p>!'<p><strong>' . T($1) . '</strong></p>'!ge;
   $diff = T('No diff available.') unless $diff;
-  print $q->div({-class=>'diff'}, $q->p($q->b($intro)), $diff);
+  print $q->div({-class=>'diff'}, $q->p($q->b($intro)), $summary, $diff);
 }
 
 sub GetCacheDiff {
@@ -2667,8 +2690,8 @@ sub OpenPage {      # Sets global variables
     $Page{ts} = $Now;
     $Page{revision} = 0;
     if ($id eq $HomePage
-	and (open(F, '<:encoding(UTF-8)', $ReadMe)
-	     or open(F, '<:encoding(UTF-8)', 'README'))) {
+	and (open(F, '<:utf8', $ReadMe)
+	     or open(F, '<:utf8', 'README'))) {
       local $/ = undef;
       $Page{text} = <F>;
       close F;
@@ -2696,15 +2719,15 @@ sub GetTextAtTime { # call with opened page, return $minor if all pages between
 sub GetTextRevision {
   my ($revision, $quiet) = @_;
   $revision =~ s/\D//g;   # Remove non-numeric chars
-  return ($Page{text}, $revision) unless $revision and $revision ne $Page{revision};
+  return ($Page{text}, $revision, $Page{summary}) unless $revision and $revision ne $Page{revision};
   my %keep = GetKeptRevision($revision);
   if (not %keep) {
     $Message .= $q->p(Ts('Revision %s not available', $revision)
           . ' (' . T('showing current revision instead') . ')') unless $quiet;
-    return ($Page{text}, '');
+    return ($Page{text}, '', '');
   }
   $Message .= $q->p(Ts('Showing revision %s', $revision)) unless $quiet;
-  return ($keep{text}, $revision);
+  return ($keep{text}, $revision, $keep{summary});
 }
 
 sub GetPageContent {
@@ -2798,7 +2821,7 @@ sub ExpireKeepFiles {   # call with opened page
 sub ReadFile {
   my $file = shift;
   utf8::encode($file); # filenames are bytes!
-  if (open(IN, '<:encoding(UTF-8)', $file)) {
+  if (open(IN, '<:utf8', $file)) {
     local $/ = undef;   # Read complete files
     my $data=<IN>;
     close IN;
@@ -3372,7 +3395,7 @@ sub PageIsUploadedFile {
   if ($IndexHash{$id}) {
     my $file = GetPageFile($id);
     utf8::encode($file); # filenames are bytes!
-    open(FILE, '<:encoding(UTF-8)', $file)
+    open(FILE, '<:utf8', $file)
       or ReportError(Ts('Cannot open %s', $file) . ": $!", '500 INTERNAL SERVER ERROR');
     while (defined($_ = <FILE>) and $_ !~ /^text: /) {
     }          # read lines until we get to the text key
@@ -3794,8 +3817,7 @@ sub DoMaintain {
       return;
     }
   }
-  RequestLockOrError();
-  print $q->p(T('Main lock obtained.')), '<p>', T('Expiring keep files and deleting pages marked for deletion');
+  print '<p>', T('Expiring keep files and deleting pages marked for deletion');
   # Expire all keep files
   foreach my $name (AllPagesList()) {
     print $q->br(), GetPageLink($name);
@@ -3808,7 +3830,10 @@ sub DoMaintain {
       ExpireKeepFiles();
     }
   }
-  print '</p>', $q->p(Ts('Moving part of the %s log file.', $RCName));
+  print '</p>';
+  RequestLockOrError();
+  print $q->p(T('Main lock obtained.'));
+  print $q->p(Ts('Moving part of the %s log file.', $RCName));
   # Determine the number of days to go back
   my $days = 0;
   foreach (@RcDays) {

wikicopy

@@ -42,6 +42,7 @@ our ($opt_v, $opt_w);
 
 my $usage = qq{$0 [-i URL] [-d STRING] [-t SECONDS]
 \t[-u USERNAME] [-p PASSWORD] [-w USERNAME:PASSWORD]
+\t[-q QUESTION] [-a ANSWER] [-z SECRET]
 \t[SOURCE] TARGET
 
 SOURCE and TARGET are the base URLs for the two wikis.  Visiting these
@@ -61,18 +62,15 @@ If you use -d instead of providing a SOURCE, all the pages will be
 replaced with STRING. This is useful when replacing the page content
 with "DeletedPage", for example.
 
-Your copies on the target wiki will show up on the list of changes as
-anonymous edits. If you want to provide a username, you can use -u to
-do so.
-
-If you want to copy pages to a locked wiki or if you need to overwrite
-locked target pages, you need to provide a password using -p.
-
-On the other hand, if your wiki is protected by so-called "basic
-authentication" -- that is, if you need to provide a username and
-password before you can even view the site -- then you can pass
-those along using the -w option. Separate username and password
-using a colon.
+ -d     Delete target pages instead of providing SOURCE (default: none)
+ -s	The summary for RecentChanges (default: none)
+ -u     The username for RecentChanges (default: none)
+ -p     The password to use for locked pages (default: none)
+ -w     The username:password combo for basic authentication (default:none)
+ -q     The question number to answer (default: 0, ie. the first question)
+ -a     The answer to the question (default: none)
+ -z     Alternatively, the secret key (default: question)
+ -v     Verbose output for debugging (default: none)
 
 Examples:
 
@@ -111,17 +109,31 @@ sub GetRaw {
   return $response->content if $response->is_success;
 }
 
-sub PostRaw {
-  my ($uri, $id, $data, $username, $password) = @_;
+sub post {
+  my ($uri, $id, $data, $minor, $summary, $username, $password,
+      $question, $answer, $secret) = @_;
   my $ua = RequestAgent->new;
-  my $response = $ua->post($uri, {title=>$id, text=>$data, raw=>1,
-				  username=>$username, pwd=>$password});
+  my %params = (title=>$id, text=>$data, raw=>1,
+		username=>$username, pwd=>$password,
+		summary=>$summary, question_num=>$question,
+		answer=>$answer, $secret=>1,
+		recent_edit=>$minor);
+  if ($opt_v) {
+    foreach my $key (keys %params) {
+      my $value = $params{$key} || '(none)';
+      $value = substr($value,0,50) . '...'
+	if $key eq 'text' and length($value) > 53;
+      warn "$key: $value\n";
+    }
+  }
+  my $response = $ua->post($uri, \%params);
   my $status = $response->code . ' ' . $response->message;
   warn "POST $id failed: $status.\n" unless $response->is_success;
 }
 
 sub copy {
-  my ($source, $replacement, $target, $interval, $username, $password,
+  my ($source, $replacement, $target, $interval, $minor, $summary,
+      $username, $password, $question, $answer, $secret,
       @pages) = @_;
   foreach my $id (@pages) {
     print "$id\n";
@@ -129,18 +141,18 @@ sub copy {
     # fix URL for other wikis
     my $data = $replacement || GetRaw("$source?action=browse;id=$page;raw=1");
     next unless $data;
-    PostRaw($target, $id, $data, $username, $password);
+    post($target, $id, $data, $minor, $summary, $username, $password,
+      $question, $answer, $secret);
     sleep($interval);
   }
 }
 
 sub main {
-  our($opt_i, $opt_t, $opt_d, $opt_u, $opt_p);
-  getopts('i:t:d:u:p:w:v');
+  our($opt_m, $opt_i, $opt_t, $opt_d, $opt_s, $opt_u, $opt_p,
+      $opt_q, $opt_a, $opt_z);
+  getopts('mi:t:d:s:u:p:q:a:z:w:v');
   my $interval = $opt_t ? $opt_t : 5;
   my $replacement = $opt_d;
-  my $username = $opt_u;
-  my $password = $opt_p;
   my ($source, $target);
   $source = shift(@ARGV) unless $replacement;
   $target = shift(@ARGV);
@@ -157,7 +169,8 @@ sub main {
     }
   }
   die "The list of pages is missing.  Did you use -i?\n" unless @pages;
-  copy($source, $replacement, $target, $interval, $username, $password,
+  copy($source, $replacement, $target, $interval, $opt_m ? 'on' : '', $opt_s,
+       $opt_u, $opt_p, $opt_q, $opt_a, $opt_z||'question',
        @pages);
 }
 

wikipipe

@@ -0,0 +1,35 @@
+#! /usr/bin/perl
+# Copyright (C) 2005  Alex Schroeder <alex@emacswiki.org>
+#
+# This program is free software; you can redistribute it and/or modify
+# it under the terms of the GNU General Public License as published by
+# the Free Software Foundation; either version 2 of the License, or
+# (at your option) any later version.
+#
+# This program is distributed in the hope that it will be useful,
+# but WITHOUT ANY WARRANTY; without even the implied warranty of
+# MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
+# GNU General Public License for more details.
+#
+# You should have received a copy of the GNU General Public License
+# along with this program; if not, write to the
+#    Free Software Foundation, Inc.
+#    59 Temple Place, Suite 330
+#    Boston, MA 02111-1307 USA
+
+use Getopt::Std;
+use LWP::UserAgent;
+
+our $opt_b;
+getopt('b');
+my $base = $opt_b;
+my $url = shift;
+die "Usage: wikipipe [-b base-url] url\n" unless $url;
+undef $/;
+
+my $data = <STDIN>;
+my $ua = new LWP::UserAgent;
+my %params = (action=>raw, data=>$data, base=>$base);
+my $response = $ua->post($url, \%params);
+die $response->status_line unless $response->is_success;
+print $response->content;

wikiput

@@ -84,7 +84,8 @@ sub post {
   if ($opt_v) {
     foreach my $key (keys %params) {
       my $value = $params{$key} || '(none)';
-      $value = substr($value,0,50) . '...' if $key eq 'text' and length($value) > 53;
+      $value = substr($value,0,50) . '...'
+	if $key eq 'text' and length($value) > 53;
       warn "$key: $value\n";
     }
   }