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