Merge branch 'master' of git.sv.gnu.org:/srv/git/oddmuse

Conflicts:
	wiki.pl

modules/module-bisect.pl

@@ -17,45 +17,60 @@ package OddMuse;
 use File::Basename;
 use File::Copy;
 
-AddModuleDescription('module-bisect.pl', 'Bisect Extension');
+AddModuleDescription('module-bisect.pl', 'Module Bisect Extension');
 
+push(@MyAdminCode, \&ModuleBisectMenu);
 $Action{bisect} = \&BisectAction;
 
+sub ModuleBisectMenu {
+  return unless UserIsAdmin();
+  my ($id, $menuref, $restref) = @_;
+  push(@$menuref, ScriptLink('action=bisect', T('Bisect modules'), 'modulebisect'));
+}
+
 sub BisectAction {
   UserIsAdminOrError();
   RequestLockOrError();
-  print GetHeader('', T('Module Bisect'), '');
+  print GetHeader('', T('Module Bisect'), '', 'nocache');
   if (GetParam('stop')) {
     BisectEnableAll(1);
     print $q->br(), $q->strong(T('All modules enabled now!'));
+    print GetFormStart(undef, 'get', 'bisect');
+    print GetHiddenValue('action', 'bisect');
+    print $q->submit(-name=>'noop', -value=>T('Go back'));
+    print $q->end_form();
   } elsif (GetParam('good') or GetParam('bad')) {
     BisectProcess(GetParam('good'));
   } else {
-    print GetFormStart(undef, 'get', 'bisect');
-    print GetHiddenValue('action', 'bisect');
-    my @disabledFiles = bsd_glob("$ModuleDir/*.p[ml].disabled");
-    if (@disabledFiles == 0) {
-      print 'Test / Always enabled / Always disabled', $q->br();
-      my @files = bsd_glob("$ModuleDir/*.p[ml]");
-      for (my $i = 0; $i < @files; $i++) {
-	my $moduleName = fileparse($files[$i]);
-	my @disabled = ($moduleName eq 'module-bisect.pl' ? (-disabled=>'disabled') : ());
-	print $q->input({-type=>'radio', -name=>"m$i", -value=>'t', ($moduleName ne 'module-bisect.pl' ? (-checked=>'checked') : ()), @disabled});
-	print $q->input({-type=>'radio', -name=>"m$i", -value=>'on', ($moduleName eq 'module-bisect.pl' ? (-checked=>'checked') : ())});
-	print $q->input({-type=>'radio', -name=>"m$i", -value=>'off', @disabled});
-	print $moduleName, $q->br();
-      }
-      print $q->submit(-name=>'bad', -value=>T('Start'));
-    } else {
-      print T('Biscecting proccess is already active.'), $q->br();
-      print $q->submit(-name=>'stop', -value=>T('Stop'));
-    }
-    print $q->end_form();
+    BisectInitialScreen();
   }
   PrintFooter();
   ReleaseLock();
 }
 
+sub BisectInitialScreen {
+  print GetFormStart(undef, 'get', 'bisect');
+  print GetHiddenValue('action', 'bisect');
+  my @disabledFiles = bsd_glob("$ModuleDir/*.p[ml].disabled");
+  if (@disabledFiles == 0) {
+    print T('Test / Always enabled / Always disabled'), $q->br();
+    my @files = bsd_glob("$ModuleDir/*.p[ml]");
+    for (my $i = 0; $i < @files; $i++) {
+      my $moduleName = fileparse($files[$i]);
+      my @disabled = ($moduleName eq 'module-bisect.pl' ? (-disabled=>'disabled') : ());
+      print $q->input({-type=>'radio', -name=>"m$i", -value=>'t', ($moduleName ne 'module-bisect.pl' ? (-checked=>'checked') : ()), @disabled});
+      print $q->input({-type=>'radio', -name=>"m$i", -value=>'on', ($moduleName eq 'module-bisect.pl' ? (-checked=>'checked') : ())});
+      print $q->input({-type=>'radio', -name=>"m$i", -value=>'off', @disabled});
+      print $moduleName, $q->br();
+    }
+    print $q->submit(-name=>'bad', -value=>T('Start'));
+  } else {
+    print T('Biscecting proccess is already active.'), $q->br();
+    print $q->submit(-name=>'stop', -value=>T('Stop'));
+  }
+  print $q->end_form();
+}
+
 sub BisectProcess {
   my ($isGood) = @_;
   my $parameterHandover = '';
@@ -71,12 +86,13 @@ sub BisectProcess {
       splice @files, $i, 1;
     }
   }
