twiki-colas/42-distrib: lib/TWiki/UI/Save.pm@414e01d06fd5

     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.

    26 =pod

    28 ---+ package TWiki::UI::Save

    30 UI delegate for save function

    32 =cut

    34 package TWiki::UI::Save;

    36 use strict;

    37 use Error qw( :try );

    38 use Assert;

    40 require TWiki;

    41 require TWiki::UI;

    42 require TWiki::Meta;

    43 require TWiki::OopsException;

    45 # Used by save and preview

    46 sub buildNewTopic {

    47     my( $session, $script ) = @_;

    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;

    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     }

    65     TWiki::UI::checkMirror( $session, $webName, $topic );

    66     TWiki::UI::checkWebExists( $session, $webName, $topic, 'save' );

    68     my $topicExists  = $store->topicExists( $webName, $topic );

    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     }

    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     }

    94     my $user = $session->{user};

    95     TWiki::UI::checkAccess( $session, $webName, $topic,

    96                             'CHANGE', $user );

    98     my $saveOpts = {};

    99     $saveOpts->{minor} = 1 if $query->param( 'dontnotify' );

   100     my $originalrev = $query->param( 'originalrev' ); # rev edit started on

   102     # Populate the new meta data

   103     my $newMeta = new TWiki::Meta( $session, $webName, $topic );

   105     my ( $prevMeta, $prevText );

   106     my ( $templateText, $templateMeta );

   107     my $templatetopic = $query->param( 'templatetopic');

   108     my $templateweb = $webName;

   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 );

   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     }

   142     # Determine the new text

   143     my $newText = $query->param( 'text' );

   145     my $forceNewRev = $query->param( 'forcenewrevision' );

   146     $saveOpts->{forcenewrevision} = $forceNewRev;

   147     my $newParent = $query->param( 'topicparent' );

   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;

   154     } elsif( defined $templateText ) {

   155         # no text in the query, but we have a templatetopic

   156         $newText = $templateText;

   157         $originalrev = 0; # disable merge

   159     } else {

   160         $newText = '';

   161         if( defined $prevText ) {

   162             $newText = $prevText;

   163             $originalrev = 0; # disable merge

   164         }

   165     }

   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;

   179     my $formName = $query->param( 'formtemplate' );

   180     my $formDef;

   181     my $copyMeta;

   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     }

   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     }

   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 ) {

   255             require TWiki::Merge;

   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

   263                 $session->{plugins}->_dispatch(

   264                     'beforeMergeHandler',

   265                     $newText,

   266                     $pti->{version}, $prevText,

   267                     undef, undef,

   268                     $webName, $topic);

   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 );

   280                 $session->{plugins}->_dispatch(

   281                     'beforeMergeHandler',

   282                     $newText,

   283                     $rev, $prevText,

   284                     $orev, $ancestorText,

   285                     $webName, $topic);

   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     }

   300     return( $newMeta, $newText, $saveOpts, $merged );

   301 }

   303 =pod

   305 ---++ StaticMethod save($session)

   307 Command handler for =save= command.

   308 This method is designed to be

   309 invoked via the =UI::run= method.

   311 See TWiki.TWikiScripts for details of parameters.

   313 Note: =cmd= has been deprecated in favour of =action=. It will be deleted at

   314 some point.

   316 =cut

   318 sub save {

   319     my $session = shift;

   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};

   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     }

   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     }

   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     }

   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

   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     }

   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         }

   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 );

   414         return;

   415     }

   417     if( $saveaction eq 'preview' ) {

   418         require TWiki::UI::Preview;

   419         TWiki::UI::Preview::preview( $session );

   420         return;

   421     }

   423     my $editaction = lc($query->param( 'editaction' )) || '';

   424     my $edit = $query->param( 'edit' ) || 'edit';

   425     my $editparams = $query->param( 'editparams' ) || '';

   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     }

   438     my $redirecturl;

   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     }

   463     if( $saveaction eq 'quietsave' ) {

   464         $query->param( -name=>'dontnotify', -value=>'checked' );

   465         $saveaction = 'save';

   466         # drop through

   467     }

   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     }

   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     }

   487     #success - redirect to topic view (unless its a checkpoint save)

   488     $redirecturl ||= $session->getScriptUrl( 1, 'view', $web, $topic );

   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         };

   503         $session->redirect( $redirecturl, undef, 1 );

   504         return;

   505     }

   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         };

   529         $session->redirect( $redirecturl, undef, ( $saveaction ne 'checkpoint' ) );

   530         return;

   531     }

   533     my( $newMeta, $newText, $saveOpts, $merged ) =

   534       buildNewTopic($session, 'save');

   536     if( $saveaction =~ /^(save|checkpoint)$/ ) {

   537         $session->{plugins}->afterEditHandler( $newText, $topic, $web, $newMeta );

   538     }

   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     };

   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     }

   558     if( $merged ) {

   559         throw TWiki::OopsException(

   560             'attention',

   561             def => 'merge_notice',

   562             web => $web, topic => $topic,

   563             params => $merged );

   564     }

   566     $session->redirect( $redirecturl, undef, ( $saveaction ne 'checkpoint' ) );

   567 }

   569 1;

author	Colas Nahaboo <colas@nahaboo.net>
	Sat, 26 Jan 2008 15:50:53 +0100
changeset 0	414e01d06fd5
child 1	e2915a7cbdfa
permissions	-rw-r--r--