1# See bottom of file for license and copyright information
2
3=begin TML
4
5---+ package Foswiki::UI::Rename
6
7UI functions for renaming.
8
9=cut
10
11package Foswiki::UI::Rename;
12
13use strict;
14use warnings;
15use Assert;
16use Error qw(:try);
17
18use Foswiki::UI     ();
19use Foswiki::Render ();
20
21BEGIN {
22    if ( $Foswiki::cfg{UseLocale} ) {
23        require locale;
24        import locale();
25    }
26}
27
28our $MARKER = "\02\03";
29
30=begin TML
31
32---++ StaticMethod rename( $session )
33
34=rename= command handler.
35This method is designed to be
36invoked via the =UI::run= method.
37Rename the given topic. Details of the new topic name are passed in CGI
38parameters:
39
40| =skin= | skin(s) to use |
41| =newweb= | new web name |
42| =newtopic= | new topic name |
43| =breaklock= | |
44| =attachment= | |
45| =confirm= | if defined, requires a second level of confirmation |
46| =currentwebonly= | if defined, searches current web only for links to this topic |
47| =onlywikiname= | if defined, only a wikiword is acceptable for the new topic name |
48| =redirectto= | If the rename process is successful, rename will redirect to this topic or URL. The parameter value can be a =TopicName=, a =Web.TopicName=, or a URL.%BR% __Note:__ Redirect to a URL only works if it is enabled in =configure= (Miscellaneous ={AllowRedirectUrl}=). |
49
50=cut
51
52# This function is entered twice during an interaction renaming session. The
53# first time is when the parameters for the rename are being gathered
54# referring topics etc) and in this case, it will terminate at either
55# newWebScreen or newTopicOrAttachmentScreen. The second times is when the
56# rename is proceeding, and/or all the appropriate parameters have been
57# passed by the caller. In this case the rename proceeds.
58sub rename {
59    my $session = shift;
60
61    my $oldWeb           = $session->{webName};
62    my $oldTopic         = $session->{topicName};
63    my $query            = $session->{request};
64    my $action           = $session->{cgiQuery}->param('action') || '';
65    my $redirectto_param = $session->{cgiQuery}->param('redirectto') || '';
66
67    Foswiki::UI::checkWebExists( $session, $oldWeb, 'rename' );
68
69    if ( $session->{invalidTopic} ) {
70        throw Foswiki::OopsException(
71            'accessdenied',
72            status => 404,
73            def    => 'invalid_topic_name',
74            web    => $oldWeb,
75            topic  => $oldTopic,
76            params => [ $session->{invalidTopic} ]
77        );
78    }
79
80    my $new_url;
81    if ( $action eq 'renameweb' ) {
82        $new_url = _renameWeb( $session, $oldWeb );
83    }
84    else {
85        $new_url = _renameTopicOrAttachment( $session, $oldWeb, $oldTopic );
86    }
87
88    if ( $redirectto_param ne '' ) {
89        $new_url = $session->redirectto($redirectto_param);
90    }
91
92    $session->redirect($new_url) if $new_url;
93}
94
95# Rename a topic
96sub _renameTopicOrAttachment {
97    my ( $session, $oldWeb, $oldTopic ) = @_;
98
99    my $query    = $session->{cgiQuery};
100    my $newTopic = $query->param('newtopic') || '';
101    my $newWeb   = $query->param('newweb') || '';
102
103    # Validate the new web name
104    $newWeb = Foswiki::Sandbox::untaint(
105        $newWeb,
106        sub {
107            my ($web) = @_;
108            unless ( !$web || Foswiki::isValidWebName( $web, 1 ) ) {
109                throw Foswiki::OopsException(
110                    'attention',
111                    def    => 'invalid_web_name',
112                    params => [$web]
113                );
114            }
115            return $web;
116        }
117    );
118
119    my $confirm = $query->param('confirm');
120
121    unless ( $session->topicExists( $oldWeb, $oldTopic ) ) {
122
123        # Item3270: check for the same name starting with a lower case letter.
124        unless ( $session->topicExists( $oldWeb, lcfirst($oldTopic) ) ) {
125            throw Foswiki::OopsException(
126                'accessdenied',
127                status => 403,
128                def    => 'no_such_topic_rename',
129                web    => $oldWeb,
130                topic  => $oldTopic
131            );
132        }
133
134        # Untaint is required is use locale is in force
135        $oldTopic = Foswiki::Sandbox::untaintUnchecked( lcfirst($oldTopic) );
136    }
137
138    if ($newTopic) {
139
140        # Purify the new topic name
141        $newTopic = _safeTopicName($newTopic);
142
143        # Validate
144        $newTopic = Foswiki::Sandbox::untaint(
145            $newTopic,
146            sub {
147                my ( $topic, $nonww ) = @_;
148                if ( !Foswiki::isValidTopicName( $topic, $nonww ) ) {
149                    throw Foswiki::OopsException(
150                        'attention',
151                        web    => $oldWeb,
152                        topic  => $oldTopic,
153                        def    => 'not_wikiword',
154                        params => [$topic]
155                    );
156                }
157                return $topic;
158            },
159            !Foswiki::isTrue( scalar( $query->param('onlywikiname') ) )
160        );
161    }
162
163    my $attachment    = $query->param('attachment');
164    my $newAttachment = $query->param('newattachment');
165
166    my $old = Foswiki::Meta->load( $session, $oldWeb, $oldTopic );
167
168    if ($attachment) {
169
170        # Does old attachment exist?
171        # Attachment exists, validated
172        $attachment = Foswiki::Sandbox::untaint(
173            $attachment,
174            sub {
175                my ($att) = @_;
176                if ( !$old->hasAttachment($att) ) {
177                    my $tmplname = $query->param('template') || '';
178                    throw Foswiki::OopsException(
179                        'attention',
180                        web   => $oldWeb,
181                        topic => $oldTopic,
182                        def   => ( $tmplname eq 'deleteattachment' )
183                        ? 'delete_err'
184                        : 'move_err',
185                        params => [
186                            $newWeb,
187                            $newTopic,
188                            $attachment,
189                            $session->i18n->maketext(
190                                'Attachment does not exist.')
191                        ]
192                    );
193                }
194                return $att;
195            }
196        );
197
198        # Validate the new attachment name, if one was provided
199        if ($newAttachment) {
200            $newAttachment = Foswiki::Sandbox::untaint( $newAttachment,
201                \&Foswiki::Sandbox::validateAttachmentName );
202        }
203
204        if ( $newWeb && $newTopic && $newAttachment ) {
205
206            Foswiki::UI::checkTopicExists( $session, $newWeb, $newTopic,
207                'rename' );
208
209            my $new = Foswiki::Meta->load( $session, $newWeb, $newTopic );
210
211            # does new attachment already exist?
212            if ( $new->hasAttachment($newAttachment) ) {
213                throw Foswiki::OopsException(
214                    'attention',
215                    def    => 'move_err',
216                    web    => $oldWeb,
217                    topic  => $oldTopic,
218                    params => [
219                        $newWeb,
220                        $newTopic,
221                        $newAttachment,
222                        $session->i18n->maketext(
223'An attachment with the same name already exists in this topic.'
224                        )
225                    ]
226                );
227            }
228        }    # else fall through to new topic screen
229    }
230    elsif ($newTopic) {
231        ( $newWeb, $newTopic ) =
232          $session->normalizeWebTopicName( $newWeb, $newTopic );
233
234        Foswiki::UI::checkWebExists( $session, $newWeb, $newTopic, 'rename' );
235        if ( $session->topicExists( $newWeb, $newTopic ) ) {
236            throw Foswiki::OopsException(
237                'attention',
238                def    => 'rename_topic_exists',
239                web    => $oldWeb,
240                topic  => $oldTopic,
241                params => [ $newWeb, $newTopic ]
242            );
243        }
244    }
245
246    # Only check RENAME authority if the topic itself is being renamed.
247    if ( ( $newWeb || $newTopic ) && !( $newAttachment || $attachment ) ) {
248        Foswiki::UI::checkAccess( $session, 'RENAME', $old );
249    }
250    else {
251        Foswiki::UI::checkAccess( $session, 'CHANGE', $old );
252    }
253
254    my $new = Foswiki::Meta->new(
255        $session,
256        $newWeb   || $old->web,
257        $newTopic || $old->topic
258    );
259
260    # Has user selected new name yet?
261    if ( !$newTopic || ( $attachment && !$newAttachment ) || $confirm ) {
262        $newAttachment ||= $attachment;
263
264        # Must be able to view the source to rename it
265        Foswiki::UI::checkAccess( $session, 'VIEW', $old );
266
267        _newTopicOrAttachmentScreen( $session, $old, $new, $attachment,
268            $newAttachment, $confirm );
269        return;
270
271    }
272
273    unless ( $session->inContext('command_line') ) {
274        if ( uc( $session->{request}->method() ) ne 'POST' ) {
275            throw Foswiki::OopsException(
276                'attention',
277                web    => $session->{webName},
278                topic  => $session->{topicName},
279                def    => 'post_method_only',
280                params => ['rename']
281            );
282        }
283    }
284
285    Foswiki::UI::checkValidationKey($session);
286
287    # Update references in referring pages - not applicable to attachments.
288    my $refs;
289    unless ($attachment) {
290        $refs =
291          _getReferringTopicsListFromURL( $session, $oldWeb, $oldTopic, $newWeb,
292            $newTopic );
293    }
294
295    _moveTopicOrAttachment( $session, $old, $new, $attachment, $newAttachment,
296        $refs );
297
298    my $new_url;
299    if (   $newWeb eq $Foswiki::cfg{TrashWebName}
300        && $oldWeb ne $Foswiki::cfg{TrashWebName} )
301    {
302
303        # deleting something
304
305        if ($attachment) {
306
307            # go back to old topic after deleting an attachment
308            $new_url =
309              $session->getScriptUrl( 0, 'view', $old->web, $old->topic );
310
311        }
312        else {
313
314            # redirect to parent topic, if set
315            my $meta = Foswiki::Meta->load( $session, $new->web, $new->topic );
316            my $parent = $meta->get('TOPICPARENT');
317            my ( $parentWeb, $parentTopic );
318            if ( $parent && defined $parent->{name} ) {
319                ( $parentWeb, $parentTopic ) =
320                  $session->normalizeWebTopicName( $oldWeb, $parent->{name} );
321            }
322            if (   $parentTopic
323                && !( $parentWeb eq $oldWeb && $parentTopic eq $oldTopic )
324                && $session->topicExists( $parentWeb, $parentTopic ) )
325            {
326                $new_url =
327                  $session->getScriptUrl( 0, 'view', $parentWeb, $parentTopic );
328            }
329            else {
330
331                # No parent topic, redirect to home topic
332                $new_url =
333                  $session->getScriptUrl( 0, 'view', $oldWeb,
334                    $Foswiki::cfg{HomeTopicName} );
335            }
336        }
337    }
338    else {
339        unless ( $session->inContext('command_line') ) {
340
341            # redirect to new topic
342            $new_url = $session->getScriptUrl( 0, 'view', $newWeb, $newTopic );
343            $session->{webName}   = $newWeb;
344            $session->{topicName} = $newTopic;
345        }
346    }
347
348    return $new_url;
349}
350
351sub _safeTopicName {
352    my ($topic) = @_;
353
354    $topic =~ s/\s//g;
355    $topic = ucfirst $topic;    # Item3270
356    $topic =~ s![./]!_!g;
357    $topic =~ s/($Foswiki::cfg{NameFilter})//g;
358
359    return $topic;
360}
361
362#| =skin= | skin(s) to use |
363#| =newsubweb= | new web name |
364#| =newparentweb= | new parent web name |
365#| =confirm= | if defined, requires a second level of confirmation.  Currently accepted values are "getlock", "continue", and "cancel" |
366sub _renameWeb {
367    my ( $session, $oldWeb ) = @_;
368
369    my $oldWebObject = Foswiki::Meta->new( $session, $oldWeb );
370
371    my $query = $session->{request};
372    my $cUID  = $session->{user};
373
374    # If the user is not allowed to rename anything in the current
375    # web - stop here
376    Foswiki::UI::checkAccess( $session, 'RENAME', $oldWebObject );
377
378    my $newParentWeb = $query->param('newparentweb') || '';
379
380    # Validate
381    if ( $newParentWeb ne "" ) {
382        $newParentWeb = Foswiki::Sandbox::untaint(
383            $newParentWeb,
384            sub {
385                my $web = shift;
386                return $web if Foswiki::isValidWebName( $web, 1 );
387                throw Foswiki::OopsException(
388                    'attention',
389                    def    => 'invalid_web_name',
390                    params => [$web]
391                );
392            }
393        );
394    }
395    my $newSubWeb = $query->param('newsubweb') || '';
396
397    # Validate
398    if ( $newSubWeb ne "" ) {
399        $newSubWeb = Foswiki::Sandbox::untaint(
400            $newSubWeb,
401            sub {
402                my $web = shift;
403                return $web if Foswiki::isValidWebName( $web, 1 );
404                throw Foswiki::OopsException(
405                    'attention',
406                    def    => 'invalid_web_name',
407                    params => [$web]
408                );
409            }
410        );
411    }
412    my $newWeb;
413    if ($newSubWeb) {
414        if ($newParentWeb) {
415            $newWeb = $newParentWeb . '/' . $newSubWeb;
416        }
417        else {
418            $newWeb = $newSubWeb;
419        }
420    }
421
422    if ( $newParentWeb eq $oldWeb
423        || ( defined $newWeb && $newParentWeb eq $newWeb ) )
424    {
425        throw Foswiki::OopsException(
426            'attention',
427            web    => $oldWeb,
428            def    => 'invalid_web_parent',
429            params => [ $newSubWeb, $newParentWeb ]
430        );
431    }
432
433    if (   $oldWeb eq $Foswiki::cfg{SystemWebName}
434        || $oldWeb eq $Foswiki::cfg{UsersWebName} )
435    {
436        throw Foswiki::OopsException(
437            'attention',
438            web    => $oldWeb,
439            topic  => '',
440            def    => 'rename_web_err',
441            params => [
442                "Rename is not permitted, it would damage the installation",
443                'anything'
444            ]
445        );
446    }
447
448    # Determine the parent of the 'from' web
449    my @tmp = split( /[\/\.]/, $oldWeb );
450    pop(@tmp);
451    my $oldParentWeb = join( '/', @tmp );
452
453    # If the user is not allowed to rename anything in the parent web
454    # - stop here
455    # This also ensures we check root webs for ALLOWROOTRENAME and
456    # DENYROOTRENAME
457    my $oldParentWebObject =
458      new Foswiki::Meta( $session, $oldParentWeb || undef );
459    Foswiki::UI::checkAccess( $session, 'RENAME', $oldParentWebObject );
460
461    # If old web is a root web then also stop if ALLOW/DENYROOTCHANGE
462    # prevents access
463    if ( !$oldParentWeb ) {
464        Foswiki::UI::checkAccess( $session, 'CHANGE', $oldParentWebObject );
465    }
466
467    my $newTopic;
468    my $lockFailure = '';
469    my $confirm = $query->param('confirm') || '';
470
471    Foswiki::UI::checkWebExists( $session, $oldWeb,
472        $Foswiki::cfg{WebPrefsTopicName}, 'rename' );
473
474    if ($newWeb) {
475        if ($newParentWeb) {
476            Foswiki::UI::checkWebExists( $session, $newParentWeb,
477                $Foswiki::cfg{WebPrefsTopicName}, 'rename' );
478        }
479        if ( $session->webExists($newWeb) ) {
480            throw Foswiki::OopsException(
481                'attention',
482                def    => 'rename_web_exists',
483                web    => $oldWeb,
484                topic  => $Foswiki::cfg{WebPrefsTopicName},
485                params => [ $newWeb, $Foswiki::cfg{WebPrefsTopicName} ]
486            );
487        }
488
489        # Check if we have change permission in the new parent
490        my $newParentWebObject = new Foswiki::Meta( $session, $newParentWeb );
491        Foswiki::UI::checkAccess( $session, 'CHANGE', $newParentWebObject );
492    }
493
494    if ( !$newWeb || $confirm ) {
495        my %refs;
496        my $info = {
497            totalReferralAccess   => 1,
498            totalWebAccess        => 1,
499            modifyingLockedTopics => 0,
500            movingLockedTopics    => 0
501        };
502
503        # get a topic list for all the topics referring to this web,
504        # and build up a hash containing permissions and lock info.
505        my $refs0 = _getReferringTopics( $session, $oldWebObject, 0 );
506        my $refs1 = _getReferringTopics( $session, $oldWebObject, 1 );
507        %refs = ( %$refs0, %$refs1 );
508
509        $info->{referring}{refs0} = $refs0;
510        $info->{referring}{refs1} = $refs1;
511
512        my $lease_ref;
513        foreach my $ref ( keys %refs ) {
514            if ( defined($ref) && $ref ne "" ) {
515                my (@path) = split( /[.\/]/, $ref );
516                my $webTopic = pop(@path);
517                my $webIter = join( '/', @path );
518
519                my $topicObject =
520                  Foswiki::Meta->new( $session, $webIter, $webTopic );
521                if ( $confirm eq 'getlock' ) {
522                    $topicObject->setLease( $Foswiki::cfg{LeaseLength} );
523                    $lease_ref = $topicObject->getLease();
524                }
525                elsif ( $confirm eq 'cancel' ) {
526                    $lease_ref = $topicObject->getLease();
527                    if ( $lease_ref->{user} eq $cUID ) {
528                        $topicObject->clearLease();
529                    }
530                }
531                my $wit = $webIter . '/' . $webTopic;
532                $info->{modify}{$wit}{leaseuser} = $lease_ref->{user};
533                $info->{modify}{$wit}{leasetime} = $lease_ref->{taken};
534
535                $info->{modifyingLockedTopics}++
536                  if ( defined( $info->{modify}{$ref}{leaseuser} )
537                    && $info->{modify}{$ref}{leaseuser} ne $cUID );
538                $info->{modify}{$ref}{access} =
539                  $topicObject->haveAccess('CHANGE');
540                if ( !$info->{modify}{$ref}{access} ) {
541                    $info->{modify}{$ref}{accessReason} =
542                      $Foswiki::Meta::reason;
543                }
544                $info->{totalReferralAccess} = 0
545                  unless $info->{modify}{$ref}{access};
546            }
547        }
548
549        # Lease topics and build
550        # up a hash containing permissions and lock info.
551        my $it = $oldWebObject->eachWeb(1);
552        _leaseContents( $session, $info, $oldWebObject->web, $confirm );
553        while ( $it->hasNext() ) {
554            my $subweb = $it->next();
555            require Foswiki::WebFilter;
556            next unless Foswiki::WebFilter->public()->ok( $session, $subweb );
557            _leaseContents( $session, $info, $oldWebObject->web . '/' . $subweb,
558                $confirm );
559        }
560
561        if (   !$info->{totalReferralAccess}
562            || !$info->{totalWebAccess}
563            || $info->{movingLockedTopics}
564            || $info->{modifyingLockedTopics} )
565        {
566
567            # check if the user can rename all the topics in this web.
568            push(
569                @{ $info->{movedenied} },
570                grep { !$info->{move}{$_}{access} }
571                  sort keys %{ $info->{move} }
572            );
573
574            # check if there are any locked topics in this web or
575            # its subwebs.
576            push(
577                @{ $info->{movelocked} },
578                grep {
579                    defined( $info->{move}{$_}{leaseuser} )
580                      && $info->{move}{$_}{leaseuser} ne $cUID
581                  }
582                  sort keys %{ $info->{move} }
583            );
584
585            # Next, build up a list of all the referrers which the
586            # user doesn't have permission to change.
587            push(
588                @{ $info->{modifydenied} },
589                grep { !$info->{modify}{$_}{access} }
590                  sort keys %{ $info->{modify} }
591            );
592
593            # Next, build up a list of all the referrers which are
594            # currently locked.
595            push(
596                @{ $info->{modifylocked} },
597                grep {
598                    defined( $info->{modify}{$_}{leaseuser} )
599                      && $info->{modify}{$_}{leaseuser} ne $cUID
600                  }
601                  sort keys %{ $info->{modify} }
602            );
603
604            unless ($confirm) {
605                my $nocontinue = '';
606                if (   @{ $info->{movedenied} }
607                    || @{ $info->{movelocked} } )
608                {
609                    $nocontinue = 'style="display:none;"';
610                }
611                my $mvd = join( ' ', @{ $info->{movedenied} } )
612                  || ( $session->i18n->maketext('(none)') );
613                $mvd = substr( $mvd, 0, 300 ) . '... (more)'
614                  if ( length($mvd) > 300 );
615                my $mvl = join( ' ', @{ $info->{movelocked} } )
616                  || ( $session->i18n->maketext('(none)') );
617                $mvl = substr( $mvl, 0, 300 ) . '... (more)'
618                  if ( length($mvl) > 300 );
619                my $mdd = join( ' ', @{ $info->{modifydenied} } )
620                  || ( $session->i18n->maketext('(none)') );
621                $mdd = substr( $mdd, 0, 300 ) . '... (more)'
622                  if ( length($mdd) > 300 );
623                my $mdl = join( ' ', @{ $info->{modifylocked} } )
624                  || ( $session->i18n->maketext('(none)') );
625                $mdl = substr( $mdl, 0, 300 ) . '... (more)'
626                  if ( length($mdl) > 300 );
627                throw Foswiki::OopsException(
628                    'attention',
629                    web    => $oldWeb,
630                    topic  => '',
631                    def    => 'rename_web_prerequisites',
632                    params => [ $mvd, $mvl, $mdd, $mdl, $nocontinue ]
633                );
634            }
635        }
636
637        if ( $confirm eq 'cancel' ) {
638
639            # redirect to original web
640            my $viewURL =
641              $session->getScriptUrl( 0, 'view', $oldWeb,
642                $Foswiki::cfg{HomeTopicName} );
643            $session->redirect($viewURL);
644        }
645        elsif (
646            $confirm ne 'getlock'
647            || (   $confirm eq 'getlock'
648                && $info->{modifyingLockedTopics}
649                && $info->{movingLockedTopics} )
650          )
651        {
652
653            # Has user selected new name yet?
654            _newWebScreen( $session, $oldWebObject, $newWeb, $confirm, $info );
655            return;
656        }
657    }
658
659    Foswiki::UI::checkValidationKey($session);
660
661    my $newWebObject = Foswiki::Meta->new( $session, $newWeb );
662
663    Foswiki::UI::checkAccess( $session, 'CHANGE', $oldWebObject );
664    Foswiki::UI::checkAccess( $session, 'CHANGE', $newWebObject );
665
666    my $refs = _getReferringTopicsListFromURL($session);
667
668    # update referrers.  We need to do this before moving,
669    # because there might be topics inside the newWeb which need updating.
670    _updateReferringTopics( $session, $refs, \&_replaceWebReferences,
671        { oldWeb => $oldWeb, newWeb => $newWeb, noautolink => 1 } );
672
673    # Now, we can move the web.
674    try {
675        $oldWebObject->move($newWebObject);
676    }
677    catch Foswiki::OopsException with {
678        shift->throw();    # propagate
679    }
680    catch Error with {
681        $session->logger->log( 'error', shift->{-text} );
682        throw Foswiki::OopsException(
683            'attention',
684            web    => $oldWeb,
685            topic  => '',
686            def    => 'rename_web_err',
687            params => [
688                $session->i18n->maketext(
689                    'Operation [_1] failed with an internal error', 'move'
690                ),
691                $newWeb
692            ],
693        );
694    }
695
696    # now remove leases on all topics inside $newWeb.
697    my $nwom = Foswiki::Meta->new( $session, $newWeb );
698    my $it = $nwom->eachWeb(1);
699    _releaseContents( $session, $newWeb );
700    while ( $it->hasNext() ) {
701        my $subweb = $it->next();
702        require Foswiki::WebFilter;
703        next unless Foswiki::WebFilter->public()->ok( $session, $subweb );
704        _releaseContents( $session, "$newWeb/$subweb" );
705    }
706
707    # also remove lease on all referring topics
708    foreach my $ref (@$refs) {
709        my @path        = split( /[.\/]/, $ref );
710        my $webTopic    = pop(@path);
711        my $webIter     = join( '/', @path );
712        my $topicObject = Foswiki::Meta->new( $session, $webIter, $webTopic );
713        $topicObject->clearLease();
714    }
715
716    my $new_url = '';
717    if (   $newWeb =~ m/^$Foswiki::cfg{TrashWebName}\b/
718        && $oldWeb !~ /^$Foswiki::cfg{TrashWebName}\b/ )
719    {
720
721        # redirect to parent
722        if ($oldParentWeb) {
723            $new_url =
724              $session->getScriptUrl( 0, 'view', $oldParentWeb,
725                $Foswiki::cfg{HomeTopicName} );
726        }
727        else {
728            $new_url = $session->getScriptUrl(
729                0, 'view',
730                $Foswiki::cfg{UsersWebName},
731                $Foswiki::cfg{HomeTopicName}
732            );
733        }
734    }
735    else {
736
737        # redirect to new web
738        $new_url =
739          $session->getScriptUrl( 0, 'view', $newWeb,
740            $Foswiki::cfg{HomeTopicName} );
741        $session->{webName}   = $newWeb;
742        $session->{topicName} = $Foswiki::cfg{HomeTopicName};
743    }
744
745    return $new_url;
746}
747
748sub _leaseContents {
749    my ( $session, $info, $web, $confirm ) = @_;
750
751    my $webObject = Foswiki::Meta->new( $session, $web );
752    my $it = $webObject->eachTopic();
753    while ( $it->hasNext() ) {
754        my $topic = $it->next();
755        my $lease_ref;
756        my $topicObject = Foswiki::Meta->new( $session, $web, $topic );
757        if ( $confirm eq 'getlock' ) {
758            $topicObject->setLease( $Foswiki::cfg{LeaseLength} );
759            $lease_ref = $topicObject->getLease();
760        }
761        elsif ( $confirm eq 'cancel' ) {
762            $lease_ref = $topicObject->getLease();
763            if ( $lease_ref->{user} eq $session->{user} ) {
764                $topicObject->clearLease();
765            }
766        }
767        my $wit = $web . '/' . $topic;
768        $info->{move}{$wit}{leaseuser} = $lease_ref->{user};
769        $info->{move}{$wit}{leasetime} = $lease_ref->{taken};
770
771        $info->{movingLockedTopics}++
772          if ( defined( $info->{move}{$wit}{leaseuser} )
773            && $info->{move}{$wit}{leaseuser} ne $session->{user} );
774        $info->{move}{$wit}{access}       = $topicObject->haveAccess('RENAME');
775        $info->{move}{$wit}{accessReason} = $Foswiki::Meta::reason;
776        $info->{totalWebAccess} =
777          ( $info->{totalWebAccess} & $info->{move}{$wit}{access} );
778    }
779}
780
781sub _releaseContents {
782    my ( $session, $web ) = @_;
783
784    my $webObject = Foswiki::Meta->new( $session, $web );
785    my $it = $webObject->eachTopic();
786    while ( $it->hasNext() ) {
787        my $topic = $it->next();
788        my $topicObject = Foswiki::Meta->new( $session, $web, $topic );
789        $topicObject->clearLease();
790    }
791}
792
793# Move the given topic, or an attachment in the topic, correcting refs to the topic in the topic itself, and
794# in the list of topics (specified as web.topic pairs) in the \@refs array.
795#
796#    * =$session= - reference to session object
797#    * =$from= - old topic
798#    * =$to= - new topic
799#    * =$attachment= - name of the attachment to move (from oldtopic to newtopic) (undef to move the topic) - must be untaineted
800#    * =\@refs= - array of webg.topics that must have refs to this topic converted
801# Will throw Foswiki::OopsException on an error.
802sub _moveTopicOrAttachment {
803    my ( $session, $from, $to, $attachment, $toattachment, $refs ) = @_;
804
805    Foswiki::UI::checkAccess( $session, 'CHANGE', $from );
806    Foswiki::UI::checkAccess( $session, 'CHANGE', $to );
807
808    if ($attachment) {
809        try {
810            $from->moveAttachment( $attachment, $to,
811                new_name => $toattachment );
812        }
813        catch Foswiki::OopsException with {
814            shift->throw();    # propagate
815        }
816        catch Error with {
817            $session->logger->log( 'error', shift->{-text} );
818            throw Foswiki::OopsException(
819                'attention',
820                web    => $from->web,
821                topic  => $from->topic,
822                def    => 'move_err',
823                params => [
824                    $to->web,
825                    $to->topic,
826                    $attachment,
827                    $session->i18n->maketext(
828                        'Operation [_1] failed with an internal error',
829                        'moveAttachment'
830                    )
831                ]
832            );
833        };
834    }
835    else {
836        try {
837            $from->move($to);
838        }
839        catch Foswiki::OopsException with {
840            shift->throw();    # propagate
841        }
842        catch Error with {
843            $session->logger->log( 'error', shift->{-text} );
844            throw Foswiki::OopsException(
845                'attention',
846                web    => $from->web,
847                topic  => $from->topic,
848                def    => 'rename_err',
849                params => [
850                    $session->i18n->maketext(
851                        'Operation [_1] failed with an internal error', 'move'
852                    ),
853                    $to->web,
854                    $to->topic
855                ]
856            );
857        };
858
859        # Force reload of new object, as it's been moved. This is safe
860        # because the $to object is entirely local to the code in this
861        # package.
862        $to->unload();
863        $to = $to->load();
864
865        # Now let's replace all self-referential links:
866        require Foswiki::Render;
867        my $text    = $to->text();
868        my $options = {
869            oldWeb    => $from->web,
870            oldTopic  => $from->topic,
871            newWeb    => $to->web,
872            newTopic  => $to->topic,
873            inWeb     => $to->web,
874            fullPaths => 0,
875
876           # Process noautolink blocks. forEachLine will set in_noautolink when
877           # processing links in a noautolink block.  _getReferenceRE will force
878           # squabbed links when in_noautolink is set.
879            noautolink => 1,
880        };
881        $text =
882          $session->renderer->forEachLine( $text, \&_replaceTopicReferences,
883            $options );
884        $to->text($text);
885
886        $to->put(
887            'TOPICMOVED',
888            {
889                from => $from->web . '.' . $from->topic,
890                to   => $to->web . '.' . $to->topic,
891                date => time(),
892                by   => $session->{user},
893            }
894        );
895
896        $to->save( minor => 1, comment => 'rename' );
897
898        # update referrers - but _not_ including the moved topic
899        _updateReferringTopics( $session, $refs, \&_replaceTopicReferences,
900            $options );
901    }
902}
903
904# _replaceTopicReferences( $text, \%options ) -> $text
905#
906# Callback designed for use with forEachLine, to replace topic references.
907# \%options contains:
908#   * =oldWeb= => Web of reference to replace
909#   * =oldTopic= => Topic of reference to replace
910#   * =newWeb= => Web of new reference
911#   * =newTopic= => Topic of new reference
912#   * =inWeb= => the web which the text we are presently processing resides in
913#   * =fullPaths= => optional, if set forces all links to full web.topic form
914#   * =noautolink= => Set to process links in noautolink blocks
915#   * =in_noautolink= => Set by calling forEachLine if inside a noautolink block
916sub _replaceTopicReferences {
917    my ( $text, $args ) = @_;
918
919    ASSERT( defined $args->{oldWeb} )   if DEBUG;
920    ASSERT( defined $args->{oldTopic} ) if DEBUG;
921
922    ASSERT( defined $args->{newWeb} )   if DEBUG;
923    ASSERT( defined $args->{newTopic} ) if DEBUG;
924
925    ASSERT( defined $args->{inWeb} ) if DEBUG;
926
927    # Do the traditional Foswiki topic references first
928    my $oldTopic = $args->{oldTopic};
929    my $newTopic = $args->{newTopic};
930    my $repl     = $newTopic;
931
932    my $newWeb  = $args->{newWeb};
933    my $oldWeb  = $args->{oldWeb};
934    my $sameWeb = ( $oldWeb eq $newWeb );
935
936    if ( $args->{inWeb} ne $newWeb || $args->{fullPaths} ) {
937        $repl = $newWeb . '.' . $repl;
938    }
939
940    my $re = _getReferenceRE( $oldWeb, $oldTopic, %$args );
941    $text =~ s/($re)/_doReplace($1, $newWeb, $repl)/ge;
942
943    # Do any references for Templates
944    if ( $oldTopic =~ m/(.*)Template$/ ) {
945        my $ot = $1;
946
947        # Only if the rename is also to a template, otherwise give up.
948        if ( $repl =~ m/(.*)Template$/ ) {
949            my $nt = $1;
950
951            # Handle META Preference settings
952            if (   $nt
953                && $args->{_type}
954                && $args->{_type} eq 'PREFERENCE'
955                && $args->{_key}  eq 'value' )
956            {
957                $re = _getReferenceRE( $oldWeb, $ot, nosot => 1 );
958                $text =~ s/($re)/_doReplace($1, $newWeb, $nt)/ge;
959            }
960
961            # Handle Set/Local statements inline
962            $re = _getReferenceRE(
963                $oldWeb, $ot,
964                nosot    => 1,
965                template => 1
966            );
967
968            # SMELL:  This will rewrite qualified topic names to be unqualified
969            # But regex is matching too much to use the _doReplace routine
970            $text =~ s/$re/$1$nt/g;
971        }
972    }
973
974    # Now URL form
975    $repl = "/$newWeb/$newTopic";
976    $re = _getReferenceRE( $oldWeb, $oldTopic, url => 1 );
977    $text =~ s/$re/$repl/g;
978
979    return $text;
980}
981
982sub _doReplace {
983    my ( $match, $web, $repl ) = @_;
984
985    # TWikibug:Item4661 If there is a web defined in the match, then
986    # make sure there's a web defined in the replacement.
987    if ( $match =~ m/\./ && $repl !~ /\./ ) {
988        $repl = $web . '.' . $repl;
989    }
990    return $repl;
991}
992
993# _replaceWebReferences( $text, \%options ) -> $text
994#
995# Callback designed for use with forEachLine, to replace text references
996# to a web.
997# \%options contains:
998#   * =oldWeb= => Web of reference to replace
999#   * =newWeb= => Web of new reference
1000#   * =noautolink => 1  -  Process noautolink blocks as well.
1001sub _replaceWebReferences {
1002    my ( $text, $args ) = @_;
1003
1004    ASSERT( defined $args->{oldWeb} ) if DEBUG;
1005    ASSERT( defined $args->{newWeb} ) if DEBUG;
1006    ASSERT( $text !~ /$MARKER/ )      if DEBUG;
1007
1008    my $newWeb = $args->{newWeb};
1009    my $oldWeb = $args->{oldWeb};
1010
1011    return $text if $oldWeb eq $newWeb;
1012
1013    # Replace stand-alone web references with $MARKER, to
1014    # prevent matching $newWeb as a URL fragment in the second RE
1015    my $re = _getReferenceRE( $oldWeb, undef, %$args );
1016    $text =~ s/$re/$MARKER$1/g;
1017
1018    # Now do URLs.
1019    $args->{url} = 1;
1020    $re = _getReferenceRE( $oldWeb, undef, %$args );
1021    $text =~ s#$re#/$newWeb/#g;
1022    $args->{url} = 0;
1023
1024    # Finally do the marker.
1025    $text =~ s/$MARKER/$newWeb/g;
1026
1027    return $text;
1028}
1029
1030# Display screen so user can decide on new web, topic, attachment names.
1031sub _newTopicOrAttachmentScreen {
1032    my ( $session, $from, $to, $attachment, $toattachment, $confirm ) = @_;
1033
1034    my $query          = $session->{cgiQuery};
1035    my $tmpl           = '';
1036    my $currentWebOnly = $query->param('currentwebonly') || '';
1037
1038    if ($attachment) {
1039        my $tmplname = $query->param('template');
1040        $tmpl =
1041          $session->templates->readTemplate( $tmplname || 'moveattachment' );
1042    }
1043    elsif ($confirm) {
1044        $tmpl = $session->templates->readTemplate('renameconfirm');
1045    }
1046    elsif ($to->web eq $Foswiki::cfg{TrashWebName}
1047        && $from->web ne $Foswiki::cfg{TrashWebName} )
1048    {
1049        $tmpl = $session->templates->readTemplate('renamedelete');
1050    }
1051    else {
1052        $tmpl = $session->templates->readTemplate('rename');
1053    }
1054
1055    if ( $to->web eq $Foswiki::cfg{TrashWebName} ) {
1056
1057        # Deleting an attachment or a topic
1058        if ($attachment) {
1059
1060            # Trashing an attachment; look for a non-conflicting name in the
1061            # trash web
1062            my $base = $toattachment || $attachment;
1063            my $ext = '';
1064            if ( $base =~ s/^(.*)(\..*?)$/$1_/ ) {
1065                $ext = $2;
1066            }
1067            my $n = 1;
1068            while ( $to->hasAttachment($toattachment) ) {
1069                $toattachment = $base . $n . $ext;
1070                $n++;
1071            }
1072        }
1073        else {
1074
1075            # Trashing a topic; look for a non-conflicting name in the
1076            # trash web
1077            my $renamedTopic = $from->web . $to->topic;
1078            $renamedTopic =~ s/\///g;
1079            my $n    = 1;
1080            my $base = $to->topic;
1081            while ( $session->topicExists( $to->web, $renamedTopic ) ) {
1082                $renamedTopic = $base . $n;
1083                $n++;
1084            }
1085            $to = Foswiki::Meta->new( $session, $to->web, $renamedTopic );
1086        }
1087    }
1088
1089    $attachment   = '' if not defined $attachment;
1090    $toattachment = '' if not defined $toattachment;
1091
1092    $attachment   = Foswiki::entityEncode($attachment);
1093    $toattachment = Foswiki::entityEncode($toattachment);
1094
1095    $tmpl =~ s/%FILENAME%/$attachment/g;
1096    $tmpl =~ s/%NEW_FILENAME%/$toattachment/g;
1097    $tmpl =~ s/%NEW_WEB%/$to->web()/ge;
1098    $tmpl =~ s/%NEW_TOPIC%/$to->topic()/ge;
1099
1100    if ( !$attachment ) {
1101        my $refs;
1102        my $search      = '';
1103        my $resultCount = 0;
1104        my $isDelete =
1105          (      $to->web eq $Foswiki::cfg{TrashWebName}
1106              && $from->web ne $Foswiki::cfg{TrashWebName} );
1107        my $checkboxAttrs = {
1108            type  => 'checkbox',
1109            class => 'foswikiCheckBox foswikiGlobalCheckable',
1110            name  => 'referring_topics'
1111        };
1112        $checkboxAttrs->{checked} = 'checked' if !$isDelete;
1113
1114        if ($currentWebOnly) {
1115            $search = $session->i18n->maketext('(skipped)');
1116        }
1117        else {
1118            if ( $tmpl =~ m/%GLOBAL_SEARCH%/ ) {
1119                $refs = _getReferringTopics( $session, $from, 1 );
1120                $resultCount += keys %$refs;
1121                foreach my $entry ( sort keys %$refs ) {
1122                    $checkboxAttrs->{value} = $entry;
1123                    $search .= CGI::div( { class => 'foswikiTopRow' },
1124                        CGI::input($checkboxAttrs) . " [[$entry]] " );
1125                }
1126                unless ($search) {
1127                    $search = ( $session->i18n->maketext('(none)') );
1128                }
1129            }
1130        }
1131        $tmpl =~ s/%GLOBAL_SEARCH%/$search/;
1132
1133        if ( $tmpl =~ m/%LOCAL_SEARCH%/ ) {
1134            $refs = _getReferringTopics( $session, $from, 0 );
1135            $resultCount += keys %$refs;
1136            $search = '';
1137            foreach my $entry ( sort keys %$refs ) {
1138                $checkboxAttrs->{value} = $entry;
1139                $search .= CGI::div( { class => 'foswikiTopRow' },
1140                    CGI::input($checkboxAttrs) . " [[$entry]] " );
1141            }
1142            unless ($search) {
1143                $search = ( $session->i18n->maketext('(none)') );
1144            }
1145            $tmpl =~ s/%LOCAL_SEARCH%/$search/g;
1146        }
1147        $tmpl =~ s/%SEARCH_COUNT%/$resultCount/g;
1148    }
1149
1150    $tmpl = $from->expandMacros($tmpl);
1151    $tmpl = $from->renderTML($tmpl);
1152
1153    $session->writeCompletePage($tmpl);
1154}
1155
1156# Display screen so user can decide on new web.
1157# a Refresh mechanism is provided after submission of the form
1158# so the user can refresh the display until lease conflicts
1159# are resolved.
1160
1161sub _newWebScreen {
1162    my ( $session, $from, $toWeb, $confirm, $infoRef ) = @_;
1163
1164    $toWeb = $from->web() unless ($toWeb);
1165
1166    my @newParentPath = split( '/', $toWeb );
1167    my $newSubWeb     = pop(@newParentPath);
1168    my $newParent     = join( '/', @newParentPath );
1169
1170    my $tmpl = '';
1171    if ( $confirm eq 'getlock' ) {
1172        $tmpl = $session->templates->readTemplate('renamewebconfirm');
1173    }
1174    elsif ( $toWeb eq $Foswiki::cfg{TrashWebName} ) {
1175        $tmpl = $session->templates->readTemplate('renamewebdelete');
1176    }
1177    else {
1178        $tmpl = $session->templates->readTemplate('renameweb');
1179    }
1180
1181    # Trashing a web; look for a non-conflicting name
1182    if ( $toWeb eq $Foswiki::cfg{TrashWebName} ) {
1183        my $renamedWeb = $Foswiki::cfg{TrashWebName} . '/' . $from->web;
1184        my $n          = 1;
1185        my $base       = $renamedWeb;
1186        while ( $session->webExists($renamedWeb) ) {
1187            $renamedWeb = $base . $n;
1188            $n++;
1189        }
1190        $toWeb = $renamedWeb;
1191    }
1192
1193    $tmpl =~ s/%NEW_PARENTWEB%/$newParent/g;
1194    $tmpl =~ s/%NEW_SUBWEB%/$newSubWeb/g;
1195    $tmpl =~ s/%TOPIC%/$Foswiki::cfg{HomeTopicName}/g;
1196
1197    my ( $movelocked, $refdenied, $reflocked ) = ( '', '', '' );
1198    $movelocked = join( ', ', @{ $infoRef->{movelocked} } )
1199      if $infoRef->{movelocked};
1200    $movelocked = ( $session->i18n->maketext('(none)') ) unless $movelocked;
1201    $refdenied = join( ', ', @{ $infoRef->{modifydenied} } )
1202      if $infoRef->{modifydenied};
1203    $refdenied = ( $session->i18n->maketext('(none)') ) unless $refdenied;
1204    $reflocked = join( ', ', @{ $infoRef->{modifylocked} } )
1205      if $infoRef->{modifylocked};
1206    $reflocked = ( $session->i18n->maketext('(none)') ) unless $reflocked;
1207
1208    $tmpl =~ s/%MOVE_LOCKED%/$movelocked/;
1209    $tmpl =~ s/%REF_DENIED%/$refdenied/;
1210    $tmpl =~ s/%REF_LOCKED%/$reflocked/;
1211
1212    my $refresh_prompt = ( $session->i18n->maketext('Refresh') );
1213    my $submit_prompt  = ( $session->i18n->maketext('Move/Rename') );
1214
1215    my $submitAction =
1216      ( $movelocked || $reflocked ) ? $refresh_prompt : $submit_prompt;
1217    $tmpl =~ s/%RENAMEWEB_SUBMIT%/$submitAction/g;
1218
1219    my $refs;
1220    my $search      = '';
1221    my $resultCount = 0;
1222
1223    $refs = ${$infoRef}{referring}{refs1};
1224    $resultCount += keys %$refs;
1225    foreach my $entry ( sort keys %$refs ) {
1226        $search .= CGI::div(
1227            { class => 'foswikiTopRow' },
1228            CGI::input(
1229                {
1230                    type    => 'checkbox',
1231                    class   => 'foswikiCheckBox foswikiGlobalCheckable',
1232                    name    => 'referring_topics',
1233                    value   => $entry,
1234                    checked => 'checked'
1235                }
1236              )
1237              . " [[$entry]] "
1238        );
1239    }
1240    unless ($search) {
1241        $search = ( $session->i18n->maketext('(none)') );
1242    }
1243    $tmpl =~ s/%GLOBAL_SEARCH%/$search/;
1244
1245    $refs = $infoRef->{referring}{refs0};
1246    $resultCount += keys %$refs;
1247    $search = '';
1248    foreach my $entry ( sort keys %$refs ) {
1249        $search .= CGI::div(
1250            { class => 'foswikiTopRow' },
1251            CGI::input(
1252                {
1253                    type    => 'checkbox',
1254                    class   => 'foswikiCheckBox foswikiGlobalCheckable',
1255                    name    => 'referring_topics',
1256                    value   => $entry,
1257                    checked => 'checked'
1258                }
1259              )
1260              . " [[$entry]] "
1261        );
1262    }
1263    unless ($search) {
1264        $search = ( $session->i18n->maketext('(none)') );
1265    }
1266    $tmpl =~ s/%LOCAL_SEARCH%/$search/g;
1267    $tmpl =~ s/%SEARCH_COUNT%/$resultCount/g;
1268
1269    my $fromWebHome =
1270      new Foswiki::Meta( $session, $from->web, $Foswiki::cfg{HomeTopicName} );
1271    $tmpl = $fromWebHome->expandMacros($tmpl);
1272    $tmpl = $fromWebHome->renderTML($tmpl);
1273
1274    $session->writeCompletePage($tmpl);
1275}
1276
1277# Returns the list of topics that have been found that refer
1278# to the renamed topic. Returns a list of topics.
1279sub _getReferringTopicsListFromURL {
1280    my $session = shift;
1281
1282    my $query = $session->{cgiQuery};
1283    my @result;
1284    foreach my $topic ( $query->multi_param('referring_topics') ) {
1285        my ( $itemWeb, $itemTopic ) =
1286          $session->normalizeWebTopicName( '', $topic );
1287
1288        # Check validity of web and topic
1289        $itemWeb = Foswiki::Sandbox::untaint( $itemWeb,
1290            \&Foswiki::Sandbox::validateWebName );
1291        $itemTopic = Foswiki::Sandbox::untaint( $itemTopic,
1292            \&Foswiki::Sandbox::validateTopicName );
1293
1294        # Skip web.topic that fails validation
1295        next unless ( $itemWeb && $itemTopic );
1296
1297        ASSERT( $itemWeb !~ /\./ ) if DEBUG;    # cos we will split on . later
1298        push @result, "$itemWeb.$itemTopic";
1299    }
1300    return \@result;
1301}
1302
1303# _getReferenceRE($web, $topic, %options) -> $re
1304#
1305#    * $web, $topic - specify the topic being referred to, or web if $topic is
1306#      undef.
1307#    * %options - the following options are available
1308#       * =interweb= - if true, then fully web-qualified references are required.
1309#       * =grep= - if true, generate a GNU-grep compatible RE instead of the
1310#         default Perl RE.
1311#       * =nosot= - If true, do not generate "Spaced out text" match
1312#       * =template= - If true, match for template setting in Set/Local statement
1313#       * =in_noautolink= - Only match explicit (squabbed) WikiWords.   Used in <noautolink> blocks
1314#       * =inMeta= - Re should match exact string. No delimiters needed.
1315#       * =url= - if set, generates an expression that will match a Foswiki
1316#         URL that points to the web/topic, instead of the default which
1317#         matches topic links in plain text.
1318# Generate a regular expression that can be used to match references to the
1319# specified web/topic. Note that the resultant RE will only match fully
1320# qualified (i.e. with web specifier) topic names and topic names that
1321# are wikiwords in text. Works for spaced-out wikiwords for topic names.
1322#
1323# The RE returned is designed to be used with =s///=
1324
1325sub _getReferenceRE {
1326    my ( $web, $topic, %options ) = @_;
1327
1328    my $matchWeb = $web;
1329
1330    # Convert . and / to [./] (subweb separators) and quote
1331    # special characters
1332    $matchWeb =~ s#[./]#\0#g;
1333    $matchWeb = quotemeta($matchWeb);
1334
1335# SMELL: Item10176 -  Adding doublequote as a WikiWord delimiter.   This causes non-linking quoted
1336# WikiWords in tml to be incorrectly renamed.   But does handle quoted topic names inside macro parameters.
1337# But this doesn't really fully fix the issue - $quotWikiWord for example.
1338    my $reSTARTWW = qr/^|(?<=[\s"\*=_\(])/m;
1339    my $reENDWW   = qr/$|(?=[\s"\*#=_,.;:!?)])/m;
1340
1341    # \0 is escaped by quotemeta so we need to match the escape
1342    $matchWeb =~ s#\\\0#[./]#g;
1343
1344    # Item1468/5791 - Quote special characters
1345    $topic = quotemeta($topic) if defined $topic;
1346
1347    # Note use of \b to match the empty string at the
1348    # edges of a word.
1349    my ( $bow, $eow, $forward, $back ) = ( '\b_?', '_?\b', '?=', '?<=' );
1350    if ( $options{grep} ) {
1351        $bow     = '\b_?';
1352        $eow     = '_?\b';
1353        $forward = '';
1354        $back    = '';
1355    }
1356    my $squabo = "($back\\[\\[)";
1357    my $squabc = "($forward(?:#.*?)?\\][][])";
1358
1359    my $re = '';
1360
1361    if ( $options{url} ) {
1362
1363        # URL fragment. Assume / separator (while . is legal, it's
1364        # undocumented and is not common usage)
1365        $re = "/$web/";
1366        $re .= $topic . $eow if $topic;
1367    }
1368    else {
1369        if ( defined($topic) ) {
1370
1371            my $sot;
1372            unless ( $options{nosot} ) {
1373
1374                # Work out spaced-out version (allows lc first chars on words)
1375                $sot = Foswiki::spaceOutWikiWord( $topic, ' *' );
1376                if ( $sot ne $topic ) {
1377                    $sot =~ s/\b([a-zA-Z])/'['.uc($1).lc($1).']'/ge;
1378                }
1379                else {
1380                    $sot = undef;
1381                }
1382            }
1383
1384            if ( $options{interweb} ) {
1385
1386                # Require web specifier
1387                if ( $options{grep} ) {
1388                    $re = "$bow$matchWeb\\.$topic$eow";
1389                }
1390                elsif ( $options{template} ) {
1391
1392# $1 is used in replace.  Can't use lookbehind because of variable length restriction
1393                    $re = '('
1394                      . $Foswiki::regex{setRegex}
1395                      . '(?:VIEW|EDIT)_TEMPLATE\s*=\s*)('
1396                      . $matchWeb . '\\.'
1397                      . $topic . ')\s*$';
1398                }
1399                elsif ( $options{in_noautolink} ) {
1400                    $re = "$squabo$matchWeb\\.$topic$squabc";
1401                }
1402                else {
1403                    $re = "$reSTARTWW$matchWeb\\.$topic$reENDWW";
1404                }
1405
1406                # Matching of spaced out topic names.
1407                if ($sot) {
1408
1409                    # match spaced out in squabs only
1410                    $re .= "|$squabo$matchWeb\\.$sot$squabc";
1411                }
1412            }
1413            else {
1414
1415                # Optional web specifier - but *only* if the topic name
1416                # is a wikiword
1417                if ( $topic =~ m/$Foswiki::regex{wikiWordRegex}/ ) {
1418
1419                    # Bit of jigger-pokery at the front to avoid matching
1420                    # subweb specifiers
1421                    if ( $options{grep} ) {
1422                        $re = "(($back\[^./])|^)$bow($matchWeb\\.)?$topic$eow";
1423                    }
1424                    elsif ( $options{template} ) {
1425
1426# $1 is used in replace.  Can't use lookbehind because of variable length restriction
1427                        $re = '('
1428                          . $Foswiki::regex{setRegex}
1429                          . '(?:VIEW|EDIT)_TEMPLATE\s*=\s*)'
1430                          . "($matchWeb\\.)?$topic" . '\s*$';
1431                    }
1432                    elsif ( $options{in_noautolink} ) {
1433                        $re = "$squabo($matchWeb\\.)?$topic$squabc";
1434                    }
1435                    else {
1436                        $re = "$reSTARTWW($matchWeb\\.)?$topic$reENDWW";
1437                    }
1438
1439                    if ($sot) {
1440
1441                        # match spaced out in squabs only
1442                        $re .= "|$squabo($matchWeb\\.)?$sot$squabc";
1443                    }
1444                }
1445                else {
1446                    if ( $options{inMeta} ) {
1447                        $re = "^($matchWeb\\.)?$topic\$"
1448                          ;  # Updating a META item,  Exact match, no delimiters
1449                    }
1450                    else {
1451
1452                        # Non-wikiword; require web specifier or squabs
1453                        $re = "$squabo$topic$squabc";    # Squabbed topic
1454                        $re .= "|\"($matchWeb\\.)?$topic\""
1455                          ;    # Quoted string in Meta and Macros
1456                        $re .= "|(($back\[^./])|^)$bow$matchWeb\\.$topic$eow"
1457                          unless ( $options{in_noautolink} )
1458                          ;    # Web qualified topic outside of autolink blocks.
1459                    }
1460                }
1461            }
1462        }
1463        else {
1464
1465            # Searching for a web
1466            # SMELL:  Does this web search also need to allow for quoted
1467            # "Web.Topic" strings found in macros and META usage?
1468
1469            if ( $options{interweb} ) {
1470
1471                if ( $options{in_noautolink} ) {
1472
1473                    # web name used to refer to a topic
1474                    $re = $squabo . $matchWeb . "(\.[[:alnum:]]+)" . $squabc;
1475                }
1476                else {
1477                    $re = $bow . $matchWeb . "(\.[[:alnum:]]+)" . $eow;
1478                }
1479            }
1480            else {
1481
1482                # most general search for a reference to a topic or subweb
1483                # note that Foswiki::UI::Rename::_replaceWebReferences()
1484                # uses $1 from this regex
1485                if ( $options{in_noautolink} ) {
1486                    $re =
1487                        $squabo
1488                      . $matchWeb
1489                      . "(([\/\.][[:upper:]]"
1490                      . "[[:alnum:]_]*)+"
1491                      . "\.[[:alnum:]]*)"
1492                      . $squabc;
1493                }
1494                else {
1495                    $re =
1496                        $bow
1497                      . $matchWeb
1498                      . "(([\/\.][[:upper:]]"
1499                      . "[[:alnum:]_]*)+"
1500                      . "\.[[:alnum:]]*)"
1501                      . $eow;
1502                }
1503            }
1504        }
1505    }
1506
1507#my $optsx = '';
1508#$optsx .= "NOSOT=$options{nosot} " if ($options{nosot});
1509#$optsx .= "GREP=$options{grep} " if ($options{grep});
1510#$optsx .= "URL=$options{url} " if ($options{url});
1511#$optsx .= "INNOAUTOLINK=$options{in_noautolink} " if ($options{in_noautolink});
1512#$optsx .= "INTERWEB=$options{interweb} " if ($options{interweb});
1513#print STDERR "ReferenceRE returns $re $optsx  \n";
1514    return $re;
1515}
1516
1517#   * =$session= - the session
1518#   * =$om= - web or topic to search for
1519#   * =$allWebs= - 0 to search $web only. 1 to search all webs
1520# _except_ $web.
1521sub _getReferringTopics {
1522    my ( $session, $om, $allWebs ) = @_;
1523    my $renderer = $session->renderer;
1524    require Foswiki::Render;
1525
1526    my @webs = ( $om->web );
1527
1528    if ($allWebs) {
1529        my $root = Foswiki::Meta->new($session);
1530        my $it   = $root->eachWeb(1);
1531        while ( $it->hasNext() ) {
1532            push( @webs, $it->next() );
1533        }
1534    }
1535    my %results;
1536    foreach my $searchWeb (@webs) {
1537        my $interWeb = ( $searchWeb ne $om->web() );
1538        next if ( $allWebs && !$interWeb );
1539
1540        my $webObject = Foswiki::Meta->new( $session, $searchWeb );
1541        next unless $webObject->haveAccess('VIEW');
1542
1543        # Search for both the foswiki form and the URL form
1544        my $searchString = _getReferenceRE(
1545            $om->web(), $om->topic(),
1546            grep     => 1,
1547            interweb => $interWeb
1548        );
1549        $searchString .= '|'
1550          . _getReferenceRE(
1551            $om->web(), $om->topic(),
1552            grep     => 1,
1553            interweb => $interWeb,
1554            url      => 1
1555          );
1556
1557        # If the topic is a Template,  search for set or meta that references it
1558        if ( $om->topic() && $om->topic() =~ m/(.*)Template$/ ) {
1559            my $refre = '(VIEW|EDIT)_TEMPLATE.*';
1560            $refre .= _getReferenceRE(
1561                $om->web(), $1,
1562                grep     => 1,
1563                nosot    => 1,
1564                interweb => $interWeb,
1565            );
1566            $searchString .= '|' . $refre;
1567        }
1568
1569        my $options =
1570          { casesensitive => 1, type => 'regex', web => $searchWeb };
1571        my $query = $session->search->parseSearch( $searchString, $options );
1572        my $matches = Foswiki::Meta::query( $query, undef, $options );
1573
1574        while ( $matches->hasNext ) {
1575            my $webtopic = $matches->next;
1576            my ( $web, $searchTopic ) =
1577              $session->normalizeWebTopicName( $searchWeb, $webtopic );
1578            next
1579              if ( $searchWeb eq $om->web
1580                && $om->topic
1581                && $searchTopic eq $om->topic );
1582
1583            # Individual topics may be view restricted. Only return
1584            # those we can see.
1585            my $m = Foswiki::Meta->new( $session, $searchWeb, $searchTopic );
1586            next unless $m->haveAccess('VIEW');
1587
1588            $results{ $searchWeb . '.' . $searchTopic } = 1;
1589        }
1590    }
1591    return \%results;
1592}
1593
1594# Update pages that refer to a page that is being renamed/moved.
1595# SMELL: this might be done more efficiently if it was behind the
1596# store interface
1597sub _updateReferringTopics {
1598    my ( $session, $refs, $fn, $options ) = @_;
1599
1600    my $renderer = $session->renderer;
1601    require Foswiki::Render;
1602
1603    $options->{pre} = 1;    # process lines in PRE blocks
1604
1605    foreach my $item (@$refs) {
1606        my ( $itemWeb, $itemTopic ) = split( /\./, $item, 2 );
1607
1608        if ( $session->topicExists( $itemWeb, $itemTopic ) ) {
1609            my $topicObject =
1610              Foswiki::Meta->load( $session, $itemWeb, $itemTopic );
1611            unless ( $topicObject->haveAccess('CHANGE') ) {
1612                $session->logger->log( 'warning',
1613                    "Access to CHANGE $itemWeb.$itemTopic is denied: "
1614                      . $Foswiki::Meta::reason );
1615                next;
1616            }
1617            $options->{inWeb} = $itemWeb;
1618            my $text =
1619              $renderer->forEachLine( $topicObject->text(), $fn, $options );
1620            $options->{inMeta} = 1;
1621            $topicObject->forEachSelectedValue(
1622                qw/^(FIELD|FORM|PREFERENCE|TOPICPARENT)$/,
1623                undef, $fn, $options );
1624            $options->{inMeta} = 0;
1625            $topicObject->text($text);
1626            $topicObject->save( minor => 1 );
1627        }
1628    }
1629}
1630
16311;
1632__END__
1633Foswiki - The Free and Open Source Wiki, http://foswiki.org/
1634
1635Copyright (C) 2008-2010 Foswiki Contributors. Foswiki Contributors
1636are listed in the AUTHORS file in the root of this distribution.
1637NOTE: Please extend that file, not this notice.
1638
1639Additional copyrights apply to some or all of the code in this
1640file as follows:
1641
1642Copyright (C) 1999-2007 Peter Thoeny, peter@thoeny.org
1643and TWiki Contributors. All Rights Reserved. TWiki Contributors
1644are listed in the AUTHORS file in the root of this distribution.
1645
1646This program is free software; you can redistribute it and/or
1647modify it under the terms of the GNU General Public License
1648as published by the Free Software Foundation; either version 2
1649of the License, or (at your option) any later version. For
1650more details read LICENSE in the root of this distribution.
1651
1652This program is distributed in the hope that it will be useful,
1653but WITHOUT ANY WARRANTY; without even the implied warranty of
1654MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.
1655
1656As per the GPL, removal of this notice is prohibited.
1657