1 rizwank 1.1 # TWiki Collaboration Platform, http://TWiki.org/
2 #
3 # Copyright (C) 1999-2004 Peter Thoeny, peter@thoeny.com
4 #
5 # For licensing info read license.txt file in the TWiki root.
6 # This program is free software; you can redistribute it and/or
7 # modify it under the terms of the GNU General Public License
8 # as published by the Free Software Foundation; either version 2
9 # of the License, or (at your option) any later version.
10 #
11 # This program is distributed in the hope that it will be useful,
12 # but WITHOUT ANY WARRANTY; without even the implied warranty of
13 # MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
14 # GNU General Public License for more details, published at
15 # http://www.gnu.org/copyleft/gpl.html
16 =begin twiki
17
18 ---+ TWiki::UI::Manage
19
20 UI functions for web, topic and user management
21
22 rizwank 1.1 =cut
23
24 package TWiki::UI::Manage;
25
26 use strict;
27 use File::Copy;
28 use TWiki;
29 use TWiki::UI;
30 use TWiki::User;
31
32 =pod
33
34 ---+++ removeUser( $web, $topic, $userToRemove, $query )
35 Renames the user's topic (with renaming all links)
36 removes user entry from passwords. CGI parameters:
37 | =password= | |
38
39 =cut
40
41 sub removeUser {
42 my( $webName, $topic, $wikiName, $query ) = @_;
43 rizwank 1.1
44 my $password = $query->param( 'password' );
45
46 # check if user entry exists
47 #TODO: need to handle the NoPasswdUser case (UserPasswordExists will retun false here)
48 if( ( $wikiName ) && (! TWiki::User::UserPasswordExists( $wikiName ) ) ) {
49 TWiki::UI::oops( $webName, $topic, "notwikiuser", $wikiName );
50 return;
51 }
52
53 #check to see it the user we are trying to remove is a memebr of a group.
54 #initinally we refuse to delte the user
55 #in a later implementation we will remove the from the group (if Access.pm implements it..)
56 my @groups = TWiki::Access::getGroupsUserIsIn( $wikiName );
57 my $numberOfGroups = $#groups;
58 if ( $numberOfGroups > -1 ) {
59 TWiki::UI::oops( $webName, $topic, "genericerror");
60 return;
61 }
62
63 my $pw = TWiki::User::CheckUserPasswd( $wikiName, $password );
64 rizwank 1.1 if( ! $pw ) {
65 # NO - wrong old password
66 TWiki::UI::oops( $webName, $topic, "wrongpassword");
67 return;
68 }
69
70 #TODO: need to add GetUniqueTopicName
71 # # appends a unique number to the requested topicname
72 # my $newTopicName = TWiki::getUniqueTopicName("AnonymousContributor");
73 #
74 # my $renameError = &TWiki::Store::renameTopic( $TWiki::mainWebname, $wikiName, $TWiki::mainWebname, $newTopicName, "relink" );
75 #
76 # if ( $renameError ) {
77 #TODO: add better error message for rname failed
78 # TWiki::UI::oops( $webName, $topic, "renameerr");
79 # return;
80 # }
81 #
82 # # Update references in referring pages - not applicable to attachments.
83 # my @refs = &TWiki::Store::findReferringPages( $oldWeb, $oldTopic );
84 # my $problems;
85 rizwank 1.1 # ( $lockFailure, $problems ) =
86 # &TWiki::Store::updateReferingPages( $oldWeb, $oldTopic, $wikiUserName, $newWeb, $newTopic, @refs );
87
88 TWiki::User::RemoveUser($wikiName);
89
90 TWiki::UI::oops( $webName, $topic, "removeuserdone", $wikiName);
91 return;
92 }
93
94 =pod
95
96 ---+++ changePassword( $webName, $topic, $query )
97 Change the user's password. Details of the user and password
98 are passed in CGI parameters.
99 | =username= | |
100 | =password= | |
101 | =passwordA= | |
102 | =TopicName= | |
103
104 =cut
105
106 rizwank 1.1 sub changePassword {
107 my( $webName, $topic, $query ) = @_;
108
109 my $wikiName = $query->param( 'username' );
110 my $passwordA = $query->param( 'password' );
111 my $passwordB = $query->param( 'passwordA' );
112 my $topicName = $query->param( 'TopicName' );
113
114 # check if required fields are filled in
115 if( ! $wikiName || ! $passwordA ) {
116 TWiki::UI::oops( $webName, $topic, "regrequ", );
117 return;
118 }
119
120 # check if user entry exists
121 #TODO: need to handle the NoPasswdUser case (UserPasswordExists will retun false here)
122 if( ( $wikiName ) && (! TWiki::User::UserPasswordExists( $wikiName ) ) ) {
123 TWiki::UI::oops( $webName, $topic, "notwikiuser", $wikiName );
124 return;
125 }
126
127 rizwank 1.1 # check if passwords are identical
128 if( $passwordA ne $passwordB ) {
129 TWiki::UI::oops( $webName, $topic, "regpasswd" );
130 return;
131 }
132
133 # c h a n g e
134 my $oldpassword = $query->param( 'oldpassword' );
135
136 # check if required fields are filled in
137 if( ! $oldpassword ) {
138 TWiki::UI::oops( $webName, $topic, "regrequ" );
139 return;
140 }
141
142 my $pw = TWiki::User::CheckUserPasswd( $wikiName, $oldpassword );
143 if( ! $pw ) {
144 # NO - wrong old password
145 TWiki::UI::oops( $webName, $topic, "wrongpassword");
146 return;
147 }
148 rizwank 1.1
149 # OK - password may be changed
150 TWiki::User::UpdateUserPassword($wikiName, $oldpassword, $passwordA );
151
152 # OK - password changed
153 TWiki::UI::oops( $webName, $topic, "changepasswd" );
154 }
155
156 # PRIVATE Prepare a template var for expansion in a message
157 sub _template {
158 my $theTmplVar = shift;
159 return "%TMPL:P{\"$theTmplVar\"}%";
160 }
161
162 =pod
163
164 ---++ createWeb( $web, $topic, $user, $query )
165 Create a new web. Parameters defining the new web are passed
166 in a CGI query.
167
168 | =newweb= | Name of new web |
169 rizwank 1.1 | =baseweb= | Name of web to copy to create newweb |
170 | =webbgcolor= | background color for new web |
171 | =sitemapwhat= | |
172 | =sitemapuseto= | |
173 | =nosearchall= | |
174
175 =cut
176
177 sub createWeb {
178 my( $webName, $topicName, $userName, $query ) = @_;
179
180 my $newWeb = $query->param( 'newweb' ) || "";
181 my $newTopic = $query->param( 'newtopic' ) || "";
182 my $baseWeb = $query->param( 'baseweb' ) || "";
183 my $webBgColor = $query->param( 'webbgcolor' ) || "";
184 my $siteMapWhat = $query->param( 'sitemapwhat' ) || "";
185 my $siteMapUseTo = $query->param( 'sitemapuseto' ) || "";
186 my $noSearchAll = $query->param( 'nosearchall' ) || "";
187 my $theUrl = $query->url;
188 my $oopsTmpl = "mngcreateweb";
189
190 rizwank 1.1 # check permission, user authorized to create webs?
191 my $wikiUserName = TWiki::userToWikiName( $userName );
192 return unless TWiki::UI::isAccessPermitted( $webName, $topicName,
193 "manage", $wikiUserName );
194
195 if( $newWeb =~ /^_[a-zA-Z0-9_]+$/ ) {
196 # valid template web name, untaint
197 $newWeb =~ /(.*)/;
198 $newWeb = $1;
199 } elsif( TWiki::isWebName( $newWeb ) ) {
200 # valid web name, untaint
201 $newWeb =~ /(.*)/;
202 $newWeb = $1;
203 } elsif( $newWeb ) {
204 TWiki::UI::oops( "", "", $oopsTmpl, _template("msg_web_name") );
205 return;
206 } else {
207 TWiki::UI::oops( "", "", $oopsTmpl, _template("msg_web_missing") );
208 return;
209 }
210
211 rizwank 1.1 if( TWiki::Store::topicExists( $newWeb, $TWiki::mainTopicname ) ) {
212 TWiki::UI::oops( "", "", $oopsTmpl,
213 _template("msg_web_exist"), $newWeb );
214 return;
215 }
216
217 $baseWeb =~ s/$TWiki::securityFilter//go;
218 $baseWeb =~ /(.*)/;
219 $baseWeb = $1;
220
221 unless( TWiki::Store::topicExists( $baseWeb, $TWiki::mainTopicname ) ) {
222 TWiki::UI::oops( "", "", $oopsTmpl, _template("msg_base_web"), $baseWeb );
223 return;
224 }
225
226 unless( $webBgColor =~ /\#[0-9a-f]{6}/i ) {
227 TWiki::UI::oops( "", "", $oopsTmpl, _template("msg_web_color") );
228 return;
229 }
230
231 # create the empty web
232 rizwank 1.1 my $err = _createEmptyWeb( $newWeb );
233 if( $err ) {
234 TWiki::UI::oops( "", "", $oopsTmpl, _template("msg_web_create"), $err );
235 return;
236 }
237
238 # copy needed topics from base web
239 $err = _copyWebTopics( $baseWeb, $newWeb );
240 if( $err ) {
241 TWiki::UI::oops( $newWeb, "", $oopsTmpl, _template("msg_web_copy_topics"), $err );
242 return;
243 }
244
245 # patch WebPreferences
246 $err = _patchWebPreferences( $newWeb, $TWiki::webPrefsTopicname, $webBgColor,
247 $siteMapWhat, $siteMapUseTo, $noSearchAll );
248 if( $err ) {
249 TWiki::UI::oops( $newWeb, $TWiki::webPrefsTopicname, $oopsTmpl, _template("msg_patch_webpreferences"), $err );
250 return;
251 }
252
253 rizwank 1.1 # everything OK, redirect to last message
254 $newTopic = $TWiki::mainTopicname unless( $newTopic );
255 TWiki::UI::oops( $newWeb, $newTopic, $oopsTmpl, _template("msg_create_web_ok") );
256 return;
257 }
258
259 # CODE_SMELL: Surely this should be done by Store?
260 sub _createEmptyWeb {
261 my ( $theWeb ) = @_;
262
263 my $dir = "$TWiki::dataDir/$theWeb";
264 umask( 0 );
265 unless( mkdir( $dir, 0775 ) ) {
266 return( "Could not create $dir, error: $!" );
267 }
268
269 if ( $TWiki::useRcsDir ) {
270 unless( mkdir( "$dir/RCS", 0775 ) ) {
271 return( "Could not create $dir/RCS, error: $!" );
272 }
273 }
274 rizwank 1.1
275 unless( open( FILE, ">$dir/.changes" ) ) {
276 return( "Could not create changes file $dir/.changes, error: $!" );
277 }
278 print FILE ""; # empty file
279 close( FILE );
280
281 unless( open( FILE, ">$dir/.mailnotify" ) ) {
282 return( "Could not create mailnotify timestamp file $dir/.mailnotify, error: $!" );
283 }
284 print FILE ""; # empty file
285 close( FILE );
286 return "";
287 }
288
289 # CODE_SMELL: Surely this should be done by Store?
290 sub _copyWebTopics
291 {
292 my ( $theBaseWeb, $theNewWeb ) = @_;
293
294 my $err = "";
295 rizwank 1.1 my @topicList = &TWiki::Store::getTopicNames( $theBaseWeb );
296 unless( $theBaseWeb =~ /^_/ ) {
297 # not a template web, so filter for only Web* topics
298 @topicList = grep { /^Web/ } @topicList;
299 }
300 foreach my $topic ( @topicList ) {
301 $topic =~ s/$TWiki::securityFilter//go;
302 $topic =~ /(.*)/;
303 $topic = $1;
304 $err = _copyOneTopic( $theBaseWeb, $topic, $theNewWeb );
305 return( $err ) if( $err );
306 }
307 return "";
308 }
309
310 # CODE_SMELL: Surely this should be done by Store?
311 sub _copyOneTopic
312 {
313 my ( $theFromWeb, $theTopic, $theToWeb ) = @_;
314
315 # FIXME: This should go into TWiki::Store
316 rizwank 1.1
317 # copy topic file
318 my $from = "$TWiki::dataDir/$theFromWeb/$theTopic.txt";
319 my $to = "$TWiki::dataDir/$theToWeb/$theTopic.txt";
320 unless( copy( $from, $to ) ) {
321 return( "Copy file ( $from, $to ) failed, error: $!" );
322 }
323 umask( 002 );
324 chmod( 0644, $to );
325
326 # copy repository file
327 # FIXME: Hack, no support for RCS subdirectory
328 $from .= ",v";
329 $to .= ",v";
330 if( -e $from ) {
331 unless( copy( $from, $to ) ) {
332 return( "Copy file ( $from, $to ) failed, error: $!" );
333 }
334 umask( 002 );
335 chmod( 0644, $to );
336 }
337 rizwank 1.1
338 # FIXME: Copy also attachments if present
339
340 return "";
341 }
342
343 # CODE_SMELL: Surely this should be done by Store?
344 sub _patchWebPreferences
345 {
346 my ( $theWeb, $theTopic, $theWebBgColor, $theSiteMapWhat, $theSiteMapUseTo, $doNoSearchAll ) = @_;
347
348 my( $meta, $text ) = &TWiki::Store::readTopic( $theWeb, $theTopic );
349
350 my $siteMapList = "";
351 $siteMapList = "on" if( $theSiteMapWhat );
352 $text =~ s/(\s\* Set WEBBGCOLOR =)[^\n\r]*/$1 $theWebBgColor/os;
353 $text =~ s/(\s\* Set SITEMAPLIST =)[^\n\r]*/$1 $siteMapList/os;
354 $text =~ s/(\s\* Set SITEMAPWHAT =)[^\n\r]*/$1 $theSiteMapWhat/os;
355 $text =~ s/(\s\* Set SITEMAPUSETO =)[^\n\r]*/$1 $theSiteMapUseTo/os;
356 $text =~ s/(\s\* Set NOSEARCHALL =)[^\n\r]*/$1 $doNoSearchAll/os;
357
358 rizwank 1.1 my $err = &TWiki::Store::saveTopic( $theWeb, $theTopic, $text, $meta );
359
360 return $err;
361 }
362
363 =pod
364
365 ---+++ rename( $web, $topic, $user, $query )
366 Rename the given topic. Details of the new topic name are passed in CGI
367 paremeters:
368 | =skin= | skin to use for derivative topics |
369 | =newweb= | new web name |
370 | =newtopic= | new topic name |
371 | =breaklock= | |
372 | =attachment= | |
373 | =confirm= | if defined, requires a second level of confirmation |
374 | =currentwebonly= | if defined, searches current web only for links to this topic |
375 | =nonwikiword= | if defined, a non-wikiword is acceptable for the new topic name |
376 | =changerefs= | |
377
378 =cut
379 rizwank 1.1
380 sub rename {
381 my ( $oldWeb, $oldTopic, $userName, $query ) = @_;
382
383 my $newWeb = $query->param( 'newweb' ) || "";
384 my $newTopic = $query->param( 'newtopic' ) || "";
385 my $theUrl = $query->url;
386 my $lockFailure = "";
387 my $breakLock = $query->param( 'breaklock' );
388 my $theAttachment = $query->param( 'attachment' );
389 my $confirm = $query->param( 'confirm' );
390 my $currentWebOnly = $query->param( 'currentwebonly' ) || "";
391 my $doAllowNonWikiWord = $query->param( 'nonwikiword' ) || "";
392 my $justChangeRefs = $query->param( 'changeRefs' ) || "";
393
394 my $skin = $query->param( "skin" ) || TWiki::Prefs::getPreferencesValue( "SKIN" );
395
396 $newTopic =~ s/\s//go;
397 $newTopic =~ s/$TWiki::securityFilter//go;
398
399 if( ! $theAttachment ) {
400 rizwank 1.1 $theAttachment = "";
401 }
402
403 my $wikiUserName = &TWiki::userToWikiName( $userName );
404
405 # justChangeRefs will be true when some topics that had links to $oldTopic
406 # still need updating, previous update being prevented by a lock.
407
408 my $fileName = &TWiki::Store::getFileName( $oldWeb, $oldTopic );
409 my $newName;
410 $newName = &TWiki::Store::getFileName( $newWeb, $newTopic ) if( $newWeb );
411
412 if( ! $justChangeRefs ) {
413 if( _checkExist( $oldWeb, $oldTopic, $newWeb, $newTopic, $theAttachment, $fileName, $newName ) ) {
414 return;
415 }
416
417 if( ! _checkPermissions( $oldWeb, $oldTopic, $wikiUserName ) ) {
418 return;
419 }
420 }
421 rizwank 1.1
422 # Has user selected new name yet?
423 if( ! $newTopic || $confirm ) {
424 _newTopicScreen( $oldWeb, $oldTopic, $newWeb, $newTopic, $theAttachment,
425 $confirm, $currentWebOnly, $doAllowNonWikiWord, $skin );
426 return;
427 }
428
429 if( ! $justChangeRefs ) {
430 if( ! _getLocks( $oldWeb, $oldTopic, $newWeb, $newTopic, $theAttachment, $breakLock, $skin ) ) {
431 return;
432 }
433 }
434
435 if( ! $justChangeRefs ) {
436 if( $theAttachment ) {
437 my $moveError =
438 &TWiki::Store::moveAttachment( $oldWeb, $oldTopic, $newWeb, $newTopic, $theAttachment );
439 if( $moveError ) {
440 TWiki::UI::oops( $newWeb, $newTopic, "moveerr",
441 $theAttachment, $moveError );
442 rizwank 1.1 return;
443 }
444 } else {
445 if( ! $doAllowNonWikiWord && ! &TWiki::isWikiName( $newTopic ) ) {
446 TWiki::UI::oops( $newWeb, $newTopic, "renamenotwikiword" );
447 return;
448 }
449
450 my $renameError = &TWiki::Store::renameTopic( $oldWeb, $oldTopic, $newWeb, $newTopic, "relink" );
451 if( $renameError ) {
452 TWiki::UI::oops( $oldWeb, $oldTopic, "renameerr",
453 $renameError, $newWeb, $newTopic );
454 return;
455 }
456 }
457 }
458
459 # Update references in referring pages - not applicable to attachments.
460 if( ! $theAttachment ) {
461 my @refs = _getReferingTopicsListFromURL( $oldWeb, $oldTopic, $newWeb, $newTopic );
462
463 rizwank 1.1 my $problems;
464 ( $lockFailure, $problems ) =
465 &TWiki::Store::updateReferingPages( $oldWeb, $oldTopic, $wikiUserName, $newWeb, $newTopic, @refs );
466 }
467
468 my $new_url = "";
469 if( $lockFailure ) {
470 _moreRefsToChange( $oldWeb, $oldTopic, $newWeb, $newTopic, $skin );
471 return;
472 } elsif ( "$newWeb" eq "Trash" && "$oldWeb" ne "Trash" ) {
473 if( $theAttachment ) {
474 # go back to old topic after deleting an attachment
475 $new_url = &TWiki::getViewUrl( $oldWeb, $oldTopic );
476 } else {
477 #redirect to parent: ending in Trash is not the expected way (ColasNahaboo - 31 Mar 2003)
478 my $meta = ""; my $text = "";
479 ( $meta, $text ) = &TWiki::Store::readTopic( $newWeb, $newTopic, 1 );
480 my %parent = $meta->findOne( "TOPICPARENT" );
481 if( %parent && $parent{"name"} && $parent{"name"} ne $oldTopic ) {
482 if ( $parent{"name"} =~ /([^.]+)[.]([^.]+)/ ) {
483 $new_url = &TWiki::getViewUrl( $1, $2 );
484 rizwank 1.1 } else {
485 $new_url = &TWiki::getViewUrl( $oldWeb, $parent{"name"} );
486 }
487 } else {
488 use vars qw( $mainTopicname );
489 $new_url = &TWiki::getViewUrl( $oldWeb, $mainTopicname );
490 }
491 }
492 } else {
493 #redirect to new topic
494 $new_url = &TWiki::getViewUrl( $newWeb, $newTopic );
495 }
496
497 TWiki::UI::redirect( $new_url );
498 return;
499 }
500
501 #=========================
502
503 =pod
504
505 rizwank 1.1 ---++ _relockRcsFiles ( )
506 | Description: | relocks all the rcs files using the configured apache user (called from testenv)) |
507
508 =cut
509
510 sub relockRcsFiles {
511 print "Content-type: text/html\n\n";
512 print "<html><head></head><body>\n";
513 print "Preparing to change all RCS locks to match current webserver user.\n";
514 print "Please wait for this page to tell you it is finished.\n";
515 print "This could take awhile, depending on the number of topics to process\n";
516 print "(about 10 seconds for a standard twiki beta release - 615 topics -\n";
517 print "on a Win2k+cygwin+apache2 machine running @ 1100MHz with 512MB ram).";
518
519 $ENV{PATH} = '';
520
521 opendir(DATA, $TWiki::dataDir) or
522 die "Open $TWiki::dataDir failed";
523 foreach my $web ( grep /^\w+$/, readdir DATA ) {
524 $web =~ /(.*)/; # untaint
525 $web = $1;
526 rizwank 1.1 print "<h1>Unlocking $web</h1>\n";
527 if ( -d "$TWiki::dataDir/$web" ) {
528 opendir(WEB, "$TWiki::dataDir/$web") or
529 die "Open $TWiki::dataDir/$web failed";;
530 foreach my $topic ( grep /.txt$/, readdir WEB ) {
531 $topic =~ /(.*)/; # untaint
532 $topic = $1;
533 print "<code>$topic</code> ";
534
535 #TODO replace with TWiki::Store::breakLockTopic( $web, $topic );
536 print `$TWiki::rcsDir/rcs -q -u -M $TWiki::dataDir/$web/$topic`;
537 #TODO replace with TWiki::Store::reLockTopic( $web, $topic );
538 print `$TWiki::rcsDir/rcs -q -l $TWiki::dataDir/$web/$topic`;
539 #TODO replace with TWiki::Store::checkIn (or something)
540 print `$TWiki::rcsDir/ci -mtestenv -t-missing_v $TWiki::dataDir/$web/$topic`;
541 print `$TWiki::rcsDir/co -q -l -M $TWiki::dataDir/$web/$topic`;
542 print "<br />\n";
543 }
544 closedir(WEB);
545 }
546 }
547 rizwank 1.1 closedir(DATA);
548 print "<h2>Re-locking finished</h2>\n";
549 print "It is now safe to reload <a href=\"$TWiki::defaultUrlHost$TWiki::scriptUrlPath/testenv\">testenv</a> \n";
550 print "</body></html>";
551 }
552
553 #=========================
554
555 =pod
556
557 ---++ _getReferingTopicsListFromURL ( $oldWeb, $oldTopic, $newWeb, $newTopic ) ==> @refs
558 | Description: | returns the list of topics that have been found that refer to the renamed topic |
559 | Parameter: =$oldWeb= | |
560 | Parameter: =$oldTopic= | |
561 | Parameter: =$newWeb= | |
562 | Parameter: =$newTopic= | |
563 | Return: =@refs= | |
564 | TODO: | docco what the return list means |
565
566 =cut
567
568 rizwank 1.1 sub _getReferingTopicsListFromURL {
569 my $query = TWiki::getCgiQuery();
570 my ( $oldWeb, $oldTopic, $newWeb, $newTopic ) = @_;
571
572 my @result = ();
573
574 # Go through parameters finding all topics for change
575 my @types = qw\local global\;
576 foreach my $type ( @types ) {
577 my $count = 1;
578 while( $query->param( "TOPIC$type$count" ) ) {
579 my $checked = $query->param( "RENAME$type$count" );
580 if ($checked) {
581 push @result, $type;
582 my $topic = $query->param( "TOPIC$type$count" );
583 if ($topic =~ /^$oldWeb.$oldTopic$/ ) {
584 $topic = "$newWeb.$newTopic";
585 }
586 push @result, $topic;
587 }
588 $count++;
589 rizwank 1.1 }
590 }
591 return @result;
592 }
593
594 #=============================
595 # return "" if problem, otherwise return text of oldTopic
596 sub _checkPermissions {
597 my( $oldWeb, $oldTopic, $wikiUserName ) = @_;
598
599 return "" unless TWiki::UI::isAccessPermitted( $oldWeb, $oldTopic, "change", $wikiUserName );
600 return "" unless TWiki::UI::isAccessPermitted( $oldWeb, $oldTopic, "rename", $wikiUserName );
601
602 my $ret = "";
603 if( &TWiki::Store::topicExists( $oldWeb, $oldTopic ) ) {
604 $ret = &TWiki::Store::readWebTopic( $oldWeb, $oldTopic );
605 }
606 return $ret;
607 }
608
609
610 rizwank 1.1 #==========================================
611 # Check that various webs and topics exist or don't exist as required
612 sub _checkExist {
613 my( $oldWeb, $oldTopic, $newWeb, $newTopic, $theAttachment, $oldFileName, $newFileName ) = @_;
614
615 my $ret = 0;
616 my $query = TWiki::getCgiQuery();
617
618 $ret = 1 unless TWiki::UI::webExists( $oldWeb, $oldTopic );
619 $ret = 1 unless TWiki::UI::webExists( $newWeb, $newTopic );
620
621 # Does old attachment exist?
622 if( ! -e $oldFileName) {
623 TWiki::UI::oops( $oldWeb, $oldTopic, "missing" );
624 $ret = 1;
625 }
626
627 # Check new topic doesn't exist (opposite if we've moving an attachment)
628 if( defined( $newFileName ) && -e $newFileName && ! $theAttachment ) {
629 # Unless moving an attachment, new topic should not already exist
630 TWiki::UI::oops( $newWeb, $newTopic, "topicexists" );
631 rizwank 1.1 $ret = 1;
632 }
633
634 if( defined( $newFileName ) && $theAttachment && ! -e $newFileName ) {
635 TWiki::UI::oops( $newWeb, $newTopic, "missing" );
636 $ret = 1;
637 }
638
639 return $ret;
640 }
641
642
643 #============================
644 #Return "" if can't get lock, otherwise "okay"
645 sub _getLocks {
646 my( $oldWeb, $oldTopic, $newWeb, $newTopic, $theAttachment, $breakLock, $skin ) = @_;
647
648 my( $oldLockUser, $oldLockTime, $newLockUser, $newLockTime );
649 my $query = TWiki::getCgiQuery();
650
651 if( ! $breakLock ) {
652 rizwank 1.1 # Check for lock - at present the lock can't be broken
653 ( $oldLockUser, $oldLockTime ) = &TWiki::Store::topicIsLockedBy( $oldWeb, $oldTopic );
654 if( $oldLockUser ) {
655 $oldLockUser = &TWiki::userToWikiName( $oldLockUser );
656 use integer;
657 $oldLockTime = ( $oldLockTime / 60 ) + 1; # convert to minutes
658 }
659
660 if( $theAttachment ) {
661 ( $newLockUser, $newLockTime ) = &TWiki::Store::topicIsLockedBy( $newWeb, $newTopic );
662 if( $newLockUser ) {
663 $newLockUser = &TWiki::userToWikiName( $newLockUser );
664 use integer;
665 $newLockTime = ( $newLockTime / 60 ) + 1; # convert to minutes
666 my $editLock = $TWiki::editLockTime / 60;
667 }
668 }
669 }
670
671 if( $oldLockUser || $newLockUser ) {
672 my $tmpl = &TWiki::Store::readTemplate( "oopslockedrename", $skin );
673 rizwank 1.1 my $editLock = $TWiki::editLockTime / 60;
674 if( $oldLockUser ) {
675 $tmpl =~ s/%OLD_LOCK%/Source topic $oldWeb.$oldTopic is locked by $oldLockUser, lock expires in $oldLockTime minutes.<br \/>/go;
676 } else {
677 $tmpl =~ s/%OLD_LOCK%//go;
678 }
679 if( $newLockUser ) {
680 $tmpl =~ s/%NEW_LOCK%/Destination topic $newWeb.$newTopic is locked by $newLockUser, lock expires in $newLockTime minutes.<br \/>/go;
681 } else {
682 $tmpl =~ s/%NEW_LOCK%//go;
683 }
684 $tmpl =~ s/%NEW_WEB%/$newWeb/go;
685 $tmpl =~ s/%NEW_TOPIC%/$newTopic/go;
686 $tmpl =~ s/%ATTACHMENT%/$theAttachment/go;
687 $tmpl = &TWiki::handleCommonTags( $tmpl, $oldTopic, $oldWeb );
688 $tmpl = &TWiki::Render::getRenderedVersion( $tmpl, $oldWeb );
689 $tmpl =~ s/( ?) *<\/?(nop|noautolink)\/?>\n?/$1/gois; # remove <nop> and <noautolink> tags
690 TWiki::writeHeader( $query );
691 print $tmpl;
692 return "";
693 } else {
694 rizwank 1.1 &TWiki::Store::lockTopicNew( $oldWeb, $oldTopic );
695 if( $theAttachment ) {
696 &TWiki::Store::lockTopicNew( $newWeb, $newTopic );
697 }
698 }
699
700 return "okay";
701 }
702
703 #============================
704 # Display screen so user can decide on new web and topic.
705 sub _newTopicScreen {
706 my( $oldWeb, $oldTopic, $newWeb, $newTopic, $theAttachment,
707 $confirm, $currentWebOnly, $doAllowNonWikiWord, $skin ) = @_;
708
709 my $query = TWiki::getCgiQuery();
710 my $tmpl = "";
711
712 $newTopic = $oldTopic unless ( $newTopic );
713 $newWeb = $oldWeb unless ( $newWeb );
714 my $nonWikiWordFlag = "";
715 rizwank 1.1 $nonWikiWordFlag = 'checked="checked"' if( $doAllowNonWikiWord );
716
717 TWiki::writeHeader( $query );
718 if( $theAttachment ) {
719 $tmpl = TWiki::Store::readTemplate( "moveattachment", $skin );
720 $tmpl =~ s/%FILENAME%/$theAttachment/go;
721 } elsif( $confirm ) {
722 $tmpl = TWiki::Store::readTemplate( "renameconfirm", $skin );
723 } elsif( $newWeb eq "Trash" ) {
724 $tmpl = TWiki::Store::readTemplate( "renamedelete", $skin );
725 } else {
726 $tmpl = &TWiki::Store::readTemplate( "rename", $skin );
727 }
728
729 $tmpl = _setVars( $tmpl, $oldTopic, $newWeb, $newTopic, $nonWikiWordFlag );
730 $tmpl = &TWiki::handleCommonTags( $tmpl, $oldTopic, $oldWeb );
731 $tmpl = &TWiki::Render::getRenderedVersion( $tmpl );
732 if( $currentWebOnly ) {
733 $tmpl =~ s/%RESEARCH\{.*?web=\"all\".*\}%/(skipped)/o; # Remove search all web search
734 }
735 $tmpl =~ s/%RESEARCH/%SEARCH/go; # Pre search result from being rendered
736 rizwank 1.1 $tmpl = &TWiki::handleCommonTags( $tmpl, $oldTopic, $oldWeb );
737 $tmpl =~ s/( ?) *<\/?(nop|noautolink)\/?>\n?/$1/gois; # remove <nop> and <noautolink> tags
738 print $tmpl;
739 }
740
741 #=========================
742 sub _setVars {
743 my( $tmpl, $oldTopic, $newWeb, $newTopic, $nonWikiWordFlag ) = @_;
744 $tmpl =~ s/%NEW_WEB%/$newWeb/go;
745 $tmpl =~ s/%NEW_TOPIC%/$newTopic/go;
746 $tmpl =~ s/%NONWIKIWORDFLAG%/$nonWikiWordFlag/go;
747 return $tmpl;
748 }
749
750 #=========================
751 sub _moreRefsToChange {
752 my( $oldWeb, $oldTopic, $newWeb, $newTopic, $skin ) = @_;
753 my $query = TWiki::getCgiQuery();
754
755 TWiki::writeHeader( $query );
756 my $tmpl = TWiki::Store::readTemplate( "renamerefs", $skin );
757 rizwank 1.1 $tmpl = _setVars( $tmpl, $oldTopic, $newWeb, $newTopic );
758 $tmpl = TWiki::Render::getRenderedVersion( $tmpl );
759 $tmpl =~ s/%RESEARCH/%SEARCH/go; # Pre search result from being rendered
760 $tmpl = TWiki::handleCommonTags( $tmpl, $oldTopic, $oldWeb );
761 $tmpl =~ s/( ?) *<\/?(nop|noautolink)\/?>\n?/$1/gois; # remove <nop> and <noautolink> tags
762 print $tmpl;
763 }
764
765 1;
|