#!/usr/bin/perl -wT
#
# TWiki Collaboration Platform, http://TWiki.org/
#
# Copyright (C) 2001-2003 Peter Thoeny, peter@thoeny.com
# Copyright (C) 2001 Sven Dowideit, svenud@ozemail.com.au
#
# For licensing info read license.txt file in the TWiki root.
# 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, published at
# http://www.gnu.org/copyleft/gpl.html
#

BEGIN {
    # Set default current working directory
    if( $ENV{"SCRIPT_FILENAME"} && $ENV{"SCRIPT_FILENAME"} =~ /^(.+)\/[^\/]+$/ ) {
        chdir $1;
    }
    # Set library paths in @INC at compile time
    unshift @INC, '.';
    require 'setlib.cfg';

    # 'Use locale' for internationalisation of Perl regexes -
    # main locale settings are done in TWiki::setupLocale
    # Do a dynamic 'use locale' for this module
    if( $$config{'TWiki::useLocale'} ) {
        require locale;
	import locale ();
    }
}

use CGI::Carp qw( fatalsToBrowser );
use CGI;
use TWiki;

use strict;


&main();


sub main
{ 
   my %configHash; 
   my $config = \%configHash;
   my $twikiUri = $ENV{"SCRIPT_FILENAME"};
   $twikiUri =~ s!/+!/!g ; # remove multiple'/' 
   my @twikiUriItem = split ( '/' , $twikiUri ) ;
   $$config{'fileConfig'} = $ENV{"SERVER_NAME"} . "Port" . $ENV{"SERVER_PORT"} . $twikiUriItem[$#twikiUriItem - 2 ];

    $$config{'rename::query'}= new CGI;
    my $thePathInfo = $$config{'rename::query'}->path_info(); 
    my $theRemoteUser = $$config{'rename::query'}->remote_user();
    my $theTopic = $$config{'rename::query'}->param( 'topic' );
    my $newWeb = $$config{'rename::query'}->param( 'newweb' ) || "";
    my $newTopic = $$config{'rename::query'}->param( 'newtopic' ) || "";
    my $theUrl = $$config{'rename::query'}->url;
    my $lockFailure = "";
    my $breakLock = $$config{'rename::query'}->param( 'breaklock' );
    my $theAttachment = $$config{'rename::query'}->param( 'attachment' );
    my $confirm = $$config{'rename::query'}->param( 'confirm' );
    my $currentWebOnly = $$config{'rename::query'}->param( 'currentwebonly' ) || "";
    my $doAllowNonWikiWord = $$config{'rename::query'}->param( 'nonwikiword' ) || "";
    my ( $oldTopic, $oldWeb, $scriptUrlPath, $userName, $dataDir ) = 
        &TWiki::initialize($config, $thePathInfo, $theRemoteUser, $theTopic, $theUrl, $$config{'rename::query'} ); # DRKW difference to core
    my $skin = $$config{'rename::query'}->param( "skin" ) || TWiki::Prefs::getPreferencesValue($config, "SKIN" );
    
    $newTopic =~ s/\s//go;
    $newTopic =~ s/$$config{'TWiki::securityFilter'}//go;

    if( ! $theAttachment ) {
        $theAttachment = "";
    }
    
    my $wikiUserName = &TWiki::userToWikiName($config, $userName );
    
    # justChangeRefs will be true when some topics that had links to $oldTopic
    # still need updating, previous update being prevented by a lock.
    my $justChangeRefs = $$config{'rename::query'}->param( 'changeRefs' ) || "";

    my $fileName = &TWiki::Store::getFileName($config, $oldWeb, $oldTopic );
    my $newName;
    $newName = &TWiki::Store::getFileName($config, $newWeb, $newTopic ) if( $newWeb );
    
    if( ! $justChangeRefs ) {
       if( checkExist($config, $oldWeb, $oldTopic, $newWeb, $newTopic, $theAttachment, $fileName, $newName ) ) {
           return;
       }

       if( ! checkPermissions($config, $oldWeb, $oldTopic, $wikiUserName ) ) {
           return;
       }
    }

    # Has user selected new name yet?
    if( ! $newTopic || $confirm ) {
       newTopicScreen($config, $oldWeb, $oldTopic, $newWeb, $newTopic, $theAttachment,
                       $confirm, $currentWebOnly, $skin );
       return;
    } 
    
    if( ! $justChangeRefs ) {
        if( ! getLocks($config, $oldWeb, $oldTopic, $newWeb, $newTopic, $theAttachment, $breakLock, $skin ) ) {
              return;
        }
    }

    if( ! $justChangeRefs ) {
       if( $theAttachment ) {
	  my $moveError = 
	     &TWiki::Store::moveAttachment($config, $oldWeb, $oldTopic, $newWeb, $newTopic, $theAttachment );
	  if( $moveError ) {
              TWiki::redirect($config, $$config{'rename::query'}, &TWiki::getOopsUrl($config, $newWeb, $newTopic, "oopsmoveerr", $theAttachment, $moveError ) );
              return;
          }
       } else {
          if( ! $doAllowNonWikiWord && ! &TWiki::isWikiName($config, $newTopic ) ) {
              TWiki::redirect($config, $$config{'rename::query'}, &TWiki::getOopsUrl($config, $newWeb, $newTopic, "oopsrenamenotwikiword" ) );
              return;
          }
	  my $renameError = &TWiki::Store::renameTopic($config, $oldWeb, $oldTopic, $newWeb, $newTopic, "relink" );
	  if( $renameError ) {
	      TWiki::redirect($config, $$config{'rename::query'}, &TWiki::getOopsUrl($config, $oldWeb, $oldTopic, "oopsrenameerr", $renameError, $newWeb, $newTopic ) );
	      return;
           }
       } 
    }

    # Update references in referring pages - not applicable to attachments.
    if( ! $theAttachment ) {
        my @refs = findReferingPages($config, $oldWeb, $oldTopic );
        my $problems;
        ( $lockFailure, $problems ) = 
            &TWiki::Store::updateReferingPages($config, $oldWeb, $oldTopic, $wikiUserName, $newWeb, $newTopic, @refs );
    }

    my $new_url = "";
    if( $lockFailure ) {
       moreRefsToChange($config, $oldWeb, $oldTopic, $newWeb, $newTopic, $skin );
       return;
    } elsif ( "$newWeb" eq "Trash" && "$oldWeb" ne "Trash" ) {
        if( $theAttachment ) {
            # go back to old topic after deleting an attachment
            $new_url = &TWiki::getViewUrl($config, $oldWeb, $oldTopic );
        } else {
            #redirect to parent: ending in Trash is not the expected way (ColasNahaboo - 31 Mar 2003)
            my $meta = ""; my $text = "";
            ( $meta, $text ) = &TWiki::Store::readTopic($config, $newWeb, $newTopic, 1 );
            my %parent = $meta->findOne( "TOPICPARENT" );
            if( %parent && $parent{"name"} && $parent{"name"} ne $oldTopic ) {
                if ( $parent{"name"} =~ /([^.]+)[.]([^.]+)/ ) {
                    $new_url = &TWiki::getViewUrl($config, $1, $2 );
                } else {
                    $new_url = &TWiki::getViewUrl($config, $oldWeb, $parent{"name"} );
                }
            } else {

                $new_url = &TWiki::getViewUrl($config, $oldWeb, $$config{'rename::mainTopicname'} );
            }
        }
    } else {
       #redirect to new topic
       $new_url = &TWiki::getViewUrl($config, $newWeb, $newTopic );
    }

    TWiki::redirect($config, $$config{'rename::query'}, $new_url );
    return;
}

#=========================
# TODO: rename this method to getReferingTopicsListFromURL
sub findReferingPages
{ 
	my $config = shift;

    my @result = ();
    
    # Go through parameters finding all topics for change
    my @types = qw\local global\;
    foreach my $type ( @types ) {
	my $count = 1;
	while( $$config{'rename::query'}->param( "TOPIC$type$count" ) ) {
	   my $checked = $$config{'rename::query'}->param( "RENAME$type$count" );
	   if ($checked) {
	      push @result, $type;
	      push @result, $$config{'rename::query'}->param( "TOPIC$type$count" );
	   }
	   $count++;
	}
    }
    return @result;
}


#=============================
# return "" if problem, otherwise return text of oldTopic
sub checkPermissions
{ 
	my $config = shift;

    my( $oldWeb, $oldTopic, $wikiUserName ) = @_;
   
    my $ret = "";
   
    if( &TWiki::Store::topicExists($config, $oldWeb, $oldTopic ) ) {
	$ret = &TWiki::Store::readWebTopic($config, $oldWeb, $oldTopic );
    }
    
    if( ! &TWiki::Access::checkAccessPermission($config, "change", $wikiUserName, $ret, $oldTopic, $oldWeb ) ) {
       # user has not permission to change the topic
       my $url = &TWiki::getOopsUrl($config, $oldWeb, $oldTopic, "oopsaccesschange" );
       TWiki::redirect($config, $$config{'rename::query'}, $url );
       $ret = "";
    }
    
    
    if( ! &TWiki::Access::checkAccessPermission($config, "rename", $wikiUserName, $ret, $oldTopic, $oldWeb ) ) {
       my $url = &TWiki::getOopsUrl($config, $oldWeb, $oldTopic, "oopsaccessrename" );
       TWiki::redirect($config, $$config{'rename::query'}, $url );
       $ret = "";
    }

    return $ret;
}


#==========================================
# Check that various webs and topics exist or don't exist as required
sub checkExist
{ 
	my $config = shift;

   my( $oldWeb, $oldTopic, $newWeb, $newTopic, $theAttachment, $oldFileName, $newFileName ) = @_;
   
   my $ret = "";
   my $tmpl = "";
   
   # Does old WEB exist?
   if( ! &TWiki::Store::webExists($config, $oldWeb ) ) {
      TWiki::redirect($config, $$config{'rename::query'}, &TWiki::getOopsUrl($config, $oldWeb, $oldTopic, "oopsnoweb" ) );
      $ret = "problem";
   }

   # Does new WEB exist?
   if( defined( $newFileName ) && ! &TWiki::Store::webExists($config, $newWeb ) ) {
      TWiki::redirect($config, $$config{'rename::query'}, &TWiki::getOopsUrl($config, $newWeb, $newTopic, "oopsnoweb" ) );
      $ret = "problem";
   }

   # Does old attachment exist?
   if( ! -e $oldFileName) {
      TWiki::redirect($config, $$config{'rename::query'}, &TWiki::getOopsUrl($config, $oldWeb, $oldTopic, "oopsmissing" ) );
      $ret = "problem"; 
   }

   # Check new topic doesn't exist (opposite if we've moving an attachment)
   if( defined( $newFileName ) && -e $newFileName && ! $theAttachment ) {
      # Unless moving an attachment, new topic should not already exist
      TWiki::redirect($config, $$config{'rename::query'}, &TWiki::getOopsUrl($config, $newWeb, $newTopic, "oopstopicexists" ) );
      $ret = "problem";    
   }    
   
   if( defined( $newFileName ) && $theAttachment && ! -e $newFileName ) {
      TWiki::redirect($config, $$config{'rename::query'}, &TWiki::getOopsUrl($config, $newWeb, $newTopic, "oopsmissing" ) );
      $ret = "problem"; 
   }
   
   return $ret;
}


#============================
#Return "" if can't get lock, otherwise "okay"
sub getLocks
{ 
	my $config = shift;

    my( $oldWeb, $oldTopic, $newWeb, $newTopic, $theAttachment, $breakLock, $skin ) = @_;
    
    my( $oldLockUser, $oldLockTime, $newLockUser, $newLockTime );
    
    if( ! $breakLock ) {
	# Check for lock - at present the lock can't be broken
	( $oldLockUser, $oldLockTime ) = &TWiki::Store::topicIsLockedBy($config, $oldWeb, $oldTopic );
	if( $oldLockUser ) {
	   $oldLockUser = &TWiki::userToWikiName($config, $oldLockUser );
	   use integer;
	   $oldLockTime = ( $oldLockTime / 60 ) + 1; # convert to minutes
	}

	if( $theAttachment ) {
	    ( $newLockUser, $newLockTime ) = &TWiki::Store::topicIsLockedBy($config, $newWeb, $newTopic );
	    if( $newLockUser ) {
	       $newLockUser = &TWiki::userToWikiName($config, $newLockUser );
	       use integer;
	       $newLockTime = ( $newLockTime / 60 ) + 1; # convert to minutes
	       my $editLock = $$config{'TWiki::editLockTime'} / 60;
	    }
	}
    }
    
    if( $oldLockUser || $newLockUser ) {
       my $tmpl = &TWiki::Store::readTemplate($config, "oopslockedrename", $skin );
       my $editLock = $$config{'TWiki::editLockTime'} / 60;
       if( $oldLockUser ) {
           $tmpl =~ s/%OLD_LOCK%/Source topic $oldWeb.$oldTopic is locked by $oldLockUser, lock expires in $oldLockTime minutes.<br \/>/go;
       } else {
           $tmpl =~ s/%OLD_LOCK%//go;
       }
       if( $newLockUser ) {
           $tmpl =~ s/%NEW_LOCK%/Destination topic $newWeb.$newTopic is locked by $newLockUser, lock expires in $newLockTime minutes.<br \/>/go;
       } else {
           $tmpl =~ s/%NEW_LOCK%//go;
       }
       $tmpl =~ s/%NEW_WEB%/$newWeb/go;
       $tmpl =~ s/%NEW_TOPIC%/$newTopic/go;
       $tmpl =~ s/%ATTACHMENT%/$theAttachment/go;
       $tmpl = &TWiki::handleCommonTags($config, $tmpl, $oldTopic, $oldWeb );
       $tmpl = &TWiki::getRenderedVersion($config, $tmpl, $oldWeb );
       $tmpl =~ s/( ?) *<\/?(nop|noautolink)\/?>\n?/$1/gois;   # remove <nop> and <noautolink> tags
       TWiki::writeHeader($config, $$config{'rename::query'} );
       print $tmpl;
       return "";
    } else {
       &TWiki::Store::lockTopicNew($config, $oldWeb, $oldTopic );
       if( $theAttachment ) {
            &TWiki::Store::lockTopicNew($config, $newWeb, $newTopic );
       }
    }
    
    return "okay";
}


#============================
# Display screen so user can decide on new web and topic.
sub newTopicScreen
{ 
	my $config = shift;

   my( $oldWeb, $oldTopic, $newWeb, $newTopic, $theAttachment, $confirm, $currentWebOnly, $skin ) = @_;
   
   my $tmpl = "";
   
   if( ! $newTopic ) {
       $newTopic = $oldTopic;
   }
   
   TWiki::writeHeader($config, $$config{'rename::query'} );
   if( $theAttachment ) {
     $tmpl = TWiki::Store::readTemplate($config, "moveattachment", $skin );
     $tmpl =~ s/%FILENAME%/$theAttachment/go;
   } elsif( $confirm ) {
     $tmpl = TWiki::Store::readTemplate($config, "renameconfirm", $skin );
   } else {
     $tmpl = &TWiki::Store::readTemplate($config, "rename", $skin );
   }
   
   $tmpl = setVars($config, $tmpl, $oldTopic, $newWeb, $newTopic );
   $tmpl = &TWiki::handleCommonTags($config, $tmpl, $oldTopic, $oldWeb );
   $tmpl = &TWiki::getRenderedVersion($config, $tmpl );
   if( $currentWebOnly ) {
     $tmpl =~ s/%RESEARCH\{.*?web=\"all\".*\}%/(skipped)/o; # Remove search all web search
   }
   $tmpl =~ s/%RESEARCH/%SEARCH/go; # Pre search result from being rendered
   $tmpl = &TWiki::handleCommonTags($config, $tmpl, $oldTopic, $oldWeb );   
   $tmpl =~ s/( ?) *<\/?(nop|noautolink)\/?>\n?/$1/gois;   # remove <nop> and <noautolink> tags
   print $tmpl;
 }
 
 #=========================
 sub setVars
 { 
	my $config = shift;

     my( $tmpl, $oldTopic, $newWeb, $newTopic ) = @_;
     $tmpl =~ s/%NEW_WEB%/$newWeb/go;
     $tmpl =~ s/%NEW_TOPIC%/$newTopic/go;
     
     return $tmpl;
 }
 
 #=========================
 sub moreRefsToChange
 { 
	my $config = shift;

    my( $oldWeb, $oldTopic, $newWeb, $newTopic, $skin ) = @_;
    
    TWiki::writeHeader($config, $$config{'rename::query'} );
    my $tmpl = TWiki::Store::readTemplate($config, "renamerefs", $skin );
    $tmpl = setVars($config, $tmpl, $oldTopic, $newWeb, $newTopic );
    $tmpl = TWiki::getRenderedVersion($config, $tmpl );
    $tmpl =~ s/%RESEARCH/%SEARCH/go; # Pre search result from being rendered
    $tmpl = TWiki::handleCommonTags($config, $tmpl, $oldTopic, $oldWeb );
    $tmpl =~ s/( ?) *<\/?(nop|noautolink)\/?>\n?/$1/gois;   # remove <nop> and <noautolink> tags
    print $tmpl;
 }

