lib/TWiki/UI/Save.pm
author Colas Nahaboo <colas@nahaboo.net>
Mon, 11 Aug 2008 20:33:37 +0200
changeset 2 7bc60a767fa4
parent 1 e2915a7cbdfa
permissions -rw-r--r--
TWiki-4.2.2 Release
     1 # Module of TWiki Enterprise Collaboration Platform, http://TWiki.org/
     2 #
     3 # Copyright (C) 1999-2007 Peter Thoeny, peter@thoeny.org
     4 # and TWiki Contributors. All Rights Reserved. TWiki Contributors
     5 # are listed in the AUTHORS file in the root of this distribution.
     6 # NOTE: Please extend that file, not this notice.
     7 #
     8 # Additional copyrights apply to some or all of the code in this
     9 # file as follows:
    10 # Based on parts of Ward Cunninghams original Wiki and JosWiki.
    11 # Copyright (C) 1998 Markus Peter - SPiN GmbH (warpi@spin.de)
    12 # Some changes by Dave Harris (drh@bhresearch.co.uk) incorporated
    13 #
    14 # This program is free software; you can redistribute it and/or
    15 # modify it under the terms of the GNU General Public License
    16 # as published by the Free Software Foundation; either version 2
    17 # of the License, or (at your option) any later version. For
    18 # more details read LICENSE in the root of this distribution.
    19 #
    20 # This program is distributed in the hope that it will be useful,
    21 # but WITHOUT ANY WARRANTY; without even the implied warranty of
    22 # MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.
    23 #
    24 # As per the GPL, removal of this notice is prohibited.
    25 
    26 =pod
    27 
    28 ---+ package TWiki::UI::Save
    29 
    30 UI delegate for save function
    31 
    32 =cut
    33 
    34 package TWiki::UI::Save;
    35 
    36 use strict;
    37 use Error qw( :try );
    38 use Assert;
    39 
    40 require TWiki;
    41 require TWiki::UI;
    42 require TWiki::Meta;
    43 require TWiki::OopsException;
    44 
    45 # Used by save and preview
    46 sub buildNewTopic {
    47     my( $session, $script ) = @_;
    48 
    49     my $query = $session->{cgiQuery};
    50     my $webName = $session->{webName};
    51     my $topic = $session->{topicName};
    52     my $store = $session->{store};
    53     my $revision = $query->param( 'rev' ) || undef;
    54 
    55     unless( scalar($query->param()) ) {
    56         # insufficient parameters to save
    57         throw TWiki::OopsException(
    58             'attention',
    59             def => 'bad_script_parameters',
    60             web => $session->{webName},
    61             topic => $session->{topicName},
    62             params => [ $script ]);
    63     }
    64 
    65     TWiki::UI::checkMirror( $session, $webName, $topic );
    66     TWiki::UI::checkWebExists( $session, $webName, $topic, 'save' );
    67 
    68     my $topicExists  = $store->topicExists( $webName, $topic );
    69 
    70     # Prevent saving existing topic?
    71     my $onlyNewTopic = TWiki::isTrue( $query->param( 'onlynewtopic' ));
    72     if( $onlyNewTopic && $topicExists ) {
    73         # Topic exists and user requested oops if it exists
    74         throw TWiki::OopsException( 'attention',
    75                                     def => 'topic_exists',
    76                                     web => $webName,
    77                                     topic => $topic );
    78     }
    79 
    80     # prevent non-Wiki names?
    81     my $onlyWikiName = TWiki::isTrue( $query->param( 'onlywikiname' ));
    82     if( ( $onlyWikiName )
    83           && ( ! $topicExists )
    84             && ( ! TWiki::isValidTopicName( $topic ) ) ) {
    85         # do not allow non-wikinames
    86         throw TWiki::OopsException(
    87             'attention',
    88             def => 'not_wikiword',
    89             web => $webName,
    90             topic => $topic,
    91             params => [ $topic ] );
    92     }
    93 
    94     my $user = $session->{user};
    95     TWiki::UI::checkAccess( $session, $webName, $topic,
    96                             'CHANGE', $user );
    97 
    98     my $saveOpts = {};
    99     $saveOpts->{minor} = 1 if $query->param( 'dontnotify' );
   100     my $originalrev = $query->param( 'originalrev' ); # rev edit started on
   101 
   102     # Populate the new meta data
   103     my $newMeta = new TWiki::Meta( $session, $webName, $topic );
   104 
   105     my ( $prevMeta, $prevText );
   106     my ( $templateText, $templateMeta );
   107     my $templatetopic = $query->param( 'templatetopic');
   108     my $templateweb = $webName;
   109 
   110     if( $topicExists ) {
   111         ( $prevMeta, $prevText ) =
   112           $store->readTopic( $user, $webName, $topic, $revision );
   113         if( $prevMeta ) {
   114             foreach my $k ( keys %$prevMeta ) {
   115                 unless( $k =~ /^_/ || $k eq 'FORM' || $k eq 'TOPICPARENT' ||
   116                           $k eq 'FIELD' ) {
   117                     $newMeta->copyFrom( $prevMeta, $k );
   118                 }
   119             }
   120         }
   121     } elsif ($templatetopic) {
   122         ( $templateweb, $templatetopic ) =
   123           $session->normalizeWebTopicName( $templateweb, $templatetopic );
   124 
   125         ( $templateMeta, $templateText ) =
   126           $store->readTopic( $user, $templateweb,
   127                              $templatetopic, $revision );
   128         $templateText = '' if $query->param( 'newtopic' ); # created by edit
   129         $templateText =
   130           $session->expandVariablesOnTopicCreation(
   131               $templateText, $user, $webName, $topic );
   132         foreach my $k ( keys %$templateMeta ) {
   133             unless( $k =~ /^_/ || $k eq 'FORM' || $k eq 'TOPICPARENT' ||
   134                       $k eq 'FIELD' || $k eq 'TOPICMOVED' ) {
   135                 $newMeta->copyFrom( $templateMeta, $k );
   136             }
   137         }
   138         # topic creation, there is no original rev
   139         $originalrev = 0;
   140     }
   141 
   142     # Determine the new text
   143     my $newText = $query->param( 'text' );
   144 
   145     my $forceNewRev = $query->param( 'forcenewrevision' );
   146     $saveOpts->{forcenewrevision} = $forceNewRev;
   147     my $newParent = $query->param( 'topicparent' );
   148 
   149     if( defined( $newText) ) {
   150         # text is defined in the query, save that text
   151         $newText =~ s/\r//g;
   152         $newText .= "\n" unless $newText =~ /\n$/s;
   153 
   154     } elsif( defined $templateText ) {
   155         # no text in the query, but we have a templatetopic
   156         $newText = $templateText;
   157         $originalrev = 0; # disable merge
   158 
   159     } else {
   160         $newText = '';
   161         if( defined $prevText ) {
   162             $newText = $prevText;
   163             $originalrev = 0; # disable merge
   164         }
   165     }
   166 
   167     my $mum;
   168     if( $newParent ) {
   169         if( $newParent ne 'none' ) {
   170             $mum = { 'name' => $newParent };
   171         }
   172     } elsif( $templateMeta ) {
   173         $mum = $templateMeta->get( 'TOPICPARENT' );
   174     } elsif( $prevMeta ) {
   175         $mum = $prevMeta->get( 'TOPICPARENT' );
   176     }
   177     $newMeta->put( 'TOPICPARENT', $mum ) if $mum;
   178 
   179     my $formName = $query->param( 'formtemplate' );
   180     my $formDef;
   181     my $copyMeta;
   182 
   183     if( $formName ) {
   184         # new form, default field values will be null
   185         $formName = '' if( $formName eq 'none' );
   186     } elsif( $templateMeta ) {
   187         # populate the meta-data with field values from the template
   188         $formName = $templateMeta->get( 'FORM' );
   189         $formName = $formName->{name} if $formName;;
   190         $copyMeta = $templateMeta;
   191     } elsif( $prevMeta ) {
   192         # populate the meta-data with field values from the existing topic
   193         $formName = $prevMeta->get( 'FORM' );
   194         $formName = $formName->{name} if $formName;;
   195         $copyMeta = $prevMeta;
   196     }
   197 
   198     if( $formName ) {
   199         require TWiki::Form;
   200         $formDef = new TWiki::Form( $session, $webName, $formName );
   201         unless( $formDef ) {
   202             throw TWiki::OopsException(
   203                 'attention',
   204                 def => 'no_form_def',
   205                 web => $session->{webName},
   206                 topic => $session->{topicName},
   207                 params => [ $webName, $formName ] );
   208         }
   209         $newMeta->put( 'FORM', { name => $formName });
   210     }
   211     if( $copyMeta && $formDef ) {
   212         # Copy existing fields into new form, filtering on the
   213         # known field names so we don't copy dead data. Though we
   214         # really should, of course. That comes later.
   215         my $filter = join(
   216             '|',
   217             map { $_->{name} }
   218               grep { $_->{name} } @{$formDef->getFields()} );
   219         $newMeta->copyFrom( $copyMeta, 'FIELD', qr/^($filter)$/ );
   220     }
   221     if( $formDef ) {
   222         # override with values from the query
   223         my( $seen, $missing ) =
   224           $formDef->getFieldValuesFromQuery( $query, $newMeta );
   225         if( $seen && @$missing ) {
   226             # chuck up if there is at least one field value defined in the
   227             # query and a mandatory field was not defined in the
   228             # query or by an existing value.
   229 	    # Item5428: clean up <nop>'s
   230 	    @$missing = map {
   231 	    			s/<nop>//g;
   232 				$_
   233 	    			} @$missing;
   234             throw TWiki::OopsException(
   235                 'attention',
   236                 def=>'mandatory_field',
   237                 web => $session->{webName},
   238                 topic => $session->{topicName},
   239                 params => [ join( ' ', @$missing ) ] );
   240         }
   241     }
   242 
   243     my $merged;
   244     # assumes rev numbers start at 1
   245     if( $originalrev ) {
   246         my( $orev, $odate );
   247         if( $originalrev =~ /^(\d+)_(\d+)$/ ) {
   248             ( $orev, $odate ) = ( $1, $2 );
   249         } elsif( $originalrev =~ /^\d+$/ ) {
   250             $orev = $originalrev;
   251         } else {
   252             $orev = 0;
   253         }
   254         my( $date, $author, $rev, $comment ) = $newMeta->getRevisionInfo();
   255         # If the last save was by me, don't merge
   256         if(( $orev ne $rev ||
   257                $odate && $date && $odate ne $date ) &&
   258                  $author ne $user ) {
   259 
   260             require TWiki::Merge;
   261 
   262             my $pti = $prevMeta->get( 'TOPICINFO' );
   263             if( $pti->{reprev} && $pti->{version} &&
   264                   $pti->{reprev} == $pti->{version} ) {
   265                 # If the ancestor revision was generated by a reprev,
   266                 # then the original is lost and we can't 3-way merge
   267 
   268                 $session->{plugins}->_dispatch(
   269                     'beforeMergeHandler',
   270                     $newText,
   271                     $pti->{version}, $prevText,
   272                     undef, undef,
   273                     $webName, $topic);
   274 
   275                 $newText = TWiki::Merge::merge2(
   276                     $pti->{version}, $prevText,
   277                     $rev, $newText,
   278                     '.*?\n',
   279                     $session );
   280             } else {
   281                 # common ancestor; we can 3-way merge
   282                 my( $ancestorMeta, $ancestorText ) =
   283                   $store->readTopic( undef, $webName, $topic, $orev );
   284 
   285                 $session->{plugins}->_dispatch(
   286                     'beforeMergeHandler',
   287                     $newText,
   288                     $rev, $prevText,
   289                     $orev, $ancestorText,
   290                     $webName, $topic);
   291 
   292                 $newText = TWiki::Merge::merge3(
   293                     $orev, $ancestorText,
   294                     $rev, $prevText,
   295                     'new', $newText,
   296                     '.*?\n', $session );
   297             }
   298             if( $formDef && $prevMeta ) {
   299                 $newMeta->merge( $prevMeta, $formDef );
   300             }
   301             $merged = [ $orev, $session->{users}->getWikiName($author), $rev||1 ];
   302         }
   303     }
   304 
   305     return( $newMeta, $newText, $saveOpts, $merged );
   306 }
   307 
   308 =pod
   309 
   310 ---++ StaticMethod save($session)
   311 
   312 Command handler for =save= command.
   313 This method is designed to be
   314 invoked via the =UI::run= method.
   315 
   316 See TWiki.TWikiScripts for details of parameters.
   317 
   318 Note: =cmd= has been deprecated in favour of =action=. It will be deleted at
   319 some point.
   320 
   321 =cut
   322 
   323 sub save {
   324     my $session = shift;
   325 
   326     my $query = $session->{cgiQuery};
   327     my $web = $session->{webName};
   328     my $topic = $session->{topicName};
   329     my $store = $session->{store};
   330     my $user = $session->{user};
   331 
   332     # Do not remove, keep as undocumented feature for compatibility with
   333     # TWiki 4.0.x: Allow for dynamic topic creation by replacing strings
   334     # of at least 10 x's XXXXXX with a next-in-sequence number.
   335     # See Codev.AllowDynamicTopicNameCreation
   336     if ( $topic =~ /X{10}/ ) {
   337 		my $n = 0;
   338 		my $baseTopic = $topic;
   339 		$store->clearLease( $web, $baseTopic );
   340 		do {
   341 			$topic = $baseTopic;
   342 			$topic =~ s/X{10}X*/$n/e;
   343 			$n++;
   344 		} while( $store->topicExists( $web, $topic ));
   345         $session->{topicName} = $topic;
   346     }
   347 
   348     # Allow for more flexible topic creation with sortable names and
   349     # better performance. See Codev.AutoIncTopicNameOnSave
   350     if( $topic =~ /AUTOINC([0-9]+)/ ) {
   351         my $start = $1;
   352         my $baseTopic = $topic;
   353         $store->clearLease( $web, $baseTopic );
   354         my $nameFilter = $topic;
   355         $nameFilter =~ s/AUTOINC([0-9]+)/([0-9]+)/;
   356         my @list =
   357           sort{ $a <=> $b }
   358             map{ s/^$nameFilter$/$1/; s/^0*([0-9])/$1/; $_ }
   359               grep{ /^$nameFilter$/ }
   360                 $store->getTopicNames( $web );
   361         if( scalar @list ) {
   362             # find last one, and increment by one
   363             my $next = $list[$#list] + 1;
   364             my $len = length( $start );
   365             $start =~ s/^0*([0-9])/$1/; # cut leading zeros
   366             $next = $start if( $start > $next );
   367             my $pad =  $len - length($next);
   368             if( $pad > 0 ) {
   369                 $next = '0' x $pad . $next; # zero-pad
   370             }
   371             $topic =~ s/AUTOINC[0-9]+/$next/;
   372         } else {
   373             # first auto-inc topic
   374             $topic =~ s/AUTOINC[0-9]+/$start/;
   375         }
   376         $session->{topicName} = $topic;
   377     }
   378 
   379     my $saveaction = '';
   380     foreach my $action qw( save checkpoint quietsave cancel preview
   381                            addform replaceform delRev repRev ) {
   382         if ($query->param('action_' . $action)) {
   383             $saveaction = $action;
   384             last;
   385         }
   386     }
   387 
   388     # the 'action' parameter has been deprecated, though is still available
   389     # for compatibility with old templates.
   390     if( !$saveaction && $query->param( 'action' )) {
   391         $saveaction = lc($query->param( 'action' ));
   392         $session->writeWarning(<<WARN);
   393 Use of deprecated "action" parameter to "save". Correct your templates!
   394 WARN
   395 
   396         # handle old values for form-related actions:
   397         $saveaction = 'addform' if ( $saveaction eq 'add form');
   398         $saveaction = 'replaceform' if ( $saveaction eq 'replace form...');
   399     }
   400 
   401     if( $saveaction eq 'cancel' ) {
   402         my $lease = $store->getLease( $web, $topic );
   403         if( $lease && $lease->{user} eq $user ) {
   404             $store->clearLease( $web, $topic );
   405         }
   406 
   407         # redirect to a sensible place (a topic that exists)
   408         my( $w, $t ) = ( '', '' );
   409         foreach my $test ( $topic,
   410                            $query->param( 'topicparent' ),
   411                            $TWiki::cfg{HomeTopicName} ) {
   412             ( $w, $t ) =
   413               $session->normalizeWebTopicName( $web, $test );
   414             last if( $store->topicExists( $w, $t ));
   415         }
   416         my $viewURL = $session->getScriptUrl( 1, 'view', $w, $t );
   417         $session->redirect( $viewURL, undef, 1 );
   418 
   419         return;
   420     }
   421 
   422     if( $saveaction eq 'preview' ) {
   423         require TWiki::UI::Preview;
   424         TWiki::UI::Preview::preview( $session );
   425         return;
   426     }
   427 
   428     my $editaction = lc($query->param( 'editaction' )) || '';
   429     my $edit = $query->param( 'edit' ) || 'edit';
   430     my $editparams = $query->param( 'editparams' ) || '';
   431 
   432     ## SMELL: The form affecting actions do not preserve edit and editparams
   433     if( $saveaction eq 'addform' ||
   434           $saveaction eq 'replaceform' ||
   435             $saveaction eq 'preview' && $query->param( 'submitChangeForm' )) {
   436         require TWiki::UI::ChangeForm;
   437         $session->writeCompletePage
   438           ( TWiki::UI::ChangeForm::generate( $session, $web,
   439                                              $topic, $editaction ) );
   440         return;
   441     }
   442 
   443     my $redirecturl;
   444 
   445     if( $saveaction eq 'checkpoint' ) {
   446         $query->param( -name=>'dontnotify', -value=>'checked' );
   447         my $editURL = $session->getScriptUrl( 1, $edit, $web, $topic );
   448         $redirecturl = $editURL.'?t='.time();
   449         $redirecturl .= '&redirectto='.$query->param( 'redirectto' )
   450           if $query->param( 'redirectto' );
   451         # select the appropriate edit template
   452         $redirecturl .= '&action='.$editaction if $editaction;
   453         $redirecturl .= '&skin='.$query->param('skin')
   454           if $query->param('skin');
   455         $redirecturl .= '&cover='.$query->param('cover')
   456           if $query->param('cover');
   457         $redirecturl .= '&nowysiwyg='.$query->param('nowysiwyg')
   458           if $query->param('nowysiwyg');
   459         $redirecturl .= $editparams
   460           if $editparams;  # May contain anchor
   461         my $lease = $store->getLease( $web, $topic );
   462         if( $lease && $lease->{user} eq $user ) {
   463             $store->setLease( $web, $topic, $user, $TWiki::cfg{LeaseLength} );
   464         }
   465         # drop through
   466     }
   467 
   468     if( $saveaction eq 'quietsave' ) {
   469         $query->param( -name=>'dontnotify', -value=>'checked' );
   470         $saveaction = 'save';
   471         # drop through
   472     }
   473 
   474     if( $saveaction =~ /^(del|rep)Rev$/ ) {
   475         # hidden, largely undocumented functions, used by administrators for
   476         # reverting spammed topics. These functions support rewriting
   477         # history, in a Joe Stalin kind of way. They should be replaced with
   478         # mechanisms for hiding revisions.
   479         $query->param( -name => 'cmd', -value => $saveaction );
   480         # drop through
   481     }
   482 
   483     my $saveCmd = $query->param( 'cmd' ) || 0;
   484     if ( $saveCmd && ! $session->{users}->isAdmin( $session->{user} )) {
   485         throw TWiki::OopsException(
   486             'accessdenied',
   487             def => 'only_group',
   488             web => $web, topic => $topic,
   489             params => [ $TWiki::cfg{SuperAdminGroup} ] );
   490     }
   491 
   492     #success - redirect to topic view (unless its a checkpoint save)
   493     $redirecturl ||= $session->getScriptUrl( 1, 'view', $web, $topic );
   494 
   495     if( $saveCmd eq 'delRev' ) {
   496         # delete top revision
   497         try {
   498             $store->delRev( $user, $web, $topic );
   499         } catch Error::Simple with {
   500             throw TWiki::OopsException(
   501                 'attention',
   502                 def => 'save_error',
   503                 web => $web,
   504                 topic => $topic,
   505                 params => [ shift->{-text} ]);
   506         };
   507 
   508         $session->redirect( $redirecturl, undef, 1 );
   509         return;
   510     }
   511 
   512     if( $saveCmd eq 'repRev' ) {
   513         # replace top revision with the text from the query, trying to
   514         # make it look as much like the original as possible. The query
   515         # text is expected to contain %META as well as text.
   516         my $meta = new TWiki::Meta( $session, $web, $topic,
   517                                     $query->param( 'text' ));
   518         my $saveOpts = {
   519             timetravel => 1,
   520             operation => 'cmd',
   521            };
   522         try {
   523             $store->repRev( $user, $web, $topic,
   524                             $meta->text(), $meta, $saveOpts );
   525         } catch Error::Simple with {
   526             throw TWiki::OopsException(
   527                 'attention',
   528                 def => 'save_error',
   529                 web => $web,
   530                 topic => $topic,
   531                 params => [ shift->{-text} ] );
   532         };
   533 
   534         $session->redirect( $redirecturl, undef, ( $saveaction ne 'checkpoint' ) );
   535         return;
   536     }
   537 
   538     my( $newMeta, $newText, $saveOpts, $merged ) =
   539       buildNewTopic($session, 'save');
   540 
   541     if( $saveaction =~ /^(save|checkpoint)$/ ) {
   542         $session->{plugins}->afterEditHandler( $newText, $topic, $web, $newMeta );
   543     }
   544 
   545     try {
   546         $store->saveTopic( $user, $web, $topic,
   547                            $newText, $newMeta, $saveOpts );
   548     } catch Error::Simple with {
   549         throw TWiki::OopsException(
   550             'attention',
   551             def => 'save_error',
   552             web => $web,
   553             topic => $topic,
   554             params => [ shift->{-text} ] );
   555     };
   556 
   557     my $lease = $store->getLease( $web, $topic );
   558     # clear the lease, if (and only if) we own it
   559     if( $lease && $lease->{user} eq $user ) {
   560         $store->clearLease( $web, $topic );
   561     }
   562 
   563     if( $merged ) {
   564         throw TWiki::OopsException(
   565             'attention',
   566             def => 'merge_notice',
   567             web => $web, topic => $topic,
   568             params => $merged );
   569     }
   570 
   571     $session->redirect( $redirecturl, undef, ( $saveaction ne 'checkpoint' ) );
   572 }
   573 
   574 1;