#!/usr/bin/perl
# TmNetWiki version 0.4 (September 11, 2002)
# Copyright (C) 2002 Adam Brate
#   <ab@adambrate.com> 
# Based on the GPLed UseModWiki 0.92
# Copyright (C) 2000-2001 Clifford A. Adams
#    <caadams@frontiernet.net> or <usemod@usemod.com>
# Based on the GPLed AtisWiki 0.3  (C) 1998 Markus Denker
#    <marcus@ira.uka.de>
# ...which was based on
#    the LGPLed CVWiki CVS-patches (C) 1997 Peter Merel
#    and The Original WikiWikiWeb  (C) Ward Cunningham
#        <ward@c2.com> (code reused with permission)
# Email and ThinLine options by Jim Mahoney <mahoney@marlboro.edu>
#
# 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


package Wiki::admin;
use strict;

# needs subs   Wiki::template: GetHeader, GetFormStart, GetHiddenValue, 
#                GetTextArea, GetGotoBar, GetCommonFooter, GetMinimumFooter
#              Wiki::error: UserIsAdminOrError, ValidIdOrDie
#              Wiki::links: BuildLinkIndex, BuildLinkIndexPage
#              Wiki::file: ReadFile, WriteStringToFile
#              Wiki::page: GetPageFile, GetLockedPageFile
#              Wiki::keep: KeepFileName
#              Wiki::utility: ValidId, FreeToNormal, GetParam
#              Wiki::wiki: StoreRaw
#              Wiki::translate: T
#              Wiki::lock: RequestLock, ReleaseLock
#              Wiki::cache: New PageCacheClear
# needs consts AdminDelete, q, KeepDir, FS3
# needs vars   $IndexFile, %LinkIndex, %SaveUrl

use base 'Exporter';

use Wiki::consts;
use Wiki::template;
use Wiki::error;
use Wiki::links;
use Wiki::file;
use Wiki::page;
use Wiki::keep;
use Wiki::utility;
use Wiki::wiki;
use Wiki::translate;
use Wiki::lock;
use Wiki::cache;

#if ($^V and $^V gt v5.6.0) {
#    our @EXPORT;
#else {
   use vars qw(@EXPORT);
#}

@EXPORT = qw(
  DoEditLinks
  DoUpdateLinks
  DoEditLock
  DoPageLock
  DoEditBanned
  DoUpdateBanned
);

sub UpdateLinksList;
sub EditRecentChanges;
sub EditRecentChangesFile;
sub DeletePage;
sub SubstituteTextLinks;
sub SubFreeLink;
sub SubWikiLink;
sub RenameKeepText;
sub RenameTextLinks;
sub RenamePage;

# ==== Editing/Deleting pages and links ====
sub DoEditLinks {
  print &GetHeader("", "Editing Links", "");
  if ($Consts->{AdminDelete}) {
    return  if (!&UserIsAdminOrError());
  } else {
    return  if (!&UserIsEditorOrError());
  }
  print &GetFormStart();
  print GetHiddenValue("edit_links", 1), "\n";
  print "<b>Editing/Deleting page titles:</b><br>\n";
  print "<p>Enter one command on each line.  Commands are:<br>",
        "<tt>!PageName</tt> -- deletes the page called PageName<br>\n",
        "<tt>=OldPageName=NewPageName</tt> -- Renames OldPageName ",
        "to NewPageName and updates links to OldPageName.<br>\n",
        "<tt>|OldPageName|NewPageName</tt> -- Changes links to OldPageName ",
        "to NewPageName.",
        " (Used to rename links to non-existing pages.)<br>\n";
  print &GetTextArea('commandlist', "", 12, 50);
  print $q->checkbox(-name=>"p_changerc", -override=>1, -checked=>1,
                      -label=>"Edit $RCName");
  print "<br>\n";
  print $q->checkbox(-name=>"p_changetext", -override=>1, -checked=>1,
                      -label=>"Substitute text for rename");
  print "<br>", $q->submit(-name=>'Edit'), "\n";
  print "<hr>\n";
  print &GetGotoBar("");
  print $q->endform;
  print &GetMinimumFooter();
}

