# Module of TWiki Enterprise Collaboration Platform, http://TWiki.org/
#
# Copyright (C) 1999-2007 Peter Thoeny, peter@thoeny.org
# and TWiki Contributors. All Rights Reserved. TWiki Contributors
# are listed in the AUTHORS file in the root of this distribution.
# NOTE: Please extend that file, not this notice.
#
# 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. For
# more details read LICENSE in the root of this distribution.
#
# 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.
#
# As per the GPL, removal of this notice is prohibited.

=begin twiki

---+ package TWiki::UI::Manage

UI functions for web, topic and user management

=cut

package TWiki::UI::Manage;

use strict;
use Assert;
use TWiki;
use TWiki::UI;
use TWiki::User;
use TWiki::Sandbox;
use Error qw( :try );
use TWiki::OopsException;
use TWiki::UI::Register;

=pod

---++ StaticMethod manage( $session )

=manage= command handler.
This method is designed to be
invoked via the =TWiki::UI::run= method.

=cut

sub manage {
    my $session = shift;

    my $action = $session->{cgiQuery}->param( 'action' );

    if( $action eq 'createweb' ) {
        _createWeb( $session );
    } elsif( $action eq 'changePassword' ) {
        TWiki::UI::Register::changePassword( $session );
    } elsif ($action eq 'bulkRegister') {
        TWiki::UI::Register::bulkRegister( $session );
    } elsif( $action eq 'deleteUserAccount' ) {
        _removeUser( $session );
    } elsif( $action eq 'editSettings' ) {
        _editSettings( $session );
    } elsif( $action eq 'saveSettings' ) {
        _saveSettings( $session );
    } elsif( $action ) {
        throw TWiki::OopsException( 'attention',
                                    def => 'unrecognized_action',
                                    params => $action );
    } else {
        throw TWiki::OopsException( 'attention', def => 'missing_action' );
    }
}

# Renames the user's topic (with renaming all links) and
# removes user entry from passwords. CGI parameters:
sub _removeUser {
    my $session = shift;

    my $webName = $session->{webName};
    my $topic = $session->{topicName};
    my $query = $session->{cgiQuery};
    my $user = $session->{user};

    my $password = $query->param( 'password' );

    # check if user entry exists
    if( $user && !$user->passwordExists()) {
        throw TWiki::OopsException( 'attention',
                                    web => $webName,
                                    topic => $topic,
                                    def => 'notwikiuser',
                                    params => $user->stringify() );
    }

    #check to see it the user we are trying to remove is a member of a group.
    #initially we refuse to delete the user
    #in a later implementation we will remove the from the group (if Access.pm implements it..)
    my @groups = $user->getGroups();
    if ( scalar( @groups ) > 0 ) { 
        throw TWiki::OopsException( 'attention',
                                    web => $webName,
                                    topic => $topic,
                                    def => 'in_a_group',
                                    params =>
                                    [ $user->stringify(),
                                      join(', ',
                                           map { $_->stringify() }
                                           @groups ) ] );
    }

    unless( $user->checkPassword( $password ) ) {
        throw TWiki::OopsException( 'attention',
                                    web => $webName,
                                    topic => $topic,
                                    def => 'wrong_password');
    }

    $user->remove();

    throw TWiki::OopsException( 'attention',
                                def => 'remove_user_done',
                                web => $webName,
                                topic => $topic,
                                params => $user->webDotWikiName() );
}