-  my $start = GetParam('start') - 1; # $start and $end are indexes
-  my $end = GetParam('end') - 1;
-  $start = 0 if $start < 0; # not specified (probably right after Start)
-  $end = @files * 2 - 1 if $end < 0;
+  my $start = GetParam('start', 1) - 1; # $start and $end are indexes
+  my $end = GetParam('end', @files * 2) - 1;
   if ($end - $start <= 1) {
-    print 'It seems like ', $q->strong((fileparse($isGood ? $files[$end] : $files[$start]))[0]), ' is causing your problem.';
+    print Ts('It seems like module %s is causing your problem.',
+	     $q->strong((fileparse($isGood ? $files[$end] : $files[$start]))[0])), $q->br(), $q->br();
+    print T('Please note that this module does not handle situations when your problem is caused by a combination of specific modules (which is rare anyway).'), $q->br();
+    print T('Good luck fixing your problem! ;)');
     print GetFormStart(undef, 'get', 'bisect');
     print GetHiddenValue('action', 'bisect');
     print $q->submit(-name=>'stop', -value=>T('Stop'));
@@ -115,7 +131,7 @@ sub BisectEnableAll {
   for (bsd_glob("$ModuleDir/*.p[ml].disabled")) { # reenable all modules
     my $oldName = $_;
     s/\.disabled$//;
-    print "Enabling ", (fileparse($_))[0], '...', $q->br() if $_[0];
+    print Ts('Enabling %s', (fileparse($_))[0]), '...', $q->br() if $_[0];
     move($oldName, $_);
   }
 }

modules/module-updater.pl

@@ -31,9 +31,9 @@ sub ModuleUpdaterMenu {
 }
 
 sub ModuleUpdaterAction {
-  return unless UserIsAdminOrError();
+  UserIsAdminOrError();
   RequestLockOrError();
-  print GetHeader('', T('Module Updater'), '');
+  print GetHeader('', T('Module Updater'), '', 'nocache');
 
   if (GetParam('ok')) {
     ModuleUpdaterApply();

t/cache.t

@@ -1,24 +1,20 @@
-# Copyright (C) 2006, 2007  Alex Schroeder <alex@emacswiki.org>
+# Copyright (C) 2006, 2007  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/>.
 
 require 't/test.pl';
 package OddMuse;
-use Test::More tests => 7;
+use Test::More tests => 8;
 
 clear_pages();
 
@@ -27,23 +23,39 @@ sub get_etag {
   return $1 if $str =~ /Etag: (.*)\r\n/;
 }
 
+sub get_last_modified {
+  my $str = shift;
+  return $1 if $str =~ /Last-Modified: (.*)\r\n/i;
+}
+
 # Get the ts from the page db and compare it to the Etag
 update_page('CacheTest', 'something');
 OpenPage('CacheTest');
 my $ts1 = $Page{ts};
 my $ts2 = get_etag(get_page('CacheTest'));
 ok(abs($ts1 - $ts2) <= 1, "Latest edit of this page: $ts1 and $ts2 are close");
+
 # When updating another page, that page's ts is the new Etag for all of them
 update_page('OtherPage', 'something');
 OpenPage('OtherPage');
 $ts1 = $Page{ts};
 $ts2 = get_etag(get_page('OtherPage'));
 ok(abs($ts1 - $ts2) <= 1, "Latest edit of other page: $ts1 and $ts2 are close");
+
 # Getting it raw should use the original timestamp
 OpenPage('CacheTest');
 $ts1 = $Page{ts};
-$ts2 = get_etag(get_page('/raw/CacheTest?'));
-ok(abs($ts1 - $ts2) <= 1, "Latest edit of raw page: $ts1 and $ts2 are close");
+$page = get_page('/raw/CacheTest?');
+$ts2 = get_etag($page);
+ok(abs($ts1 - $ts2) <= 1, "Latest edit of raw page: $ts1 and $ts2 based on etag are close");
+
+SKIP: {
+  eval { require Date::Parse };
+  skip ("Date::Parse not installed", 1) if $@;
+
+  $ts2 = Date::Parse::str2time(get_last_modified($page));
+  ok(abs($ts1 - $ts2) <= 1, "Latest edit of raw page: $ts1 and $ts2 based on last-modified timestamp are close");
+}
 
 $str = 'This is a WikiLink.';
 

wiki.pl

@@ -29,6 +29,7 @@
 
 package OddMuse;
 use strict;
+use utf8; # in case anybody ever addes UTF8 characters to the source
 use CGI qw/-utf8/;
 use CGI::Carp qw(fatalsToBrowser);
 use File::Glob ':glob';
@@ -214,7 +215,8 @@ sub ReportError {   # fatal!
 }
 
 sub Init {
-  binmode(STDOUT, ':utf8');
+  binmode(STDOUT, ':utf8'); # this is where the HTML gets printed
+  binmode(STDERR, ':utf8'); # just in case somebody prints debug info to stderr
   InitDirConfig();
   $FS = "\x1e"; # The FS character is the RECORD SEPARATOR control char in ASCII
   $Message = ''; # Warnings and non-fatal errors.
@@ -361,6 +363,7 @@ sub CookieRollbackFix {
 
 sub GetParam {
   my ($name, $default) = @_;
+  utf8::encode($name); # turn to byte string
   my $result = $q->param($name);
   $result //= $default;
   return QuoteHtml($result); # you need to unquote anything that can have <tags>
@@ -1260,11 +1263,13 @@ sub PageHtml {
   local *STDOUT;
   OpenPage($id);
   open(STDOUT, '>', \$diff) or die "Can't open memory file: $!";
+  binmode(STDOUT); # works whether STDOUT already has the UTF8 layer or not
   binmode(STDOUT, ":utf8");
   PrintPageDiff();
   utf8::decode($diff);
   return $error if $limit and length($diff) > $limit;
   open(STDOUT, '>', \$page) or die "Can't open memory file: $!";
+  binmode(STDOUT); # works whether STDOUT already has the UTF8 layer or not
   binmode(STDOUT, ":utf8");
   PrintPageHtml();
   utf8::decode($page);
@@ -1453,7 +1458,7 @@ sub PageFresh { # pages can depend on other pages (ie. last update), admin statu
 
 sub PageEtag {
   my ($changed, $visible, %params) = CookieData();
-  return UrlEncode(join($FS, $LastUpdate, sort(values %params))); # no CTL in field values
+  return UrlEncode(join($FS, $LastUpdate||$Now, sort(values %params))); # no CTL in field values
 }
 
 sub FileFresh { # old files are never stale, current files are stale when the page was modified
@@ -2235,11 +2240,17 @@ sub GetHeaderTitle {
 sub GetHttpHeader {
   return if $PrintedHeader;
   $PrintedHeader = 1;
-  my ($type, $ts, $status, $encoding) = @_; # $ts is undef, a ts, or 'nocache'
+  my ($type, $ts, $status, $encoding) = @_;
   $q->charset($type =~ m!^(text/|application/xml)! ? 'utf-8' : ''); # text/plain, text/html, application/xml: UTF-8
   my %headers = (-cache_control=>($UseCache < 0 ? 'no-cache' : 'max-age=10'));
-  $headers{-etag} = $ts || PageEtag() if GetParam('cache', $UseCache) >= 2;
-  $headers{'-last-modified'} = TimeToRFC822($ts) if $ts and $ts ne 'nocache'; # RFC 2616 section 13.3.4
+  # Set $ts when serving raw content that cannot be modified by cookie parameters; or 'nocache'; or undef. If you
+  # provide a $ts, the last-modiefied header generated will by used by HTTP/1.0 clients. If you provide no $ts, the etag
+  # header generated will be used by HTTP/1.1 clients. In this situation, cookie parameters can influence the look of
+  # the page and we cannot rely on $LastUpdate. HTTP/1.0 clients will ignore etags. See RFC 2616 section 13.3.4.
+  if (GetParam('cache', $UseCache) >= 2 and $ts ne 'nocache') {
+    $headers{'-last-modified'} = TimeToRFC822($ts) if $ts;
+    $headers{-etag} = PageEtag();
+  }
   $headers{-type} = GetParam('mime-type', $type);
   $headers{-status} = $status if $status;
   $headers{-Content_Encoding} = $encoding if $encoding;
@@ -3055,19 +3066,18 @@ sub DoDownload {
   OpenPage($id) if ValidIdOrDie($id);
   print $q->header(-status=>'304 NOT MODIFIED') and return if FileFresh(); # FileFresh needs an OpenPage!
   my ($text, $revision) = GetTextRevision(GetParam('revision', '')); # maybe revision reset!
-  my $ts = $Page{ts};
   if (my ($type, $encoding) = TextIsFile($text)) {
     my ($data) = $text =~ /^[^\n]*\n(.*)/s;
     my %allowed = map {$_ => 1} @UploadTypes;
     if (@UploadTypes and not $allowed{$type}) {
       ReportError(Ts('Files of type %s are not allowed.', $type), '415 UNSUPPORTED MEDIA TYPE');
     }
-    print GetHttpHeader($type, $ts, undef, $encoding);
+    print GetHttpHeader($type, $Page{ts}, undef, $encoding);
     require MIME::Base64;
     binmode(STDOUT, ":pop:raw"); # need to pop utf8 for Windows users!?
     print MIME::Base64::decode($data);
   } else {
-    print GetHttpHeader('text/plain', $ts);
+    print GetHttpHeader('text/plain', $Page{ts});
     print $text;
   }
 }