sub DoUpdateLinks {
  my ($commandList, $doRC, $doText);

  print &GetHeader("", "Updating Links", "");
  if ($Consts->{AdminDelete}) {
    return  if (!&UserIsAdminOrError());
  } else {
    return  if (!&UserIsEditorOrError());
  }
  $commandList = &GetParam("commandlist", "");
  $doRC   = &GetParam("p_changerc", "0");
  $doRC   = 1  if ($doRC eq "on");
  $doText = &GetParam("p_changetext", "0");
  $doText = 1  if ($doText eq "on");
  if ($commandList eq "") {
    print "<p>Empty command list or error.";
  } else {
    &UpdateLinksList($commandList, $doRC, $doText);
    print "<p>Finished command list.";
  }
  print &GetCommonFooter();
}

sub UpdateLinksList {
  my ($commandList, $doRC, $doText) = @_;

  if ($doText) {
    &BuildLinkIndex();
  }
  &RequestLock() or die "UpdateLinksList could not get main lock";
  unlink($IndexFile)  if ($Consts->{UseIndex});
  foreach (split(/\n/, $commandList)) {
    s/\s+$//g;
    next  if (!(/^[=!|]/));  # Only valid commands.
    print "Processing $_<br>\n";
    if (/^\!(.+)/) {
      &DeletePage($1, $doRC, $doText);
    } elsif (/^\=(?:\[\[)?([^]=]+)(?:\]\])?\=(?:\[\[)?([^]=]+)(?:\]\])?/) {
      &RenamePage($1, $2, $doRC, $doText);
    } elsif (/^\|(?:\[\[)?([^]|]+)(?:\]\])?\|(?:\[\[)?([^]|]+)(?:\]\])?/) {
      &RenameTextLinks($1, $2);
    }
  }
  &NewPageCacheClear(".");  # Clear cache (needs testing?)
  unlink($IndexFile)  if ($Consts->{UseIndex});
  &ReleaseLock();
}

sub EditRecentChanges {
  my ($action, $old, $new) = @_;

  &EditRecentChangesFile($RcFile,    $action, $old, $new);
  &EditRecentChangesFile($RcOldFile, $action, $old, $new);
}

sub EditRecentChangesFile {
  my ($fname, $action, $old, $new) = @_;
  my ($status, $fileData, $errorText, $rcline, @rclist);
  my ($outrc, $ts, $page, $junk);

  ($status, $fileData) = &ReadFile($fname);
  if (!$status) {
    # Save error text if needed.
    $errorText = "<p><strong>Could not open $Consts->{RCName} log file:"
                 . "</strong> $fname<p>Error was:\n<pre>$!</pre>\n";
    print $errorText;   # Maybe handle differently later?
    return;
  }
  $outrc = "";
  @rclist = split(/\n/, $fileData);
  foreach $rcline (@rclist) {
    ($ts, $page, $junk) = split(/$Consts->{FS3}/, $rcline);
    if ($page eq $old) {
      if ($action == 1) {  # Delete
        ; # Do nothing (don't add line to new RC)
      } elsif ($action == 2) {
        $junk = $rcline;
        $junk =~ s/^(\d+$Consts->{FS3})$old($Consts->{FS3})/"$1$new$2"/ge;
        $outrc .= $junk . "\n";
      }
    } else {
      $outrc .= $rcline . "\n";
    }
  }
  &WriteStringToFile($fname . ".old", $fileData);  # Backup copy
  &WriteStringToFile($fname, $outrc);
}

# Delete and rename must be done inside locks.
sub DeletePage {
  my ($page, $doRC, $doText) = @_;
  my ($fname, $status);

  $page =~ s/ /_/g;
  $page =~ s/\[+//;
  $page =~ s/\]+//;
  $status = &ValidId($page);
  if ($status ne "") {
    print "Delete-Page: page $page is invalid, error is: $status<br>\n";
    return;
  }
  
  $fname = &GetPageFile($page);
  unlink($fname)  if (-f $fname);
  $fname = &KeepFileName($page);
  unlink($fname)  if (-f $fname);
  unlink($IndexFile)  if ($UseIndex);
  &EditRecentChanges(1, $page, "")  if ($doRC);  # Delete page
  # Currently don't do anything with page text
}

