nsbin/rename

438 lines
14 KiB
Text
Raw Normal View History

#!/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;
}