(file) Return to Manage.pm CVS log (file) (dir) Up to [RizwankCVS] / geekymedia_web / twiki / lib / TWiki / UI

  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;

Rizwan Kassim
Powered by
ViewCVS 0.9.2