# Given text, returns substituted text
sub SubstituteTextLinks {
  my ($old, $new, $text) = @_;

  # Much of this is taken from the common markup
  %SaveUrl = ();
  $SaveUrlIndex = 0;
  $text =~ s/$Consts->{FS}//g;              # Remove separators (paranoia)
  if ($Consts->{RawHtml}) {
    $text =~ s/(<html>((.|\n)*?)<\/html>)/&StoreRaw($1)/ige;
  }
  $text =~ s/(<pre>((.|\n)*?)<\/pre>)/&StoreRaw($1)/ige;
  $text =~ s/(<code>((.|\n)*?)<\/code>)/&StoreRaw($1)/ige;
  $text =~ s/(<nowiki>((.|\n)*?)<\/nowiki>)/&StoreRaw($1)/ige;

  if ($Consts->{FreeLinks}) {
    $text =~
     s/\[\[$Consts->{FreeLinkPattern}\|([^\]]+)\]\]/&SubFreeLink($1,$2,$old,$new)/geo;
    $text =~ s/\[\[$Consts->{FreeLinkPattern}\]\]/&SubFreeLink($1,"",$old,$new)/geo;
  }
  if ($Consts->{BracketText}) {  # Links like [URL text of link]
    $text =~ s/(\[$Consts->{UrlPattern}\s+([^\]]+?)\])/&StoreRaw($1)/geo;
    $text =~ s/(\[$Consts->{InterLinkPattern}\s+([^\]]+?)\])/&StoreRaw($1)/geo;
  }
  $text =~ s/(\[?$Consts->{UrlPattern}\]?)/&StoreRaw($1)/geo;
  $text =~ s/(\[?$Consts->{InterLinkPattern}\]?)/&StoreRaw($1)/geo;
  if ($Consts->{WikiLinks}) {
    $text =~ s/$Consts->{LinkPattern}/&SubWikiLink($1, $old, $new)/geo;
  }

  $text =~ s/$Consts->{FS}(\d+)$Consts->{FS}/$SaveUrl{$1}/ge;   # Restore saved text
  return $text;
}

sub SubFreeLink {
  my ($link, $name, $old, $new) = @_;
  my ($oldlink);

  $oldlink = $link;
  $link =~ s/^\s+//;
  $link =~ s/\s+$//;
  if (($link eq $old) || (&FreeToNormal($old) eq &FreeToNormal($link))) {
    $link = $new;
  } else {
    $link = $oldlink;  # Preserve spaces if no match
  }
  $link = "[[$link";
  if ($name ne "") {
    $link .= "|$name";
  }
  $link .= "]]";
  return &StoreRaw($link);
}

sub SubWikiLink {
  my ($link, $old, $new) = @_;
  my ($newBracket);

  $newBracket = 0;
  if ($link eq $old) {
    $link = $new;
    if (!($new =~ /^$LinkPattern$/)) {
      $link = "[[$link]]";
    }
  }
  return &StoreRaw($link);
}

# Rename is mostly copied from expire
sub RenameKeepText {
  my ($page, $old, $new) = @_;
  my ($fname, $status, $data, @kplist, %tempSection, $changed);
  my ($sectName, $newText);

  $fname = &KeepFileName($page);
  return  if (!(-f $fname));
  ($status, $data) = &ReadFile($fname);
  return  if (!$status);
  @kplist = split(/$Consts-{FS1}/, $data, -1);  # -1 keeps trailing null fields
  return  if (length(@kplist) < 1);  # Also empty
  shift(@kplist)  if ($kplist[0] eq "");  # First can be empty
  return  if (length(@kplist) < 1);  # Also empty
  %tempSection = split(/$Consts->{FS2}/, $kplist[0], -1);
  if (!defined($tempSection{'keepts'})) {
    return;
  }

  # First pass: optimize for nothing changed
  $changed = 0;
  foreach (@kplist) {
    %tempSection = split(/$Consts->{FS2}/, $_, -1);
    $sectName = $tempSection{'name'};
    if ($sectName =~ /^(text_)/) {
      %Text = split(/$Consts->{FS3}/, $tempSection{'data'}, -1);
      $newText = &SubstituteTextLinks($old, $new, $Text{'text'});
      $changed = 1  if ($Text{'text'} ne $newText);
    }
    # Later add other section types? (maybe)
  }

  return  if (!$changed);  # No sections changed
  open (OUT, ">$fname") or return;
  foreach (@kplist) {
    %tempSection = split(/$Consts->{FS2}/, $_, -1);
    $sectName = $tempSection{'name'};
    if ($sectName =~ /^(text_)/) {
      %Text = split(/$Consts->{FS3}/, $tempSection{'data'}, -1);
      $newText = &SubstituteTextLinks($old, $new, $Text{'text'});
      $Text{'text'} = $newText;
      $tempSection{'data'} = join($Consts->{FS3}, %Text);
      print OUT $Consts->{FS1}, join($Consts->{FS2}, %tempSection);
    } else {
      print OUT $Consts->{FS1}, $_;
    }
  }
  close(OUT);
}

