lib/TWiki/UI/Save.pm
author Colas Nahaboo <colas@nahaboo.net>
Sat, 26 Jan 2008 15:50:53 +0100
changeset 0 414e01d06fd5
child 1 e2915a7cbdfa
permissions -rw-r--r--
RELEASE 4.2.0 freetown
     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             throw TWiki::OopsException(
   230                 'attention',
   231                 def=>'mandatory_field',
   232                 web => $session->{webName},
   233                 topic => $session->{topicName},
   234                 params => [ join( ' ', @$missing ) ] );
   235         }
   236     }
   237 
   238     my $merged;
   239     # assumes rev numbers start at 1
   240     if( $originalrev ) {
   241         my( $orev, $odate );
   242         if( $originalrev =~ /^(\d+)_(\d+)$/ ) {
   243             ( $orev, $odate ) = ( $1, $2 );
   244         } elsif( $originalrev =~ /^\d+$/ ) {
   245             $orev = $originalrev;
   246         } else {
   247             $orev = 0;
   248         }
   249         my( $date, $author, $rev, $comment ) = $newMeta->getRevisionInfo();
   250         # If the last save was by me, don't merge
   251         if(( $orev ne $rev ||
   252                $odate && $date && $odate ne $date ) &&
   253                  $author ne $user ) {
   254 
   255             require TWiki::Merge;
   256 
   257             my $pti = $prevMeta->get( 'TOPICINFO' );
   258             if( $pti->{reprev} && $pti->{version} &&
   259                   $pti->{reprev} == $pti->{version} ) {
   260                 # If the ancestor revision was generated by a reprev,
   261                 # then the original is lost and we can't 3-way merge
   262 
   263                 $session->{plugins}->_dispatch(
   264                     'beforeMergeHandler',
   265                     $newText,
   266                     $pti->{version}, $prevText,
   267                     undef, undef,
   268                     $webName, $topic);
   269 
   270                 $newText = TWiki::Merge::merge2(
   271                     $pti->{version}, $prevText,
   272                     $rev, $newText,
   273                     '.*?\n',
   274                     $session );
   275             } else {
   276                 # common ancestor; we can 3-way merge
   277                 my( $ancestorMeta, $ancestorText ) =
   278                   $store->readTopic( undef, $webName, $topic, $orev );
   279 
   280                 $session->{plugins}->_dispatch(
   281                     'beforeMergeHandler',
   282                     $newText,
   283                     $rev, $prevText,
   284                     $orev, $ancestorText,
   285                     $webName, $topic);
   286 
   287                 $newText = TWiki::Merge::merge3(
   288                     $orev, $ancestorText,
   289                     $rev, $prevText,
   290                     'new', $newText,
   291                     '.*?\n', $session );
   292             }
   293             if( $formDef && $prevMeta ) {
   294                 $newMeta->merge( $prevMeta, $formDef );
   295             }
   296             $merged = [ $orev, $author, $rev||1 ];
   297         }
   298     }
   299 
   300     return( $newMeta, $newText, $saveOpts, $merged );
   301 }
   302 
   303 =pod
   304 
   305 ---++ StaticMethod save($session)
   306 
   307 Command handler for =save= command.
   308 This method is designed to be
   309 invoked via the =UI::run= method.
   310 
   311 See TWiki.TWikiScripts for details of parameters.
   312 
   313 Note: =cmd= has been deprecated in favour of =action=. It will be deleted at
   314 some point.
   315 
   316 =cut
   317 
   318 sub save {
   319     my $session = shift;
   320 
   321     my $query = $session->{cgiQuery};
   322     my $web = $session->{webName};
   323     my $topic = $session->{topicName};
   324     my $store = $session->{store};
   325     my $user = $session->{user};
   326 
   327     # Do not remove, keep as undocumented feature for compatibility with
   328     # TWiki 4.0.x: Allow for dynamic topic creation by replacing strings
   329     # of at least 10 x's XXXXXX with a next-in-sequence number.
   330     # See Codev.AllowDynamicTopicNameCreation
   331     if ( $topic =~ /X{10}/ ) {
   332 		my $n = 0;
   333 		my $baseTopic = $topic;
   334 		$store->clearLease( $web, $baseTopic );
   335 		do {
   336 			$topic = $baseTopic;
   337 			$topic =~ s/X{10}X*/$n/e;
   338 			$n++;
   339 		} while( $store->topicExists( $web, $topic ));
   340         $session->{topicName} = $topic;
   341     }
   342 
   343     # Allow for more flexible topic creation with sortable names and
   344     # better performance. See Codev.AutoIncTopicNameOnSave
   345     if( $topic =~ /AUTOINC([0-9]+)/ ) {
   346         my $start = $1;
   347         my $baseTopic = $topic;
   348         $store->clearLease( $web, $baseTopic );
   349         my $nameFilter = $topic;
   350         $nameFilter =~ s/AUTOINC([0-9]+)/([0-9]+)/;
   351         my @list =
   352           sort{ $a <=> $b }
   353             map{ s/^$nameFilter$/$1/; s/^0*([0-9])/$1/; $_ }
   354               grep{ /^$nameFilter$/ }
   355                 $store->getTopicNames( $web );
   356         if( scalar @list ) {
   357             # find last one, and increment by one
   358             my $next = $list[$#list] + 1;
   359             my $len = length( $start );
   360             $start =~ s/^0*([0-9])/$1/; # cut leading zeros
   361             $next = $start if( $start > $next );
   362             my $pad =  $len - length($next);
   363             if( $pad > 0 ) {
   364                 $next = '0' x $pad . $next; # zero-pad
   365             }
   366             $topic =~ s/AUTOINC[0-9]+/$next/;
   367         } else {
   368             # first auto-inc topic
   369             $topic =~ s/AUTOINC[0-9]+/$start/;
   370         }
   371         $session->{topicName} = $topic;
   372     }
   373 
   374     my $saveaction = '';
   375     foreach my $action qw( save checkpoint quietsave cancel preview
   376                            addform replaceform delRev repRev ) {
   377         if ($query->param('action_' . $action)) {
   378             $saveaction = $action;
   379             last;
   380         }
   381     }
   382 
   383     # the 'action' parameter has been deprecated, though is still available
   384     # for compatibility with old templates.
   385     if( !$saveaction && $query->param( 'action' )) {
   386         $saveaction = lc($query->param( 'action' ));
   387         $session->writeWarning(<<WARN);
   388 Use of deprecated "action" parameter to "save". Correct your templates!
   389 WARN
   390 
   391         # handle old values for form-related actions:
   392         $saveaction = 'addform' if ( $saveaction eq 'add form');
   393         $saveaction = 'replaceform' if ( $saveaction eq 'replace form...');
   394     }
   395 
   396     if( $saveaction eq 'cancel' ) {
   397         my $lease = $store->getLease( $web, $topic );
   398         if( $lease && $lease->{user} eq $user ) {
   399             $store->clearLease( $web, $topic );
   400         }
   401 
   402         # redirect to a sensible place (a topic that exists)
   403         my( $w, $t ) = ( '', '' );
   404         foreach my $test ( $topic,
   405                            $query->param( 'topicparent' ),
   406                            $TWiki::cfg{HomeTopicName} ) {
   407             ( $w, $t ) =
   408               $session->normalizeWebTopicName( $web, $test );
   409             last if( $store->topicExists( $w, $t ));
   410         }
   411         my $viewURL = $session->getScriptUrl( 1, 'view', $w, $t );
   412         $session->redirect( $viewURL, undef, 1 );
   413 
   414         return;
   415     }
   416 
   417     if( $saveaction eq 'preview' ) {
   418         require TWiki::UI::Preview;
   419         TWiki::UI::Preview::preview( $session );
   420         return;
   421     }
   422 
   423     my $editaction = lc($query->param( 'editaction' )) || '';
   424     my $edit = $query->param( 'edit' ) || 'edit';
   425     my $editparams = $query->param( 'editparams' ) || '';
   426 
   427     ## SMELL: The form affecting actions do not preserve edit and editparams
   428     if( $saveaction eq 'addform' ||
   429           $saveaction eq 'replaceform' ||
   430             $saveaction eq 'preview' && $query->param( 'submitChangeForm' )) {
   431         require TWiki::UI::ChangeForm;
   432         $session->writeCompletePage
   433           ( TWiki::UI::ChangeForm::generate( $session, $web,
   434                                              $topic, $editaction ) );
   435         return;
   436     }
   437 
   438     my $redirecturl;
   439 
   440     if( $saveaction eq 'checkpoint' ) {
   441         $query->param( -name=>'dontnotify', -value=>'checked' );
   442         my $editURL = $session->getScriptUrl( 1, $edit, $web, $topic );
   443         $redirecturl = $editURL.'?t='.time();
   444         $redirecturl .= '&redirectto='.$query->param( 'redirectto' )
   445           if $query->param( 'redirectto' );
   446         # select the appropriate edit template
   447         $redirecturl .= '&action='.$editaction if $editaction;
   448         $redirecturl .= '&skin='.$query->param('skin')
   449           if $query->param('skin');
   450         $redirecturl .= '&cover='.$query->param('cover')
   451           if $query->param('cover');
   452         $redirecturl .= '&nowysiwyg='.$query->param('nowysiwyg')
   453           if $query->param('nowysiwyg');
   454         $redirecturl .= $editparams
   455           if $editparams;  # May contain anchor
   456         my $lease = $store->getLease( $web, $topic );
   457         if( $lease && $lease->{user} eq $user ) {
   458             $store->setLease( $web, $topic, $user, $TWiki::cfg{LeaseLength} );
   459         }
   460         # drop through
   461     }
   462 
   463     if( $saveaction eq 'quietsave' ) {
   464         $query->param( -name=>'dontnotify', -value=>'checked' );
   465         $saveaction = 'save';
   466         # drop through
   467     }
   468 
   469     if( $saveaction =~ /^(del|rep)Rev$/ ) {
   470         # hidden, largely undocumented functions, used by administrators for
   471         # reverting spammed topics. These functions support rewriting
   472         # history, in a Joe Stalin kind of way. They should be replaced with
   473         # mechanisms for hiding revisions.
   474         $query->param( -name => 'cmd', -value => $saveaction );
   475         # drop through
   476     }
   477 
   478     my $saveCmd = $query->param( 'cmd' ) || 0;
   479     if ( $saveCmd && ! $session->{users}->isAdmin( $session->{user} )) {
   480         throw TWiki::OopsException(
   481             'accessdenied',
   482             def => 'only_group',
   483             web => $web, topic => $topic,
   484             params => [ $TWiki::cfg{SuperAdminGroup} ] );
   485     }
   486 
   487     #success - redirect to topic view (unless its a checkpoint save)
   488     $redirecturl ||= $session->getScriptUrl( 1, 'view', $web, $topic );
   489 
   490     if( $saveCmd eq 'delRev' ) {
   491         # delete top revision
   492         try {
   493             $store->delRev( $user, $web, $topic );
   494         } catch Error::Simple with {
   495             throw TWiki::OopsException(
   496                 'attention',
   497                 def => 'save_error',
   498                 web => $web,
   499                 topic => $topic,
   500                 params => [ shift->{-text} ]);
   501         };
   502 
   503         $session->redirect( $redirecturl, undef, 1 );
   504         return;
   505     }
   506 
   507     if( $saveCmd eq 'repRev' ) {
   508         # replace top revision with the text from the query, trying to
   509         # make it look as much like the original as possible. The query
   510         # text is expected to contain %META as well as text.
   511         my $meta = new TWiki::Meta( $session, $web, $topic,
   512                                     $query->param( 'text' ));
   513         my $saveOpts = {
   514             timetravel => 1,
   515             operation => 'cmd',
   516            };
   517         try {
   518             $store->repRev( $user, $web, $topic,
   519                             $meta->text(), $meta, $saveOpts );
   520         } catch Error::Simple with {
   521             throw TWiki::OopsException(
   522                 'attention',
   523                 def => 'save_error',
   524                 web => $web,
   525                 topic => $topic,
   526                 params => [ shift->{-text} ] );
   527         };
   528 
   529         $session->redirect( $redirecturl, undef, ( $saveaction ne 'checkpoint' ) );
   530         return;
   531     }
   532 
   533     my( $newMeta, $newText, $saveOpts, $merged ) =
   534       buildNewTopic($session, 'save');
   535 
   536     if( $saveaction =~ /^(save|checkpoint)$/ ) {
   537         $session->{plugins}->afterEditHandler( $newText, $topic, $web, $newMeta );
   538     }
   539 
   540     try {
   541         $store->saveTopic( $user, $web, $topic,
   542                            $newText, $newMeta, $saveOpts );
   543     } catch Error::Simple with {
   544         throw TWiki::OopsException(
   545             'attention',
   546             def => 'save_error',
   547             web => $web,
   548             topic => $topic,
   549             params => [ shift->{-text} ] );
   550     };
   551 
   552     my $lease = $store->getLease( $web, $topic );
   553     # clear the lease, if (and only if) we own it
   554     if( $lease && $lease->{user} eq $user ) {
   555         $store->clearLease( $web, $topic );
   556     }
   557 
   558     if( $merged ) {
   559         throw TWiki::OopsException(
   560             'attention',
   561             def => 'merge_notice',
   562             web => $web, topic => $topic,
   563             params => $merged );
   564     }
   565 
   566     $session->redirect( $redirecturl, undef, ( $saveaction ne 'checkpoint' ) );
   567 }
   568 
   569 1;