437 lines
14 KiB
Perl
Executable file
437 lines
14 KiB
Perl
Executable file
#!/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
|
|
#
|
|
|
|
# Set library paths in @INC, at compile time
|
|
BEGIN { unshift @INC, '.'; require 'setlib.cfg'; }
|
|
|
|
# 'Use locale' for internationalisation of Perl regexes -
|
|
# main locale settings are done in TWiki::setupLocale
|
|
BEGIN {
|
|
# Do a dynamic 'use locale' for this module
|
|
if( $TWiki::useLocale ) {
|
|
require locale;
|
|
import locale ();
|
|
}
|
|
}
|
|
|
|
use CGI::Carp qw( fatalsToBrowser );
|
|
use CGI;
|
|
use TWiki;
|
|
|
|
use strict;
|
|
|
|
use vars qw($query);
|
|
|
|
&main();
|
|
|
|
|
|
sub main
|
|
{
|
|
$query= new CGI;
|
|
my $thePathInfo = $query->path_info();
|
|
my $theRemoteUser = $query->remote_user();
|
|
my $theTopic = $query->param( 'topic' );
|
|
my $newWeb = $query->param( 'newweb' ) || "";
|
|
my $newTopic = $query->param( 'newtopic' ) || "";
|
|
my $theUrl = $query->url;
|
|
my $lockFailure = "";
|
|
my $breakLock = $query->param( 'breaklock' );
|
|
my $theAttachment = $query->param( 'attachment' );
|
|
my $confirm = $query->param( 'confirm' );
|
|
my $currentWebOnly = $query->param( 'currentwebonly' ) || "";
|
|
my $doAllowNonWikiWord = $query->param( 'nonwikiword' ) || "";
|
|
my ( $oldTopic, $oldWeb, $scriptUrlPath, $userName, $dataDir ) =
|
|
&TWiki::initialize( $thePathInfo, $theRemoteUser, $theTopic, $theUrl, $query ); # DRKW difference to core
|
|
my $skin = $query->param( "skin" ) || TWiki::Prefs::getPreferencesValue( "SKIN" );
|
|
|
|
$newTopic =~ s/\s//go;
|
|
$newTopic =~ s/$TWiki::securityFilter//go;
|
|
|
|
if( ! $theAttachment ) {
|
|
$theAttachment = "";
|
|
}
|
|
|
|
my $wikiUserName = &TWiki::userToWikiName( $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 = $query->param( 'changeRefs' ) || "";
|
|
|
|
my $fileName = &TWiki::Store::getFileName( $oldWeb, $oldTopic );
|
|
my $newName;
|
|
$newName = &TWiki::Store::getFileName( $newWeb, $newTopic ) if( $newWeb );
|
|
|
|
if( ! $justChangeRefs ) {
|
|
if( checkExist( $oldWeb, $oldTopic, $newWeb, $newTopic, $theAttachment, $fileName, $newName ) ) {
|
|
return;
|
|
}
|
|
|
|
if( ! checkPermissions( $oldWeb, $oldTopic, $wikiUserName ) ) {
|
|
return;
|
|
}
|
|
}
|
|
|
|
# Has user selected new name yet?
|
|
if( ! $newTopic || $confirm ) {
|
|
newTopicScreen( $oldWeb, $oldTopic, $newWeb, $newTopic, $theAttachment,
|
|
$confirm, $currentWebOnly, $skin );
|
|
return;
|
|
}
|
|
|
|
if( ! $justChangeRefs ) {
|
|
if( ! getLocks( $oldWeb, $oldTopic, $newWeb, $newTopic, $theAttachment, $breakLock, $skin ) ) {
|
|
return;
|
|
}
|
|
}
|
|
|
|
if( ! $justChangeRefs ) {
|
|
if( $theAttachment ) {
|
|
my $moveError =
|
|
&TWiki::Store::moveAttachment( $oldWeb, $oldTopic, $newWeb, $newTopic, $theAttachment );
|
|
if( $moveError ) {
|
|
TWiki::redirect( $query, &TWiki::getOopsUrl( $newWeb, $newTopic, "oopsmoveerr", $theAttachment, $moveError ) );
|
|
return;
|
|
}
|
|
} else {
|
|
if( ! $doAllowNonWikiWord && ! &TWiki::isWikiName( $newTopic ) ) {
|
|
TWiki::redirect( $query, &TWiki::getOopsUrl( $newWeb, $newTopic, "oopsrenamenotwikiword" ) );
|
|
return;
|
|
}
|
|
my $renameError = &TWiki::Store::renameTopic( $oldWeb, $oldTopic, $newWeb, $newTopic, "relink" );
|
|
if( $renameError ) {
|
|
TWiki::redirect( $query, &TWiki::getOopsUrl( $oldWeb, $oldTopic, "oopsrenameerr", $renameError, $newWeb, $newTopic ) );
|
|
return;
|
|
}
|
|
}
|
|
}
|
|
|
|
# Update references in referring pages - not applicable to attachments.
|
|
if( ! $theAttachment ) {
|
|
my @refs = findReferingPages( $oldWeb, $oldTopic );
|
|
my $problems;
|
|
( $lockFailure, $problems ) =
|
|
updateReferingPages( $oldWeb, $oldTopic, $wikiUserName, $newWeb, $newTopic, @refs );
|
|
}
|
|
|
|
my $new_url = "";
|
|
if( $lockFailure ) {
|
|
moreRefsToChange( $oldWeb, $oldTopic, $newWeb, $newTopic, $skin );
|
|
return;
|
|
} else {
|
|
#redirect to new topic
|
|
$new_url = &TWiki::getViewUrl( $newWeb, $newTopic );
|
|
}
|
|
|
|
TWiki::redirect( $query, $new_url );
|
|
return;
|
|
}
|
|
|
|
|
|
#=========================
|
|
sub findReferingPages
|
|
{
|
|
my @result = ();
|
|
|
|
# Go through parameters finding all topics for change
|
|
my @types = qw\local global\;
|
|
foreach my $type ( @types ) {
|
|
my $count = 1;
|
|
while( $query->param( "TOPIC$type$count" ) ) {
|
|
my $checked = $query->param( "RENAME$type$count" );
|
|
if ($checked) {
|
|
push @result, $type;
|
|
push @result, $query->param( "TOPIC$type$count" );
|
|
}
|
|
$count++;
|
|
}
|
|
}
|
|
return @result;
|
|
}
|
|
|
|
|
|
#==================================
|
|
# update pages that refer to the one being renamed/moved
|
|
sub updateReferingPages
|
|
{
|
|
my ( $oldWeb, $oldTopic, $wikiUserName, $newWeb, $newTopic, @refs ) = @_;
|
|
|
|
my $lockFailure = 0;
|
|
|
|
my $result = "";
|
|
my $alphaNum = $TWiki::mixedAlphaNum;
|
|
my $preTopic = '^|[^${alphaNum}_]'; # Start of line or non-alphanumeric
|
|
my $postTopic = '$|[^${alphaNum}_]'; # End of line or non-alphanumeric
|
|
my $spacedTopic = TWiki::Search::spacedTopic( $oldTopic );
|
|
|
|
while ( @refs ) {
|
|
my $type = shift @refs;
|
|
my $item = shift @refs;
|
|
my( $itemWeb, $itemTopic ) = TWiki::Store::normalizeWebTopicName( "", $item );
|
|
if ( &TWiki::Store::topicIsLockedBy( $itemWeb, $itemTopic ) ) {
|
|
$lockFailure = 1;
|
|
} else {
|
|
my $resultText = "";
|
|
$result .= ":$item: , ";
|
|
#open each file, replace $topic with $newTopic
|
|
if ( &TWiki::Store::topicExists($itemWeb, $itemTopic) ) {
|
|
my $scantext = &TWiki::Store::readTopicRaw($itemWeb, $itemTopic);
|
|
if( ! &TWiki::Access::checkAccessPermission( "change", $wikiUserName, $scantext,
|
|
$itemWeb, $itemTopic ) ) {
|
|
# This shouldn't happen, as search will not return, but check to be on the safe side
|
|
&TWiki::writeWarning( "rename: attempt to change $itemWeb.$itemTopic without permission" );
|
|
next;
|
|
}
|
|
my $insidePRE = 0;
|
|
my $insideVERBATIM = 0;
|
|
my $noAutoLink = 0;
|
|
foreach( split( /\n/, $scantext ) ) {
|
|
if( /^%META:TOPIC(INFO|MOVED)/ ) {
|
|
$resultText .= "$_\n";
|
|
next;
|
|
}
|
|
# FIXME This code is in far too many places - also in Search.pm and Store.pm
|
|
m|<pre>|i && ( $insidePRE = 1 );
|
|
m|</pre>|i && ( $insidePRE = 0 );
|
|
if( m|<verbatim>|i ) {
|
|
$insideVERBATIM = 1;
|
|
}
|
|
if( m|</verbatim>|i ) {
|
|
$insideVERBATIM = 0;
|
|
}
|
|
m|<noautolink>|i && ( $noAutoLink = 1 );
|
|
m|</noautolink>|i && ( $noAutoLink = 0 );
|
|
|
|
if( ! ( $insidePRE || $insideVERBATIM || $noAutoLink ) ) {
|
|
if( $type eq "global" ) {
|
|
my $insertWeb = ($itemWeb eq $newWeb) ? "" : "$newWeb.";
|
|
s/($preTopic)\Q$oldWeb.$oldTopic\E(?=$postTopic)/$1$insertWeb$newTopic/g;
|
|
} else {
|
|
# Only replace bare topic (i.e. not preceeded by web) if web of referring
|
|
# topic is in original Web of topic that's being moved
|
|
if( $oldWeb eq $itemWeb ) {
|
|
my $insertWeb = ($oldWeb eq $newWeb) ? "" : "$newWeb.";
|
|
s/($preTopic)\Q$oldTopic\E(?=$postTopic)/$1$insertWeb$newTopic/g;
|
|
s/\[\[($spacedTopic)\]\]/[[$newTopic][$1]]/gi;
|
|
}
|
|
}
|
|
}
|
|
$resultText .= "$_\n";
|
|
}
|
|
my ( $meta, $text ) = &TWiki::Store::_extractMetaData( $itemWeb, $itemTopic, $resultText );
|
|
&TWiki::Store::saveTopic( $itemWeb, $itemTopic, $text, $meta, "", "unlock", "dontNotify", "" );
|
|
} else {
|
|
$result .= ";$item does not exist;";
|
|
}
|
|
}
|
|
}
|
|
return ( $lockFailure, $result );
|
|
}
|
|
|
|
|
|
#=============================
|
|
# return "" if problem, otherwise return text of oldTopic
|
|
sub checkPermissions
|
|
{
|
|
my( $oldWeb, $oldTopic, $wikiUserName ) = @_;
|
|
|
|
my $ret = "";
|
|
|
|
if( &TWiki::Store::topicExists( $oldWeb, $oldTopic ) ) {
|
|
$ret = &TWiki::Store::readWebTopic( $oldWeb, $oldTopic );
|
|
}
|
|
|
|
if( ! &TWiki::Access::checkAccessPermission( "change", $wikiUserName, $ret, $oldTopic, $oldWeb ) ) {
|
|
# user has not permission to change the topic
|
|
my $url = &TWiki::getOopsUrl( $oldWeb, $oldTopic, "oopsaccesschange" );
|
|
TWiki::redirect( $query, $url );
|
|
$ret = "";
|
|
}
|
|
|
|
|
|
if( ! &TWiki::Access::checkAccessPermission( "rename", $wikiUserName, $ret, $oldTopic, $oldWeb ) ) {
|
|
my $url = &TWiki::getOopsUrl( $oldWeb, $oldTopic, "oopsaccessrename" );
|
|
TWiki::redirect( $query, $url );
|
|
$ret = "";
|
|
}
|
|
|
|
return $ret;
|
|
}
|
|
|
|
|
|
#==========================================
|
|
# Check that various webs and topics exist or don't exist as required
|
|
sub checkExist
|
|
{
|
|
my( $oldWeb, $oldTopic, $newWeb, $newTopic, $theAttachment, $oldFileName, $newFileName ) = @_;
|
|
|
|
my $ret = "";
|
|
my $tmpl = "";
|
|
|
|
# Does old WEB exist?
|
|
if( ! &TWiki::Store::webExists( $oldWeb ) ) {
|
|
TWiki::redirect( $query, &TWiki::getOopsUrl( $oldWeb, $oldTopic, "oopsnoweb" ) );
|
|
$ret = "problem";
|
|
}
|
|
|
|
# Does new WEB exist?
|
|
if( defined( $newFileName ) && ! &TWiki::Store::webExists( $newWeb ) ) {
|
|
TWiki::redirect( $query, &TWiki::getOopsUrl( $newWeb, $newTopic, "oopsnoweb" ) );
|
|
$ret = "problem";
|
|
}
|
|
|
|
# Does old attachment exist?
|
|
if( ! -e $oldFileName) {
|
|
TWiki::redirect( $query, &TWiki::getOopsUrl( $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( $query, &TWiki::getOopsUrl( $newWeb, $newTopic, "oopstopicexists" ) );
|
|
$ret = "problem";
|
|
}
|
|
|
|
if( defined( $newFileName ) && $theAttachment && ! -e $newFileName ) {
|
|
TWiki::redirect( $query, &TWiki::getOopsUrl( $newWeb, $newTopic, "oopsmissing" ) );
|
|
$ret = "problem";
|
|
}
|
|
|
|
return $ret;
|
|
}
|
|
|
|
|
|
#============================
|
|
#Return "" if can't get lock, otherwise "okay"
|
|
sub getLocks
|
|
{
|
|
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( $oldWeb, $oldTopic );
|
|
if( $oldLockUser ) {
|
|
$oldLockUser = &TWiki::userToWikiName( $oldLockUser );
|
|
use integer;
|
|
$oldLockTime = ( $oldLockTime / 60 ) + 1; # convert to minutes
|
|
}
|
|
|
|
if( $theAttachment ) {
|
|
( $newLockUser, $newLockTime ) = &TWiki::Store::topicIsLockedBy( $newWeb, $newTopic );
|
|
if( $newLockUser ) {
|
|
$newLockUser = &TWiki::userToWikiName( $newLockUser );
|
|
use integer;
|
|
$newLockTime = ( $newLockTime / 60 ) + 1; # convert to minutes
|
|
my $editLock = $TWiki::editLockTime / 60;
|
|
}
|
|
}
|
|
}
|
|
|
|
if( $oldLockUser || $newLockUser ) {
|
|
my $tmpl = &TWiki::Store::readTemplate( "oopslockedrename", $skin );
|
|
my $editLock = $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( $tmpl, $oldTopic, $oldWeb );
|
|
$tmpl = &TWiki::getRenderedVersion( $tmpl, $oldWeb );
|
|
TWiki::writeHeader( $query );
|
|
print $tmpl;
|
|
return "";
|
|
} else {
|
|
&TWiki::Store::lockTopicNew( $oldWeb, $oldTopic );
|
|
if( $theAttachment ) {
|
|
&TWiki::Store::lockTopicNew( $newWeb, $newTopic );
|
|
}
|
|
}
|
|
|
|
return "okay";
|
|
}
|
|
|
|
|
|
#============================
|
|
# Display screen so user can decide on new web and topic.
|
|
sub newTopicScreen
|
|
{
|
|
my( $oldWeb, $oldTopic, $newWeb, $newTopic, $theAttachment, $confirm, $currentWebOnly, $skin ) = @_;
|
|
|
|
my $tmpl = "";
|
|
|
|
if( ! $newTopic ) {
|
|
$newTopic = $oldTopic;
|
|
}
|
|
|
|
TWiki::writeHeader( $query );
|
|
if( $theAttachment ) {
|
|
$tmpl = TWiki::Store::readTemplate( "moveattachment", $skin );
|
|
$tmpl =~ s/%FILENAME%/$theAttachment/go;
|
|
} elsif( $confirm ) {
|
|
$tmpl = TWiki::Store::readTemplate( "renameconfirm", $skin );
|
|
} else {
|
|
$tmpl = &TWiki::Store::readTemplate( "rename", $skin );
|
|
}
|
|
|
|
$tmpl = setVars( $tmpl, $oldTopic, $newWeb, $newTopic );
|
|
$tmpl = &TWiki::handleCommonTags( $tmpl, $oldTopic, $oldWeb );
|
|
$tmpl = &TWiki::getRenderedVersion( $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( $tmpl, $oldTopic, $oldWeb );
|
|
print $tmpl;
|
|
}
|
|
|
|
#=========================
|
|
sub setVars
|
|
{
|
|
my( $tmpl, $oldTopic, $newWeb, $newTopic ) = @_;
|
|
$tmpl =~ s/%NEW_WEB%/$newWeb/go;
|
|
$tmpl =~ s/%NEW_TOPIC%/$newTopic/go;
|
|
|
|
return $tmpl;
|
|
}
|
|
|
|
#=========================
|
|
sub moreRefsToChange
|
|
{
|
|
my( $oldWeb, $oldTopic, $newWeb, $newTopic, $skin ) = @_;
|
|
|
|
TWiki::writeHeader( $query );
|
|
my $tmpl = TWiki::Store::readTemplate( "renamerefs", $skin );
|
|
$tmpl = setVars( $tmpl, $oldTopic, $newWeb, $newTopic );
|
|
$tmpl = TWiki::getRenderedVersion( $tmpl );
|
|
$tmpl =~ s/%RESEARCH/%SEARCH/go; # Pre search result from being rendered
|
|
$tmpl = TWiki::handleCommonTags( $tmpl, $oldTopic, $oldWeb );
|
|
print $tmpl;
|
|
}
|
|
|