sub RenameTextLinks {
    my ($old, $new) = @_;
    my ($changed, $file, $page, $sectionname, $oldText, $newText, $status);
    my ($oldCanonical, @pageList);
    
    $old =~ s/ /_/g;
    $oldCanonical = &FreeToNormal($old);
    $new =~ s/ /_/g;
    $status = &ValidId($old);
    if ($status ne "") {
	print "Rename-Text: old page $old is invalid, error is: $status<br>\n";
	return;
    }
    $status = &ValidId($new);
    if ($status ne "") {
	print "Rename-Text: new page $new is invalid, error is: $status<br>\n";
	return;
    }
    $old =~ s/_/ /g;
    $new =~ s/_/ /g;
    
    # Note: the LinkIndex must be built prior to this routine
    return  if (!defined($LinkIndex{$oldCanonical}));
    
    @pageList = split(' ', $LinkIndex{$oldCanonical});
    foreach $page (@pageList) {
	$changed = 0;
	&OpenPage($page);
	foreach $sectionname (keys %Page) {
	    if ($sectionname =~ /^text_/) {
		my ($text,$section);
		$section = &OpenSection($sectionname);
		%{$text} = split(/$Consts->{FS3}/, $section->{data}, -1);
		$oldText = $text->{text};
		$newText = &SubstituteTextLinks($old, $new, $oldText);
		if ($oldText ne $newText) {
		    $text->{text} = $newText;
		    $section->{data} = join($Consts->{FS3}, %{$text});
		    $Page{$sectionname} = join($Consts->{FS2}, %{$section});
		    $changed = 1;
		}
	    } elsif ($sectionname =~ /^cache_diff/) {
		$oldText = $Page{$sectionname};
		$newText = &SubstituteTextLinks($old, $new, $oldText);
		if ($oldText ne $newText) {
		    $Page{$sectionname} = $newText;
		    $changed = 1;
		}
	    }
	    # Later: add other text-sections (categories) here
	}
	if ($changed) {
	    $file = &GetPageFile($page);
	    &WriteStringToFile($file, join($Consts->{FS1}, %Page));
	}
	&RenameKeepText($page, $old, $new);
    }
}

sub RenamePage {
  my ($old, $new, $doRC, $doText) = @_;
  my ($oldfname, $newfname, $oldkeep, $newkeep, $oldlock,$newlock,$status);

  $old =~ s/ /_/g;
  $new = &FreeToNormal($new);
  $status = &ValidId($old);
  if ($status ne "") {
    print "Rename: old page $old is invalid, error is: $status<br>\n";
    return;
  }
  $status = &ValidId($new);
  if ($status ne "") {
    print "Rename: new page $new is invalid, error is: $status<br>\n";
    return;
  }
  $newfname = &GetPageFile($new);
  if (-f $newfname) {
    print "Rename: new page $new already exists--not renamed.<br>\n";
    return;
  }
  $oldfname = &GetPageFile($old);
  if (!(-f $oldfname)) {
    print "Rename: old page $old does not exist--nothing done.<br>\n";
    return;
  }

  &CreatePageDir($PageDir, $new);  # It might not exist yet
  rename($oldfname, $newfname);
  &CreatePageDir($KeepDir, $new);
  $oldkeep = &KeepFileName($old);
  $newkeep = &KeepFileName($new);
  unlink($newkeep)  if (-f $newkeep);  # Clean up if needed.
  rename($oldkeep,  $newkeep);
  $oldlock = &GetLockedPageFile($old);
  $newlock = &GetLockedPageFile($new);
  unlink($newlock) if (-f $newlock);
  rename($oldlock, $newlock) if (-f $oldlock);
  unlink($IndexFile)  if ($UseIndex);
  &EditRecentChanges(2, $old, $new)  if ($doRC);
  if ($doText) {
    &BuildLinkIndexPage($new);  # Keep index up-to-date
    &RenameTextLinks($old, $new);
  }
}