sub _isValidHTMLColor {
    my $c = shift;
    return $c =~ m/^(#[0-9a-f]{6}|black|silver|gray|white|maroon|red|purple|fuchsia|green|lime|olive|yellow|navy|blue|teal|aqua)/i;

}

sub _createWeb {
    my $session = shift;

    my $topicName = $session->{topicName};
    my $webName = $session->{webName};
    my $query = $session->{cgiQuery};
    my $user = $session->{user};

    my $webBGColor = $query->param( 'webbgcolor' ) || '';
    my $siteMapWhat = $query->param( 'sitemapwhat' ) || '';
    my $siteMapUseTo = $query->param( 'sitemapuseto' ) || '';
    my $noSearchAll = $query->param( 'nosearchall' ) || '';

    # check permission, user authorized to create web here?
    my $parent = undef; # default is root if no parent web
    if( $webName =~ m|^(.*)[./](.*?)$| ) {
        $parent = $1;
    }
    TWiki::UI::checkAccess( $session, $parent, undef,
                            'CHANGE', $session->{user} );

    my $newWeb = $query->param( 'newweb' ) || '';
    unless( $newWeb ) {
        throw TWiki::OopsException( 'attention', def => 'web_missing' );
    }
    unless ( TWiki::isValidWebName( $newWeb, 1 )) {
        throw TWiki::OopsException
          ( 'attention', def =>'invalid_web_name', params => $newWeb );
    }
    $newWeb = TWiki::Sandbox::untaintUnchecked( $newWeb );

    my $baseWeb = $query->param( 'baseweb' ) || '';
    unless( $session->{store}->webExists( $baseWeb )) {
        throw TWiki::OopsException
          ( 'attention', def => 'base_web_missing', params => $baseWeb );
    }
    $baseWeb = TWiki::Sandbox::untaintUnchecked( $baseWeb );

    my $newTopic = $query->param( 'newtopic' ) || $TWiki::cfg{HomeTopicName};
    # SMELL: check that it is a valid topic name?
    $newTopic = TWiki::Sandbox::untaintUnchecked( $newTopic );

    if( $session->{store}->webExists( $newWeb )) {
        throw TWiki::OopsException
          ( 'attention', def => 'web_exists', params => $newWeb );
    }

    unless( _isValidHTMLColor( $webBGColor )) {
        throw TWiki::OopsException
          ( 'attention', def => 'invalid_web_color',
            params => $webBGColor );
    }

    # create the empty web
    my $opts =
      {
       WEBBGCOLOR => $webBGColor,
       SITEMAPWHAT => $siteMapWhat,
       SITEMAPUSETO => $siteMapUseTo,
       NOSEARCHALL => $noSearchAll,
      };
    $opts->{SITEMAPLIST} = 'on' if( $siteMapWhat );

    my $err = $session->{store}->createWeb( $user, $newWeb, $baseWeb, $opts );
    if( $err ) {
        throw TWiki::OopsException
          ( 'attention', def => 'web_creation_error',
            params => [ $newWeb, $err ] );
    }

    # everything OK, redirect to last message
    throw TWiki::OopsException
      ( 'attention',
        web => $newWeb,
        topic => $newTopic,
        def => 'created_web' );
}

=pod

---++ StaticMethod rename( $session )

=rename= command handler.
This method is designed to be
invoked via the =TWiki::UI::run= method.
Rename the given topic. Details of the new topic name are passed in CGI
parameters:

| =skin= | skin(s) to use |
| =newweb= | new web name |
| =newtopic= | new topic name |
| =breaklock= | |
| =attachment= | |
| =confirm= | if defined, requires a second level of confirmation |
| =currentwebonly= | if defined, searches current web only for links to this topic |
| =nonwikiword= | if defined, a non-wikiword is acceptable for the new topic name |

=cut

sub rename {
    my $session = shift;

    my $oldTopic = $session->{topicName};
    my $oldWeb = $session->{webName};
    my $query = $session->{cgiQuery};
    my $action = $query->param( 'action' ) || '';

    if( $action eq 'renameweb' ) {
        _renameweb( $session );
        return;
    }

    my $newTopic = $query->param( 'newtopic' ) || '';
    $newTopic = TWiki::Sandbox::untaintUnchecked( $newTopic );

    my $newWeb = $query->param( 'newweb' ) || '';
    unless( !$newWeb || TWiki::isValidWebName( $newWeb, 1 )) {
        throw TWiki::OopsException
          ( 'attention', def =>'invalid_web_name', params => $newWeb );
    }
    $newWeb = TWiki::Sandbox::untaintUnchecked( $newWeb );

    my $attachment = $query->param( 'attachment' );
    # SMELL: test for valid attachment name?
    $attachment = TWiki::Sandbox::untaintUnchecked( $attachment );

    my $lockFailure = '';
    my $breakLock = $query->param( 'breaklock' );

    my $confirm = $query->param( 'confirm' );
    my $doAllowNonWikiWord = $query->param( 'nonwikiword' ) || '';
    my $store = $session->{store};

    $newTopic =~ s/\s//go;
    $newTopic =~ s/$TWiki::cfg{NameFilter}//go;
    $newTopic = ucfirst $newTopic;   # Item3270

    $attachment ||= '';

    TWiki::UI::checkWebExists( $session, $oldWeb, $oldTopic, 'rename' );
    # Item3270: Wrap topic existence into extra try/catch block to
    #           check for the same name starting with a lower case letter.
    try {
        TWiki::UI::checkTopicExists( $session, $oldWeb, $oldTopic, 'rename');
    } catch TWiki::OopsException with {
        $oldTopic = lcfirst $oldTopic;
        TWiki::UI::checkTopicExists( $session, $oldWeb, $oldTopic, 'rename');
    };

    if( $newTopic && !TWiki::isValidWikiWord( $newTopic ) ) {
        unless( $doAllowNonWikiWord ) {
            throw TWiki::OopsException( 'attention',
                                        web => $oldWeb,
                                        topic => $oldTopic,
                                        def => 'not_wikiword',
                                        params => [ $newTopic ] );
        }
        # Filter out dangerous characters (. and / may cause
        # issues with pathnames
        $newTopic =~ s![./]!_!g;
        $newTopic =~ s/($TWiki::cfg{NameFilter})//go;
    }

    if ( $attachment) {
        # Does old attachment exist?
        unless( $store->attachmentExists( $oldWeb, $oldTopic,
                                          $attachment )) {
			my $tmplname = $query->param( 'template' ) || '';
            throw TWiki::OopsException(
                'attention',
                web => $oldWeb, topic => $oldTopic,
                def => ($tmplname eq 'deleteattachment') ? 'delete_err' : 'move_err',
                keep => 1,
                params => [
                    $newWeb, $newTopic,
                    $attachment,
                    $session->{i18n}->maketext('Attachment does not exist')
                   ] );
        }

        if( $newWeb && $newTopic ) {
            TWiki::UI::checkTopicExists( $session, $newWeb,
                                         $newTopic, 'rename');

            # does new attachment already exist?
            if( $store->attachmentExists( $newWeb, $newTopic,
                                          $attachment )) {
                throw TWiki::OopsException(
                    'attention',
                    def => 'move_err',
                    web => $oldWeb, topic => $oldTopic,
                    keep => 1,
                    params => [
                        $newWeb, $newTopic,
                        $attachment,
                        $session->{i18n}->maketext(
                            'Attachment already exists in new topic')
                       ] );
            }
        } # else fall through to new topic screen
    } elsif( $newTopic ) {
        ( $newWeb, $newTopic ) =
          $session->normalizeWebTopicName( $newWeb, $newTopic );

        TWiki::UI::checkWebExists( $session, $newWeb, $newTopic, 'rename' );
        if( $store->topicExists( $newWeb, $newTopic)) {
            throw TWiki::OopsException( 'attention',
                                        def => 'rename_topic_exists',
                                        web => $oldWeb,
                                        topic => $oldTopic,
                                        params => [ $newWeb, $newTopic ] );
        }
    }

    TWiki::UI::checkAccess( $session, $oldWeb, $oldTopic,
                            'rename', $session->{user} );

    # Has user selected new name yet?
    if( ! $newTopic || $confirm ) {
        # Must be able to view the source to rename it
        TWiki::UI::checkAccess( $session, $oldWeb, $oldTopic,
                                'view', $session->{user} );
        _newTopicScreen( $session,
                         $oldWeb, $oldTopic,
                         $newWeb, $newTopic,
                         $attachment,
                         $confirm, $doAllowNonWikiWord );
        return;
    }

    # Update references in referring pages - not applicable to attachments.
    my $refs;
    unless( $attachment ) {
        $refs = _getReferringTopicsListFromURL
          ( $session, $oldWeb, $oldTopic, $newWeb, $newTopic );
    }
    move( $session, $oldWeb, $oldTopic, $newWeb, $newTopic,
          $attachment, $refs );

    my $new_url;
    if ( $newWeb eq $TWiki::cfg{TrashWebName} &&
         $oldWeb ne $TWiki::cfg{TrashWebName} ) {

        # deleting something

        if( $attachment ) {
            # go back to old topic after deleting an attachment
            $new_url = $session->getScriptUrl( 0, 'view', $oldWeb, $oldTopic );

        } else {
            # redirect to parent topic, if set
            my ( $meta, $text ) =
              $store->readTopic( undef, $newWeb, $newTopic, undef );
            my $parent = $meta->get( 'TOPICPARENT' );
            my( $parentWeb, $parentTopic );
            if( $parent && defined $parent->{name} ) {
                ( $parentWeb, $parentTopic ) =
                  $session->normalizeWebTopicName( '', $parent->{name} );
            }
            if( $parentTopic &&
                !( $parentWeb eq $oldTopic && $parentTopic eq $oldTopic ) &&
                  $store->topicExists( $parentWeb, $parentTopic ) ) {
                $new_url = $session->getScriptUrl(
                    0, 'view', $parentWeb, $parentTopic );
            } else {
                $new_url = $session->getScriptUrl( 0, 'view', $oldWeb,
                                                   $TWiki::cfg{HomeTopicName});
            }
        }
    } else {
        #redirect to new topic
        $new_url = $session->getScriptUrl( 0, 'view', $newWeb, $newTopic );
    }

    $session->redirect( $new_url );
}

#| =skin= | skin(s) to use |
#| =newsubweb= | new web name |
#| =newparentweb= | new parent web name |
#| =confirm= | if defined, requires a second level of confirmation.  Currently accepted values are "getlock", "continue", and "cancel" |
sub _renameweb {
    my $session = shift;

    my $oldWeb = $session->{webName};
    my $query = $session->{cgiQuery};
    my $user = $session->{user};

    my $newParentWeb = $query->param( 'newparentweb' ) || '';
    unless ( !$newParentWeb || TWiki::isValidWebName( $newParentWeb, 1 )) {
        throw TWiki::OopsException
          ( 'attention', def => 'invalid_web_name', params => $newParentWeb );
    }
    $newParentWeb = TWiki::Sandbox::untaintUnchecked( $newParentWeb );

    my $newSubWeb = $query->param( 'newsubweb' ) || '';;
    unless ( !$newSubWeb || TWiki::isValidWebName( $newSubWeb, 1 )) {
        throw TWiki::OopsException
          ( 'attention', def => 'invalid_web_name', params => $newSubWeb );
    }
    $newSubWeb = TWiki::Sandbox::untaintUnchecked( $newSubWeb );

    my $newWeb;
    if( $newSubWeb ) {
        if( $newParentWeb ) {
            $newWeb = $newParentWeb.'/'.$newSubWeb;
        } else {
            $newWeb=$newSubWeb;
        }
    }
    my @tmp = split( /[\/\.]/, $oldWeb );
    pop( @tmp );
    my $oldParentWeb = join( '/', @tmp );
    my $newTopic;
    my $lockFailure = '';
    my $breakLock = $query->param( 'breaklock' );
    my $confirm = $query->param( 'confirm' ) || '';
    my $doAllowNonWikiWord = $query->param( 'nonwikiword' ) || '';
    my $store = $session->{store};
    my $security = $session->{security};

    TWiki::UI::checkWebExists(
        $session, $oldWeb, $TWiki::cfg{WebPrefsTopicName}, 'rename' );

    if( $newWeb ) {
        if( $newParentWeb ) {
            # SMELL: need to check change permissions of new parent web
            TWiki::UI::checkWebExists(
                $session, $newParentWeb,
                $TWiki::cfg{WebPrefsTopicName}, 'rename' );
        }

        if( $store->webExists( $newWeb )) {
            throw TWiki::OopsException(
                'attention',
                def => 'rename_web_exists',
                web => $oldWeb,
                topic => $TWiki::cfg{WebPrefsTopicName},
                params => [ $newWeb, $TWiki::cfg{WebPrefsTopicName} ] );
        }
    }

    if( ! $newWeb || $confirm ) {

        my %refs;
        my $refs0;
        my $refs1;
        my $totalReferralAccess = 1;
        my $totalWebAccess = 1;
        my $modifyingLockedTopics;
        my $movingLockedTopics;
        my %webTopicInfo;
        my @webList;

        # get a topic list for all the topics referring to this web,
        # and build up a hash containing permissions and lock info.
        $refs0 = getReferringTopics( $session, $oldWeb, undef, 0 );
        $refs1 = getReferringTopics( $session, $oldWeb, undef, 1 );
        foreach my $ref (sort keys %$refs0) {
            $refs{$ref} = $refs0->{$ref};
        }
        foreach my $ref (sort keys %$refs1) {
            $refs{$ref} = $refs1->{$ref};
        }
        $webTopicInfo{referring}{refs0} = $refs0;
        $webTopicInfo{referring}{refs1} = $refs1;

        my $lease_ref;
        foreach my $ref (sort keys %refs) {
            if(defined($ref) && $ref ne "") {
                $ref =~ s/\./\//go;
                my (@path) = split(/\//,$ref);
                my $webTopic = pop(@path);
                my $webIter = join("/",@path);

                $webIter = TWiki::Sandbox::untaintUnchecked( $webIter );
                $webTopic = TWiki::Sandbox::untaintUnchecked( $webTopic );
                if($confirm eq 'getlock') {
                    $store->setLease( $webIter, $webTopic, $user,
                                      $TWiki::cfg{LeaseLength});
                    $lease_ref=$store->getLease($webIter,$webTopic);
                } elsif ($confirm eq 'cancel') {
                    $lease_ref=$store->getLease($webIter,$webTopic);
                    if($lease_ref->{user} eq $user) {
                        $store->clearLease( $webIter, $webTopic );
                    }
                }
                my $wit = $webIter.'/'.$webTopic;
                $webTopicInfo{modify}{$wit}{leaseuser} = $lease_ref->{user};
                $webTopicInfo{modify}{$wit}{leasetime}=$lease_ref->{taken};

                $modifyingLockedTopics++
                  if(defined($webTopicInfo{modify}{$ref}{leaseuser}) &&
                       $webTopicInfo{modify}{$ref}{leaseuser} ne $user);
                $webTopicInfo{modify}{$ref}{summary} = $refs{$ref};
                $webTopicInfo{modify}{$ref}{access} =
                  $security->checkAccessPermission('change', $user,
                                                   undef, undef, $webTopic,
                                                   $webIter);
                if(!$webTopicInfo{modify}{$ref}{access}) {
                    $webTopicInfo{modify}{$ref}{accessReason} =
                      $security->getReason();
                }
                $totalReferralAccess = 0 unless
                  $webTopicInfo{modify}{$ref}{access};
            }
        }

        # get a topic list for this web and all its subwebs, and build
        # up a hash containing permissions and lock info.
        (@webList) = $store->getListOfWebs('public',$oldWeb);
        unshift(@webList,$oldWeb);
        foreach my $webIter (@webList) {
            $webIter = TWiki::Sandbox::untaintUnchecked( $webIter );
            my @webTopicList=$store->getTopicNames($webIter);
            foreach my $webTopic (@webTopicList) {
                $webTopic = TWiki::Sandbox::untaintUnchecked( $webTopic );
                if( $confirm eq 'getlock' ) {
                    $store->setLease( $webIter, $webTopic, $user,
                                      $TWiki::cfg{LeaseLength});
                    $lease_ref = $store->getLease($webIter,$webTopic);
                } elsif ($confirm eq 'cancel') {
                    $lease_ref = $store->getLease($webIter,$webTopic);
                    if( $lease_ref->{user} eq $user ) {
                        $store->clearLease( $webIter, $webTopic );
                    }
                }
                my $wit = $webIter.'/'.$webTopic;
                $webTopicInfo{move}{$wit}{leaseuser} = $lease_ref->{user};
                $webTopicInfo{move}{$wit}{leasetime} = $lease_ref->{taken};

                $movingLockedTopics++
                  if(defined($webTopicInfo{move}{$wit}{leaseuser}) &&
                       $webTopicInfo{move}{$wit}{leaseuser} ne $user);
                $webTopicInfo{move}{$wit}{access} =
                  $security->checkAccessPermission('rename', $user,
                                                   undef, undef, $webTopic,
                                                   $webIter);
                $webTopicInfo{move}{$wit}{accessReason} =
                  $security->getReason();
                $totalWebAccess = ($totalWebAccess &
                                     $webTopicInfo{move}{$wit}{access});
            }
        }

        if( !$totalReferralAccess || !$totalWebAccess ||
              $movingLockedTopics || $modifyingLockedTopics) {

            # check if the user can rename all the topics in this web.
            push( @{$webTopicInfo{movedenied}},
              grep { !$webTopicInfo{move}{$_}{access} }
                sort keys %{$webTopicInfo{move}} );

            # check if there are any locked topics in this web or
            # its subwebs.
            push( @{$webTopicInfo{movelocked}},
              grep { defined($webTopicInfo{move}{$_}{leaseuser}) &&
                       $webTopicInfo{move}{$_}{leaseuser} ne $user }
                sort keys %{$webTopicInfo{move}} );

            # Next, build up a list of all the referrers which the
            # user doesn't have permission to change.
            push( @{$webTopicInfo{modifydenied}},
              grep { !$webTopicInfo{modify}{$_}{access} }
                sort keys %{$webTopicInfo{modify}} );

            # Next, build up a list of all the referrers which are
            # currently locked.
            push( @{$webTopicInfo{modifylocked}},
              grep { defined($webTopicInfo{modify}{$_}{leaseuser}) &&
                       $webTopicInfo{modify}{$_}{leaseuser} ne $user }
                sort keys %{$webTopicInfo{modify}} );

            unless( $confirm ) {
                my $nocontinue = '';
                if( @{$webTopicInfo{movedenied}} ||
                      @{$webTopicInfo{movelocked}} ) {
                    $nocontinue = 'style="display:none;"';
                }
                my $mvd = join(' ', @{$webTopicInfo{movedenied}} ) || ($session->{i18n}->maketext('(none)'));
                $mvd = substr($mvd, 0, 300).'... (more)'
                  if( length($mvd) > 300);
                my $mvl = join(' ', @{$webTopicInfo{movelocked}} ) || ($session->{i18n}->maketext('(none)'));
                $mvl = substr($mvl, 0, 300).'... (more)'
                  if( length($mvl) > 300);
                my $mdd = join(' ', @{$webTopicInfo{modifydenied}} ) || ($session->{i18n}->maketext('(none)'));
                $mdd = substr($mdd, 0, 300).'... (more)'
                  if( length($mdd) > 300);
                my $mdl = join(' ', @{$webTopicInfo{modifylocked}} ) || ($session->{i18n}->maketext('(none)'));
                $mdl = substr($mdl, 0, 300).'... (more)'
                  if( length($mdl) > 300);
                throw TWiki::OopsException(
                    'attention',
                    web => $oldWeb,
                    topic => '',
                    def => 'rename_web_prerequisites',
                    params => [
                        $mvd, $mvl, $mdd, $mdl,
                        $nocontinue
                       ] );
            }
        }

        if ($confirm eq 'cancel') {
            # redirect to original web
            my $viewURL = $session->getScriptUrl( 0, 'view',
                $oldWeb, $TWiki::cfg{HomeTopicName});
            $session->redirect( $viewURL );
        } elsif( $confirm ne 'getlock' ||
                   ($confirm eq 'getlock' &&
                      $modifyingLockedTopics && $movingLockedTopics )) {
            # Has user selected new name yet?
            _newWebScreen( $session, $oldWeb, $newWeb,
                           $confirm, \%webTopicInfo);
            return;
        }
    }

    # Update references in referring pages 
    my $refs = _getReferringTopicsListFromURL(
        $session, $oldWeb, $TWiki::cfg{HomeTopicName},
        $newWeb, $TWiki::cfg{HomeTopicName} );

    # Now, we can move the web.
    _moveWeb( $session, $oldWeb, $newWeb, $refs );

    # now remove lease on all topics inside $newWeb.
    my (@webList) = $store->getListOfWebs('public',$newWeb);
    unshift(@webList,$newWeb);
    foreach my $webIter (@webList) {
        $webIter = TWiki::Sandbox::untaintUnchecked( $webIter );
        my @webTopicList=$store->getTopicNames($webIter);
        foreach my $webTopic (@webTopicList) {
            $webTopic = TWiki::Sandbox::untaintUnchecked( $webTopic );
            $store->clearLease( $webIter, $webTopic );
        }
    }

    # also remove lease on all referring topics
    foreach my $ref (@$refs) {
        $ref =~ s/\./\//go;
        my (@path)=split(/\//,$ref);
        my $webTopic=pop(@path);
        $webTopic = TWiki::Sandbox::untaintUnchecked( $webTopic );
        my $webIter=join("/",@path);
        $webIter = TWiki::Sandbox::untaintUnchecked( $webIter );
        $store->clearLease( $webIter, $webTopic );
    }

    my $new_url = '';
    if ( $newWeb =~ /^$TWiki::cfg{TrashWebName}\b/ &&
           $oldWeb !~ /^$TWiki::cfg{TrashWebName}\b/ ) {

        # redirect to parent
        if( $oldParentWeb ) {
            $new_url = $session->getScriptUrl( 0, 'view',
                $oldParentWeb, $TWiki::cfg{HomeTopicName} );
        } else {
            $new_url = $session->getScriptUrl( 0, 'view',
                $TWiki::cfg{UsersWebName}, $TWiki::cfg{HomeTopicName} );
        }
    } else {
        # redirect to new web
        $new_url = $session->getScriptUrl( 0, 'view',
            $newWeb, $TWiki::cfg{HomeTopicName} );
    }

    $session->redirect( $new_url );
}

=pod

---++ StaticMethod move($session, $oldWeb, $oldTopic, $newWeb, $newTopic, $attachment, \@refs )

Move the given topic, or an attachment in the topic, correcting refs to the topic in the topic itself, and
in the list of topics (specified as web.topic pairs) in the \@refs array.

   * =$session= - reference to session object
   * =$oldWeb= - name of old web - must be untained
   * =$oldTopic= - name of old topic - must be untained
   * =$newWeb= - name of new web - must be untained
   * =$newTopic= - name of new topic - must be untained
   * =$attachment= - name of the attachment to move (from oldtopic to newtopic) (undef to move the topic) - must be untaineted
   * =\@refs= - array of webg.topics that must have refs to this topic converted
Will throw TWiki::OopsException or TWiki::AccessControlException on an error.

=cut

sub move {
    my( $session, $oldWeb, $oldTopic,
        $newWeb, $newTopic, $attachment, $refs ) = @_;
    my $store = $session->{store};

    if( $attachment ) {
        try {
            $store->moveAttachment( $oldWeb, $oldTopic, $attachment,
                                    $newWeb, $newTopic, $attachment,
                                    $session->{user} );
        } catch Error::Simple with {
            throw TWiki::OopsException(
                'attention',
                web => $oldWeb, topic => $oldTopic,
                def => 'move_err',
                params => [ $newWeb, $newTopic,
                            $attachment,
                            shift->{-text} ] );
        };
        return;
    }

    try {
        $store->moveTopic( $oldWeb, $oldTopic, $newWeb, $newTopic,
                           $session->{user} );
    } catch Error::Simple with {
        throw TWiki::OopsException( 'attention',
                                    web => $oldWeb,
                                    topic => $oldTopic,
                                    def => 'rename_err',
                                    params => [ shift->{-text},
                                                $newWeb,
                                                $newTopic ] );
    };

    my( $meta, $text ) = $store->readTopic( undef, $newWeb, $newTopic );

    if( $oldWeb ne $newWeb ) {
        # If the web changed, replace local refs to the topics
        # in $oldWeb with full $oldWeb.topic references so that
        # they still work.
        my $renderer = $session->{renderer};
        $renderer->replaceWebInternalReferences(
            \$text, $meta,
            $oldWeb, $oldTopic, $newWeb, $newTopic );
    }
    # Ok, now let's replace all self-referential links:
    my $options =
      {
       oldWeb => $newWeb,
       oldTopic => $oldTopic,
       newTopic => $newTopic,
       newWeb => $newWeb,
       inWeb => $newWeb,
       fullPaths => 0,
       spacedTopic => TWiki::spaceOutWikiWord( $oldTopic )
      };
    $options->{spacedTopic} =~ s/ / */g;
    $text = $session->{renderer}->forEachLine(
        $text, \&TWiki::Render::replaceTopicReferences, $options );

    $meta->put( 'TOPICMOVED',
                {
                 from => $oldWeb.'.'.$oldTopic,
                 to   => $newWeb.'.'.$newTopic,
                 date => time(),
                 # SMELL: surely this should be webDotWikiname?
                 by   => $session->{user}->wikiName(),
                } );

    $store->saveTopic( $session->{user}, $newWeb, $newTopic, $text, $meta,
                       { minor => 1, comment => 'rename' } );

    # update referrers - but _not_ including the moved topic
    _updateReferringTopics( $session, $oldWeb, $oldTopic,
                            $newWeb, $newTopic, $refs );
}

# Display screen so user can decide on new web and topic.
sub _newTopicScreen {
    my( $session, $oldWeb, $oldTopic, $newWeb, $newTopic, $attachment,
        $confirm, $doAllowNonWikiWord ) = @_;

    my $query = $session->{cgiQuery};
    my $tmplname = $query->param( 'template' ) || '';
    my $tmpl = '';
    my $skin = $session->getSkin();
    my $currentWebOnly = $query->param( 'currentwebonly' ) || '';

    $newTopic = $oldTopic unless ( $newTopic );
    $newWeb = $oldWeb unless ( $newWeb );
    my $nonWikiWordFlag = '';
    $nonWikiWordFlag = 'checked="checked"' if( $doAllowNonWikiWord );

    if( $attachment ) {
        $tmpl = $session->{templates}->readTemplate(
            $tmplname || 'moveattachment', $skin );
        $tmpl =~ s/%FILENAME%/$attachment/go;
    } elsif( $confirm ) {
        $tmpl = $session->{templates}->readTemplate( 'renameconfirm', $skin );
    } elsif( $newWeb eq $TWiki::cfg{TrashWebName} &&
               $oldWeb ne $TWiki::cfg{TrashWebName}) {
        $tmpl = $session->{templates}->readTemplate( 'renamedelete', $skin );
    } else {
        $tmpl = $session->{templates}->readTemplate( 'rename', $skin );
    }

    if( !$attachment && $newWeb eq $TWiki::cfg{TrashWebName} ) {
        # Trashing a topic; look for a non-conflicting name
        $newTopic = $oldWeb.$newTopic;
        my $n = 1;
        my $base = $newTopic;
        while( $session->{store}->topicExists( $newWeb, $newTopic)) {
            $newTopic = $base.$n;
            $n++;
        }
    }

    $tmpl =~ s/%NEW_WEB%/$newWeb/go;
    $tmpl =~ s/%NEW_TOPIC%/$newTopic/go;
    $tmpl =~ s/%NONWIKIWORDFLAG%/$nonWikiWordFlag/go;

    if( !$attachment ) {
        my $refs;
        my $search = '';
        if( $currentWebOnly ) {
            $search = $session->{i18n}->maketext('(skipped)');
        } else {
            $refs = getReferringTopics( $session, $oldWeb, $oldTopic, 1 );
            foreach my $entry ( sort keys %$refs ) {
                $search .= CGI::Tr
                  (CGI::td(
                      { class => 'twikiTopRow' },
                      CGI::input(
                          { type => 'checkbox',
                            class => 'twikiCheckBox',
                            name => 'referring_topics',
                            value => $entry,
                            checked => 'checked' } ). " [[$entry]] " ) .
                              CGI::td(
                                  { class => 'twikiSummary twikiGrayText' },
                                  $refs->{$entry} ));
            }
            unless( $search ) {
                $search = ($session->{i18n}->maketext('(none)'));
            } else {
                $search = CGI::start_table().$search.CGI::end_table();
            }
        }
        $tmpl =~ s/%GLOBAL_SEARCH%/$search/o;

        $refs = getReferringTopics( $session, $oldWeb, $oldTopic, 0 );

        $search = '';;
        foreach my $entry ( sort keys %$refs ) {
            $search .= CGI::Tr
              (CGI::td(
                  { class => 'twikiTopRow' },
                  CGI::input(
                      { type => 'checkbox',
                        class => 'twikiCheckBox',
                        name => 'referring_topics',
                        value => $entry,
                        checked => 'checked' } ). " [[$entry]] " ) .
                          CGI::td(
                              { class => 'twikiSummary twikiGrayText' },
                              $refs->{$entry} ));
        }
        unless( $search ) {
            $search = ($session->{i18n}->maketext('(none)'));
        } else {
            $search = CGI::start_table().$search.CGI::end_table();
        }
        $tmpl =~ s/%LOCAL_SEARCH%/$search/go;
    }

    $tmpl = $session->handleCommonTags( $tmpl, $oldWeb, $oldTopic );
    $tmpl = $session->{renderer}->getRenderedVersion( $tmpl, $oldWeb, $oldTopic );
    $session->writeCompletePage( $tmpl );
}

# _moveWeb($session, $oldWeb,  $newWeb, \@refs )
#
# Move the given web, correcting refs to the web in the web itself, and
# in the list of topics (specified as web.topic pairs) in the \@refs array.
# Currently only called by _renameweb
#
# All permissions and lease conflicts should be resolved before calling this method.
#
#    * =$session= - reference to session object
#    * =$oldWeb= - name of old web
#    * =$newWeb= - name of new web
#    * =\@refs= - array of webg.topics that must have refs to this topic converted
# Will throw TWiki::OopsException on an error.

sub _moveWeb {
    my( $session, $oldWeb, $newWeb, $refs ) = @_;
    my $store = $session->{store};

    $oldWeb =~ s/\./\//go;
    $newWeb =~ s/\./\//go;

    my $user = $session->{user};

    if( $store->webExists( $newWeb )) {
        throw TWiki::OopsException( 'attention',
                                    web => $oldWeb,
                                    topic => '',
                                    def => 'rename_web_exists',
                                    params => [ $newWeb ] );
    }

    # update referrers.  We need to do this before moving,
    # because there might be topics inside the newWeb which need updating.
    _updateWebReferringTopics( $session, $oldWeb, $newWeb, $refs );

    try {
        $store->moveWeb( $oldWeb, $newWeb, $user );
    } catch Error::Simple  with {
        my $e = shift;
        throw TWiki::OopsException( 'attention',
                                    web => $oldWeb,
                                    topic => '',
                                    def => 'rename_web_err',
                                    params => [ $e->{-text}, $newWeb ] );
    }
}

# Display screen so user can decide on new web.
# a Refresh mechanism is provided after submission of the form
# so the user can refresh the display until lease conflicts 
# are resolved.

sub _newWebScreen {
    my( $session, $oldWeb, $newWeb,
        $confirm, $webTopicInfoRef ) = @_;

    my $query = $session->{cgiQuery};
    my $tmpl = '';

    $newWeb = $oldWeb unless ( $newWeb );

    my @newParentPath = split( /\//, $newWeb );
    my $newSubWeb = pop( @newParentPath );
    my $newParent = join( '/', @newParentPath );
    my $accessCheckWeb = $newParent;
    my $accessCheckTopic = $TWiki::cfg{WebPrefsTopicName};
    my $templates = $session->{templates};

    if( $confirm eq 'getlock' ) {
        $tmpl = $templates->readTemplate( 'renamewebconfirm' );
    } elsif( $newWeb eq $TWiki::cfg{TrashWebName} ) {
        $tmpl = $templates->readTemplate( 'renamewebdelete' );
    } else {
        $tmpl = $templates->readTemplate( 'renameweb' );
    }

    # Trashing a web; look for a non-conflicting name
    if( $newWeb eq $TWiki::cfg{TrashWebName} ) {
        $newWeb = "$TWiki::cfg{TrashWebName}/$oldWeb";
        my $n = 1;
        my $base = $newWeb;
        while( $session->{store}->webExists( $newWeb )) {
            $newWeb = $base.$n;
            $n++;
        }
    }

    my $subWebStyle = 'style="display:none;"';
    $subWebStyle = '' if $TWiki::cfg{EnableHierarchicalWebs};

    $tmpl =~ s/%SUBWEBSENABLE%/$subWebStyle/g;
    $tmpl =~ s/%NEW_PARENTWEB%/$newParent/go;
    $tmpl =~ s/%NEW_SUBWEB%/$newSubWeb/go;
    $tmpl =~ s/%TOPIC%/$TWiki::cfg{HomeTopicName}/go;

    my( $movelocked, $refdenied, $reflocked ) = ( '', '', '' );
    $movelocked = join(', ', @{$webTopicInfoRef->{movelocked}} )
      if $webTopicInfoRef->{movelocked};
    $movelocked = ($session->{i18n}->maketext('(none)')) unless $movelocked;
    $refdenied = join(', ', @{$webTopicInfoRef->{modifydenied}} )
      if $webTopicInfoRef->{modifydenied};
    $refdenied = ($session->{i18n}->maketext('(none)')) unless $refdenied;
    $reflocked = join(', ', @{$webTopicInfoRef->{modifylocked}} )
      if $webTopicInfoRef->{modifylocked};
    $reflocked = ($session->{i18n}->maketext('(none)')) unless $reflocked;

    $tmpl =~ s/%MOVE_LOCKED%/$movelocked/;
    $tmpl =~ s/%REF_DENIED%/$refdenied/;
    $tmpl =~ s/%REF_LOCKED%/$reflocked/;

    my $submitAction =
      ( $movelocked || $reflocked ) ? 'refresh_prompt' : 'submit_prompt';
    $tmpl =~ s/%RENAMEWEB_SUBMIT%/\%$submitAction\%/go;

    my $refs;
    my $search = '';

    $refs = ${$webTopicInfoRef}{referring}{refs1};
    foreach my $entry ( sort keys %$refs ) {
        $search .= CGI::Tr(
            CGI::td(
                { class => 'twikiTopRow' },
                CGI::input(
                    { type => 'checkbox',
                      class => 'twikiCheckBox',
                      name => 'referring_topics',
                      value => $entry,
                      checked => 'checked' } ). " [[$entry]] " ) .
                        CGI::td(
                            { class => 'twikiSummary twikiGrayText' },
                            $refs->{$entry}
                           )
                         );
    }
    unless( $search ) {
        $search = ($session->{i18n}->maketext('(none)'));
    } else {
        $search = CGI::start_table().$search.CGI::end_table();
    }
    $tmpl =~ s/%GLOBAL_SEARCH%/$search/o;

    $refs = $webTopicInfoRef->{referring}{refs0};
    $search = '';
    foreach my $entry ( sort keys %$refs ) {
        $search .= CGI::Tr(
            CGI::td(
                { class => 'twikiTopRow' },
                CGI::input(
                    { type => 'checkbox',
                      class => 'twikiCheckBox',
                      name => 'referring_topics',
                      value => $entry,
                      checked => 'checked' } ). " [[$entry]] " ) .
                        CGI::td(
                            { class => 'twikiSummary twikiGrayText' },
                            $refs->{$entry} ));
    }
    unless( $search ) {
        $search = ($session->{i18n}->maketext('(none)'));
    } else {
        $search = CGI::start_table().$search.CGI::end_table();
    }
    $tmpl =~ s/%LOCAL_SEARCH%/$search/go;

    $tmpl = $session->handleCommonTags( $tmpl, $oldWeb, $TWiki::cfg{HomeTopicName} );
    $tmpl = $session->{renderer}->getRenderedVersion( $tmpl, $oldWeb, $TWiki::cfg{HomeTopicName} );
    $session->writeCompletePage( $tmpl );
}

# Returns the list of topics that have been found that refer
# to the renamed topic. Returns a list of topics.
sub _getReferringTopicsListFromURL {
    my( $session, $oldWeb, $oldTopic, $newWeb, $newTopic ) = @_;

    my $query = $session->{cgiQuery};
    my @result;
    foreach my $topic ( $query->param( 'referring_topics' ) ) {
        push @result, $topic;
    }
    return \@result;
}

=pod

---++ StaticMethod getReferringTopics($session, $web, $topic, $allWebs) -> \%matches

   * =$session= - the session
   * =$web= - web to search for
   * =$topic= - topic to search for
   * =$allWebs= - 0 to search $web only. 1 to search all webs _except_ $web.
Returns a hash that maps the web.topic name to a summary of the lines that matched. Will _not_ return $web.$topic in the list

=cut

sub getReferringTopics {
    my( $session, $web, $topic, $allWebs ) = @_;
    my $store = $session->{store};
    my $renderer = $session->{renderer};
    $web =~ s#\.#/#go;
    my @webs = ( $web );

    if( $allWebs ) {
        @webs = $store->getListOfWebs();
    }

    my %results;
    foreach my $searchWeb ( @webs ) {
        next if( $allWebs && $searchWeb eq $web );
        my @topicList = $store->getTopicNames( $searchWeb );
        my $searchString;
        my $webString = $web;
        $webString =~ s#[\./]#[\\.\\/]#go;

        if( defined($topic) ) {
            if( $searchWeb eq $web ) {
                $searchString = '\<'.$topic.'\>';
            } else {
                $searchString = '\<'.$webString.'\.'.$topic.'\>';
             }
        } elsif( $searchWeb ne $web ) {
            # search for the *qualified* web name
            $searchString = '\<'.$webString.'\.[A-Za-z0-9]*\>';
        } else {
            # most general search
            $searchString = '\<'.$webString.'\>';
        }
        # Note use of \< and \> to match the empty string at the
        # edges of a word.

        my $matches = $store->searchInWebContent
          ( $searchString,
            $searchWeb, \@topicList,
            { casesensitive => 1, type => 'regex' } );

        foreach my $searchTopic ( keys %$matches ) {
            next if( $searchWeb eq $web && $topic && $searchTopic eq $topic );

            my $t = join( '...', @{$matches->{$searchTopic}});
            $t = $renderer->TML2PlainText( $t, $searchWeb, $searchTopic,
                                           "showvar;showmeta" );
            $t =~ s/^\s+//;
            if( length( $t ) > 100 ) {
                $t =~ s/^(.{100}).*$/$1/;
            }
            $results{$searchWeb.'.'.$searchTopic} = $t;
        };
    }
    return \%results;
}

# Update pages that refer to a page that is being renamed/moved.
# SMELL: this might be done more efficiently if it was behind the
# store interface
sub _updateReferringTopics {
    my ( $session, $oldWeb, $oldTopic, $newWeb, $newTopic, $refs ) = @_;
    my $store = $session->{store};
    my $renderer = $session->{renderer};
    my $user = $session->{user};
    my $options =
      {
       pre => 1, # process lines in PRE blocks
       oldWeb => $oldWeb,
       oldTopic => $oldTopic,
       newWeb => $newWeb,
       newTopic => $newTopic,
       spacedTopic => TWiki::spaceOutWikiWord( $oldTopic )
      };
    $options->{spacedTopic} =~ s/ / */g;

    foreach my $item ( @$refs ) {
        my( $itemWeb, $itemTopic ) =
          $session->normalizeWebTopicName( '', $item );

        if ( $store->topicExists($itemWeb, $itemTopic) ) {
            $store->lockTopic( $user, $itemWeb, $itemTopic );
            try {
                my( $meta, $text ) =
                  $store->readTopic( undef, $itemWeb, $itemTopic, undef );
                $options->{inWeb} = $itemWeb;

                $text = $renderer->forEachLine
                  ( $text, \&TWiki::Render::replaceTopicReferences, $options );
                $meta->forEachSelectedValue
                  ( qw/^(FIELD|FORM|TOPICPARENT)$/, undef,
                    \&TWiki::Render::replaceTopicReferences, $options );

                $store->saveTopic( $user, $itemWeb, $itemTopic,
                                   $text, $meta,
                                   { minor => 1 } );
            } catch TWiki::AccessControlException with {
                my $e = shift;
                $session->writeWarning( $e->stringify() );
            } finally {
                $store->unlockTopic( $user, $itemWeb, $itemTopic );
            };
        }
    }
}

# Update pages that refer to a web that is being renamed/moved.
sub _updateWebReferringTopics {
    my ( $session, $oldWeb, $newWeb, $refs ) = @_;
    my $store = $session->{store};
    my $renderer = $session->{renderer};
    my $user = $session->{user};
    my $options =
      {
       oldWeb => $oldWeb,
       newWeb => $newWeb
      };

    foreach my $item ( @$refs ) {
        my( $itemWeb, $itemTopic ) =
          $session->normalizeWebTopicName( '', $item );

        if ( $store->topicExists($itemWeb, $itemTopic) ) {
            $store->lockTopic( $user, $itemWeb, $itemTopic );
            try {
                my( $meta, $text ) =
                  $store->readTopic( undef, $itemWeb, $itemTopic, undef );
                $options->{inWeb} = $itemWeb;

                $text = $renderer->forEachLine
                  ( $text, \&TWiki::Render::replaceWebReferences, $options );
                $meta->forEachSelectedValue
                  ( qw/^(FIELD|FORM|TOPICPARENT)$/, undef,
                    \&TWiki::Render::replaceWebReferences, $options );

                $store->saveTopic( $user, $itemWeb, $itemTopic,
                                   $text, $meta,
                                   { minor => 1 } );
            } catch TWiki::AccessControlException with {
                my $e = shift;
                $session->writeWarning( $e->stringify() );
            } finally {
                $store->unlockTopic( $user, $itemWeb, $itemTopic );
            };
        }
    }
}

sub _editSettings {
    my $session = shift;
    my $topic = $session->{topicName};
    my $web = $session->{webName};

    my( $meta, $text ) =
      $session->{store}->readTopic( $session->{user}, $web, $topic, undef );
    my ( $orgDate, $orgAuth, $orgRev ) = $meta->getRevisionInfo();

    my $settings = "";

    my @fields = $meta->find( 'PREFERENCE' );
    foreach my $field ( @fields ) {
       my $name  = $field->{name};
       my $value = $field->{value};
       $settings .= '   * ' . (($field->{type} eq 'Local') ? 'Local' : 'Set').
         ' '.$name.' = '.$value."\n";
    }

    my $skin = $session->getSkin();
    my $tmpl = $session->{templates}->readTemplate( 'settings', $skin );
    $tmpl = $session->handleCommonTags( $tmpl, $web, $topic );
    $tmpl = $session->{renderer}->getRenderedVersion( $tmpl, $web, $topic );

    $tmpl =~ s/%TEXT%/$settings/o;
    $tmpl =~ s/%ORIGINALREV%/$orgRev/g;

    $session->writeCompletePage( $tmpl );

}

sub _saveSettings {
    my $session = shift;
    my $topic = $session->{topicName};
    my $web = $session->{webName};
    my $user = $session->{user};

    # set up editing session
    my ( $currMeta, $currText ) =
      $session->{store}->readTopic( undef, $web, $topic, undef );
    my $newMeta = new TWiki::Meta( $session, $web, $topic );
    $newMeta->copyFrom( $currMeta );

    my $query = $session->{cgiQuery};
    my $settings = $query->param( 'text' );
    my $originalrev = $query->param( 'originalrev' );

    $newMeta->remove( 'PREFERENCE' );  # delete previous settings
    $settings =~ s($TWiki::regex{setVarRegex})
      (&_handleSave($web, $topic, $1, $2, $3, $newMeta))mgeo;

    my $saveOpts = {};
    $saveOpts->{minor} = 1;            # don't notify
    $saveOpts->{forcenewrevision} = 1; # always new revision

    # Merge changes in meta data
    if ( $originalrev ) {
        my ( $date, $author, $rev ) = $newMeta->getRevisionInfo();
        # If the last save was by me, don't merge
        if ( $rev ne $originalrev && !$author->equals( $user )) {
            $newMeta->merge( $currMeta );
        }
    }

    try {
        $session->{store}->saveTopic( $user, $web, $topic,
                                    $currText, $newMeta, $saveOpts );
    } catch Error::Simple with {
        throw TWiki::OopsException( 'attention',
                                    def => 'save_error',
                                    web => $web,
                                    topic => $topic,
                                    params => shift->{-text} );
    };
    my $viewURL = $session->getScriptUrl( 0, 'view', $web, $topic );
    $session->redirect( $viewURL );
    return;

}

sub _handleSave {
  my( $web, $topic, $type, $name, $value, $meta ) = @_;

  $value =~ s/^\s*(.*?)\s*$/$1/ge;

  my $args =
    {
     name =>  $name,
     title => $name,
     value => $value,
     type =>  $type
    };
  $meta->putKeyed( 'PREFERENCE', $args );
  return '';

}

1;
