#!/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|
|i  && ( $insidePRE = 1 );
		m|
|i && ( $insidePRE = 0 ); if( m||i ) { $insideVERBATIM = 1; } if( m||i ) { $insideVERBATIM = 0; } m||i && ( $noAutoLink = 1 ); m||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.
/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.
/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; }