sub DoEditLock {
  my ($fname);

  print &GetHeader('', T('Set or Remove global edit lock'), '');
  return  if (!&UserIsAdminOrError());
  $fname = "$DataDir/noedit";
  if (&GetParam("set", 1)) {
    &WriteStringToFile($fname, "editing locked.");
  } else {
    unlink($fname);
  }
  if (-f $fname) {
    print '<p>', T('Edit lock created.'), '<br>';
  } else {
    print '<p>', T('Edit lock removed.'), '<br>';
  }
  print &GetCommonFooter();
}

sub DoPageLock {
  my ($fname, $id);

  print &GetHeader('', T('Set or Remove page edit lock'), '');
  # Consider allowing page lock/unlock at editor level?
  return  if (!&UserIsAdminOrError());
  $id = &GetParam("id", "");
  if ($id eq "") {
    print '<p>', T('Missing page id to lock/unlock...');
    return;
  }
  return  if (!&ValidIdOrDie($id));       # Later consider nicer error?
  $fname = &GetLockedPageFile($id);
  if (&GetParam("set", 1)) {
    &WriteStringToFile($fname, "editing locked.");
  } else {
    unlink($fname);
  }
  if (-f $fname) {
    print '<p>', Ts('Lock for %s created.', &GetPageLink($id)), '<br>';
  } else {
    print '<p>', Ts('Lock for %s removed.', &GetPageLink($id)), '<br>';
  }
  print &GetCommonFooter();
}

sub DoEditBanned {
  my ($banList, $status);

  print &GetHeader("", "Editing Banned list", "");
  return  if (!&UserIsAdminOrError());
  ($status, $banList) = &ReadFile("$DataDir/banlist");
  $banList = ""  if (!$status);
  print &GetFormStart();
  print GetHiddenValue("edit_ban", 1), "\n";
  print "<b>Banned IP/network/host list:</b><br>\n";
  print "<p>Each entry is either a commented line (starting with #), ",
        "or a Perl regular expression (matching either an IP address or ",
        "a hostname).  <b>Note:</b> To test the ban on yourself, you must ",
        "give up your admin access (remove password in Preferences).";
  print "<p>Examples:<br>",
        "\\.foocorp.com\$  (blocks hosts ending with .foocorp.com)<br>",
        "^123.21.3.9\$  (blocks exact IP address)<br>",
        "^123.21.3.  (blocks whole 123.21.3.* IP network)<p>";
  print &GetTextArea('banlist', $banList, 12, 50);
  print "<br>", $q->submit(-name=>'Save'), "\n";
  print "<hr>\n";
  print &GetGotoBar("");
  print $q->endform;
  print &GetMinimumFooter();
}

sub DoUpdateBanned {
  my ($newList, $fname);

  print &GetHeader("", "Updating Banned list", "");
  return  if (!&UserIsAdminOrError());
  $fname = "$DataDir/banlist";
  $newList = &GetParam("banlist", "#Empty file");
  if ($newList eq "") {
    print "<p>Empty banned list or error.";
    print "<p>Resubmit with at least one space character to remove.";
  } elsif ($newList =~ /^\s*$/s) {
    unlink($fname);
    print "<p>Removed banned list";
  } else {
    &WriteStringToFile($fname, $newList);
    print "<p>Updated banned list";
  }
  print &GetCommonFooter();
}

1;