oddmuse/modules/upgrade.pl

# Copyright (C) 2014–2015  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 strict;
use v5.10;

use utf8;

AddModuleDescription('upgrade.pl', '2014-06-17 New Directory Structure');

our ($q, %Action, %InterSite, $ModuleDir, $IndexFile, $DataDir, $PageDir, $KeepDir, $InterMap, $JoinerDir, $JoinerEmailDir, $LocalNamesPage, $GotobarName, $NearMap, $RefererDir, $SidebarName);

# We are now running in InitModules. InitVariables will be called later.
# We want to prevent any calls to GetPageContent and the like.

*UpgradeOldInitVariables = \&InitVariables;
*InitVariables = \&UpgradeNewInitVariables;

sub UpgradeNewInitVariables {
  $InterMap = undef;
  $LocalNamesPage = undef;
  $SidebarName = undef;
  $NearMap = undef;
  $GotobarName = undef;
  UpgradeOldInitVariables(@_);
}

*DoBrowseRequest = \&DoUpgrade;

sub DoUpgrade {
  # The only thing allowed besides upgrading is login and unlock
  my $action = lc(GetParam('action', ''));
  if (($action eq 'password' or $action eq 'unlock')
      and $Action{$action}) {
    return &{$Action{$action}}(GetId());
  }

  # Only admins may upgrade
  ReportError(T('Upgrading Database'),
	      '403 FORBIDDEN', 0,
	      $q->p(T('This operation is restricted to administrators only...'))
	      . $q->p(ScriptLink('action=password', T('Login'), 'password')))
    unless UserIsAdmin();

  ReportError(T('Upgrading Database'),
	      '403 FORBIDDEN', 0,
	      $q->p(T('Did the previous upgrade end with an error? A lock was left behind.'))
	      . $q->p(ScriptLink('action=unlock', T('Unlock wiki'), 'unlock')))
    unless RequestLockDir('main');

  print GetHeader('', T('Upgrading Database')),
    $q->start_div({-class=>'content upgrade'});

  if (IsFile($IndexFile)) {
    Unlink($IndexFile);
  }

  print "<p>Renaming files...";

  for my $ns ('', keys %InterSite) {
    next unless IsDir("$DataDir/$ns");
    print "<br />\n<strong>$ns</strong>" if $ns;
    for my $dirname ($PageDir, $KeepDir, $RefererDir, $JoinerDir, $JoinerEmailDir) {
      next unless $dirname;
      my $dir = $dirname; # copy in order not to modify the original
      $dir =~ s/^$DataDir/$DataDir\/$ns/ if $ns;
      for my $old (Glob("$dir/*/*"), Glob("$dir/*/.*")) {
	next if $old =~ /\/\.\.?$/;
	print "<br />\n$old";
	my $new = $old;
	$new =~ s!/([A-Z]|other)/!/!;
	if ($old eq $new) {
	  print " does not fit the pattern!";
	} elsif (not Rename($old, $new)) {
	  print " → $new failed!";
	}
      }
      for my $subdir (grep(/\/([A-Z]|other)$/, Glob("$dir/*"), Glob("$dir/.*"))) {
	next if substr($subdir, -2) eq '/.' or substr($subdir, -3) eq '/..';
	RemoveDir($subdir); # ignore errors
      }
    }
  }

  print $q->end_p();

  if (Rename("$ModuleDir/upgrade.pl", "$ModuleDir/upgrade.done")) {
    print $q->p(T("Upgrade complete."))
  } else {
    print $q->p(T("Upgrade complete. Please remove $ModuleDir/upgade.pl, now."))
  }

  ReleaseLock();

  print $q->end_p(), $q->end_div();
  PrintFooter();
}