# Module of TWiki Enterprise Collaboration Platform, http://TWiki.org/
#
# Copyright (C) 1999-2018 Peter Thoeny, peter[at]thoeny.org
# and TWiki Contributors. All Rights Reserved. TWiki Contributors
# are listed in the AUTHORS file in the root of this distribution.
# NOTE: Please extend that file, not this notice.
#
# Additional copyrights apply to some or all of the code in this
# file as follows:
# Based on parts of Ward Cunninghams original Wiki and JosWiki.
# Copyright (C) 1998 Markus Peter - SPiN GmbH (warpi@spin.de)
# Some changes by Dave Harris (drh@bhresearch.co.uk) incorporated
#
# This program is free software; you can redistribute it and/or
# modify it under the terms of the GNU General Public License
# as published by the Free Software Foundation; either version 3
# of the License, or (at your option) any later version. For
# more details read LICENSE in the root of this distribution.
#
# This program is distributed in the hope that it will be useful,
# but WITHOUT ANY WARRANTY; without even the implied warranty of
# MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.
#
# As per the GPL, removal of this notice is prohibited.

=pod

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

UI delegate for save function

=cut

package TWiki::UI::Save;

use strict;
use Error qw( :try );
use Assert;

require TWiki;
require TWiki::UI;
require TWiki::Meta;
require TWiki::OopsException;

# Used by save and preview
sub buildNewTopic {
    my( $session, $script ) = @_;

    my $query = $session->{request};
    my $webName = $session->{webName};
    my $topic = $session->{topicName};
    my $store = $session->{store};
    my $revision = $query->param( 'rev' ) || undef;
    my $reqmethod = $query->request_method();

    if( $reqmethod && $reqmethod !~ /^POST$/i ) {
        # save can only be called via POST method or command line
        throw TWiki::OopsException(
            'attention',
            def => 'post_method_only',
            web => $session->{webName},
            topic => $session->{topicName},
            status => '405 Method Not Allowed',
            params => [ $script ]);
    }

    #$action in this block/subroutine is used only for verification
    #of crypttoken
    my $cryptaction = 'save';
    my %secureActions;
    map { $secureActions{ lc($_) } = 1; }
      split( /[\s,]+/, $TWiki::cfg{CryptToken}{SecureActions} );


    #If Crypt Token is requred for save action, one should not be able
    #go beyond following step without valid crypttokens.

    if (   $TWiki::cfg{CryptToken}{Enable}
        && $secureActions{ lc($cryptaction) } )
    {

        TWiki::UI::verifyCryptToken( $session, $query->param('crypttoken') );
    }

    
    unless( scalar($query->param()) ) {
        # insufficient parameters to save
        throw TWiki::OopsException(
            'attention',
            def => 'bad_script_parameters',
            web => $session->{webName},
            topic => $session->{topicName},
            params => [ $script ]);
    }

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

    my $topicExists = $store->topicExists( $webName, $topic );
    if ( !$topicExists && $store->webExists( $webName.'/'.$topic ) ) {
        throw TWiki::OopsException(
            'attention',
            def => 'web_exists_topic_save',
            web => $webName,
            topic => $topic );
    }


    # Prevent saving existing topic?
    my $onlyNewTopic = TWiki::isTrue( $query->param( 'onlynewtopic' ));
    if( $onlyNewTopic && $topicExists ) {
        # Topic exists and user requested oops if it exists
        throw TWiki::OopsException( 'attention',
                                    def => 'topic_exists',
                                    web => $webName,
                                    topic => $topic );
    }

    # prevent non-Wiki names?
    my $onlyWikiName = TWiki::isTrue( $query->param( 'onlywikiname' ));
    if( ( $onlyWikiName )
          && ( ! $topicExists )
            && ( ! TWiki::isValidTopicName( $topic ) ) ) {
        # do not allow non-wikinames
        throw TWiki::OopsException(
            'attention',
            def => 'not_wikiword',
            web => $webName,
            topic => $topic,
            params => [ $topic ] );
    }

    my $user = $session->{user};
    TWiki::UI::checkAccess( $session, $webName, $topic,
                            'CHANGE', $user );

    my $saveOpts = {};
    $saveOpts->{minor} = 1 if $query->param( 'dontnotify' );
    my $originalrev = $query->param( 'originalrev' ); # rev edit started on

    # Populate the new meta data
    my $newMeta = new TWiki::Meta( $session, $webName, $topic );

    my ( $prevMeta, $prevText );
    my ( $templateText, $templateMeta );
    my $templatetopic = $query->param( 'templatetopic');
    my $templateweb = $webName;

    if( $templatetopic ) {
        ( $templateweb, $templatetopic ) =
          $session->normalizeWebTopicName( $templateweb, $templatetopic );

        unless( $store->topicExists( $templateweb, $templatetopic )) {
            throw TWiki::OopsException(
                'attention',
                def => 'no_such_topic_template',
                web => $templateweb,
                topic => $templatetopic);
        }
    }

    if( $topicExists ) {
        ( $prevMeta, $prevText ) =
          $store->readTopic( $user, $webName, $topic, $revision );
        if( $prevMeta ) {
            foreach my $k ( keys %$prevMeta ) {
                unless( $k =~ /^_/ || $k eq 'FORM' || $k eq 'TOPICPARENT' ||
                          $k eq 'FIELD' ) {
                    $newMeta->copyFrom( $prevMeta, $k );
                }
            }
        }
    } elsif ($templatetopic) {
        ( $templateMeta, $templateText ) =
          $store->readTopic( $user, $templateweb,
                             $templatetopic, $revision );
        $templateText = '' if $query->param( 'newtopic' ); # created by edit
        $templateText =
          $session->expandVariablesOnTopicCreation(
              $templateText, $user, $webName, $topic );
        foreach my $k ( keys %$templateMeta ) {
            unless( $k =~ /^_/ || $k eq 'FORM' || $k eq 'TOPICPARENT' ||
                      $k eq 'FIELD' || $k eq 'TOPICMOVED' ) {
                $newMeta->copyFrom( $templateMeta, $k );
            }
        }
        # topic creation, there is no original rev
        $originalrev = 0;
    }

    # Determine the new text
    my $newText = $query->param( 'text' );

    my $forceNewRev = $query->param( 'forcenewrevision' );
    $saveOpts->{forcenewrevision} = $forceNewRev;
    my $newParent = $query->param( 'topicparent' )
                 || $query->param( 'parenttopic' ); # the latter is undocumented

    if( defined( $newText) ) {
        # text is defined in the query, save that text
        $newText =~ s/\r//g;
        $newText .= "\n" unless $newText =~ /\n$/s;

    } elsif( defined $templateText ) {
        # no text in the query, but we have a templatetopic
        $newText = $templateText;
        $originalrev = 0; # disable merge

    } else {
        $newText = '';
        if( defined $prevText ) {
            $newText = $prevText;
            $originalrev = 0; # disable merge
        }
    }

    my $mum;
    if( $newParent ) {
        if( $newParent ne 'none' ) {
            $mum = { 'name' => $newParent };
        }
    } elsif( $templateMeta ) {
        $mum = $templateMeta->get( 'TOPICPARENT' );
    } elsif( $prevMeta ) {
        $mum = $prevMeta->get( 'TOPICPARENT' );
    }
    $newMeta->put( 'TOPICPARENT', $mum ) if $mum;

    my $metaPreferences = $query->param( 'metapreferences' ) || '';
    foreach my $line ( split(/[\n\r]+/, $metaPreferences) ) {
        if( $line =~ /^ +\*\s+(Set|Local)\s+($TWiki::regex{tagNameRegex})\s*=\s(.*)$/ ) {
            $newMeta->putKeyed( 'PREFERENCE',
                                { name => $2,
                                  title => $2,
                                  type => $1,
                                  value => $3
                                } );
        }
    }

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

    if( $formName ) {
        # new form, default field values will be null
        $formName = '' if( $formName eq 'none' );
        $copyMeta = $prevMeta if $prevMeta;
    } elsif( $templateMeta ) {
        # populate the meta-data with field values from the template
        $formName = $templateMeta->get( 'FORM' );
        $formName = $formName->{name} if $formName;;
        $copyMeta = $templateMeta;
    } elsif( $prevMeta ) {
        # populate the meta-data with field values from the existing topic
        $formName = $prevMeta->get( 'FORM' );
        $formName = $formName->{name} if $formName;;
        $copyMeta = $prevMeta;
    }

    if( $formName ) {
        require TWiki::Form;
        $formDef = new TWiki::Form( $session, $webName, $formName );
        unless( $formDef ) {
            throw TWiki::OopsException(
                'attention',
                def => 'no_form_def',
                web => $session->{webName},
                topic => $session->{topicName},
                params => [ $webName, $formName ] );
        }
        $newMeta->put( 'FORM', { name => $formName });

        # add all fields of form
        foreach my $fieldDef ( @{$formDef->getFields()} ) {
            next unless( $fieldDef->{name} );
            $newMeta->putKeyed( 'FIELD',
                                { name => $fieldDef->{name},
                                  title => $fieldDef->{title},
                                  value => $fieldDef->isMandatory() ? '1' : ''
                                } );
        }
    }
    if( $copyMeta && $formDef ) {
        # Copy existing fields into new form, filtering on the
        # known field names so we don't copy dead data. Though we
        # really should, of course. That comes later.
        my @keys = map { $_->{name} }
                   grep { $_->{name} }
                   @{$formDef->getFields()};
        foreach my $key ( @keys ) {
            my $field = $copyMeta->get( 'FIELD', $key );
            if( $field ) {
                $newMeta->remove( 'FIELD', $key );
                $newMeta->putKeyed( 'FIELD', $field );
            }
        }
    }
    if( $formDef ) {
        # override with values from the query
        my( $seen, $missing ) =
          $formDef->getFieldValuesFromQuery( $query, $newMeta );
        if( $seen && @$missing ) {
            # chuck up if there is at least one field value defined in the
            # query and a mandatory field was not defined in the
            # query or by an existing value.
	    # Item5428: clean up <nop>'s
	    @$missing = map {
	    			s/<nop>//g;
				$_
	    			} @$missing;
            throw TWiki::OopsException(
                'attention',
                def=>'mandatory_field',
                web => $session->{webName},
                topic => $session->{topicName},
                params => [ join( ' ', @$missing ) ] );
        }
    }

    my $merged;
    # assumes rev numbers start at 1
    if( $originalrev ) {
        my( $orev, $odate );
        if( $originalrev =~ /^(\d+)_(\d+)$/ ) {
            ( $orev, $odate ) = ( $1, $2 );
        } elsif( $originalrev =~ /^\d+$/ ) {
            $orev = $originalrev;
        } else {
            $orev = 0;
        }
        my( $date, $author, $rev, $comment ) = $newMeta->getRevisionInfo();
        # If the last save was by me, don't merge
        if(( $orev ne $rev ||
               $odate && $date && $odate ne $date ) &&
                 $author ne $user ) {

            require TWiki::Merge;

            my $pti = $prevMeta->get( 'TOPICINFO' );
            if( $pti->{reprev} && $pti->{version} &&
                  $pti->{reprev} == $pti->{version} ) {
                # If the ancestor revision was generated by a reprev,
                # then the original is lost and we can't 3-way merge

                $session->{plugins}->dispatch(
                    'beforeMergeHandler',
                    $newText,
                    $pti->{version}, $prevText,
                    undef, undef,
                    $webName, $topic);

                $newText = TWiki::Merge::merge2(
                    $pti->{version}, $prevText,
                    $rev, $newText,
                    '.*?\n',
                    $session );
            } else {
                # common ancestor; we can 3-way merge
                my( $ancestorMeta, $ancestorText ) =
                  $store->readTopic( undef, $webName, $topic, $orev );

                $session->{plugins}->dispatch(
                    'beforeMergeHandler',
                    $newText,
                    $rev, $prevText,
                    $orev, $ancestorText,
                    $webName, $topic);

                $newText = TWiki::Merge::merge3(
                    $orev, $ancestorText,
                    $rev, $prevText,
                    'new', $newText,
                    '.*?\n', $session );
            }
            if( $formDef && $prevMeta ) {
                $newMeta->merge( $prevMeta, $formDef );
            }
            $merged = [ $orev, $session->{users}->getWikiName($author), $rev||1 ];
        }
    }

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

=pod

---++ StaticMethod save($session)

Command handler for =save= command.
This method is designed to be
invoked via the =UI::run= method.

See TWiki.TWikiScripts for details of parameters.

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

=cut

sub save {
    my $session = shift;

    my $query = $session->{request};
    my $web = $session->{webName};
    my $topic = $session->{topicName};
    my $store = $session->{store};
    my $user = $session->{user};

    # Do not remove, keep as undocumented feature for compatibility with
    # TWiki 4.0.x: Allow for dynamic topic creation by replacing strings
    # of at least 10 x's XXXXXX with a next-in-sequence number.
    # See Codev.AllowDynamicTopicNameCreation
    if ( $topic =~ /X{10}/ ) {
		my $n = 0;
		my $baseTopic = $topic;
		$store->clearLease( $web, $baseTopic );
		do {
			$topic = $baseTopic;
			$topic =~ s/X{10}X*/$n/e;
			$n++;
		} while( $store->topicExists( $web, $topic ));
        $session->{topicName} = $topic;
    }

    # Allow for more flexible topic creation with sortable names and
    # better performance. See Codev.AutoIncTopicNameOnSave
    if( $topic =~ /AUTOINC([0-9]+)/ ) {
        my $start = $1;
        my $baseTopic = $topic;
        $store->clearLease( $web, $baseTopic );
        my $nameFilter = $topic;
        $nameFilter =~ s/AUTOINC([0-9]+).*/([0-9]+)/;
        my @list =
          sort{ $a <=> $b }
            map{ s/^$nameFilter.*/$1/; s/^0*([0-9])/$1/; $_ }
              grep{ /^$nameFilter/ }
                $store->getTopicNames( $web );
        if( scalar @list ) {
            # find last one, and increment by one
            my $next = $list[$#list] + 1;
            my $len = length( $start );
            $start =~ s/^0*([0-9])/$1/; # cut leading zeros
            $next = $start if( $start > $next );
            my $pad =  $len - length($next);
            if( $pad > 0 ) {
                $next = '0' x $pad . $next; # zero-pad
            }
            $topic =~ s/AUTOINC[0-9]+/$next/;
            $session->{AUTOINC} = $next;
        } else {
            # first auto-inc topic
            $topic =~ s/AUTOINC[0-9]+/$start/;
            $session->{AUTOINC} = $start;
        }
        $session->{topicName} = $topic;
    }

    my $saveaction = '';
    foreach my $action ( 'save', 'checkpoint', 'quietsave', 'cancel', 'preview',
                         'addform', 'replaceform', 'delRev', 'repRev' ) {
        if ($query->param('action_' . $action)) {
            $saveaction = $action;
            last;
        }
    }

    # the 'action' parameter has been deprecated, though is still available
    # for compatibility with old templates.
    if( !$saveaction && $query->param( 'action' )) {
        $saveaction = lc($query->param( 'action' ));
        $session->writeWarning(<<WARN);
Use of deprecated "action" parameter to "save". Correct your templates!
WARN

        # handle old values for form-related actions:
        $saveaction = 'addform' if ( $saveaction eq 'add form');
        $saveaction = 'replaceform' if ( $saveaction eq 'replace form...');
    }

    if( $saveaction eq 'cancel' ) {
        my $lease = $store->getLease( $web, $topic );
        if( $lease && $lease->{user} eq $user ) {
            $store->clearLease( $web, $topic );
        }

        # redirect to a sensible place (a topic that exists)
        my( $w, $t ) = ( '', '' );
        foreach my $test ( $topic,
                           $query->param( 'topicparent' ) || $query->param( 'parenttopic' ),
                           $TWiki::cfg{HomeTopicName} ) {
            ( $w, $t ) =
              $session->normalizeWebTopicName( $web, $test );
            last if( $store->topicExists( $w, $t ));
        }
        my $viewURL = $session->getScriptUrl( 1, 'view', $w, $t );
        $session->redirect( $viewURL, undef, 1 );

        return;
    }

    if( $saveaction eq 'preview' ) {
        require TWiki::UI::Preview;
        TWiki::UI::Preview::preview( $session );
        return;
    }

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

    ## SMELL: The form affecting actions do not preserve edit and editparams
    if( $saveaction eq 'addform' ||
          $saveaction eq 'replaceform' ||
            $saveaction eq 'preview' && $query->param( 'submitChangeForm' )) {
        require TWiki::UI::ChangeForm;
        $session->writeCompletePage
          ( TWiki::UI::ChangeForm::generate( $session, $web,
                                             $topic, $editaction ) );
        return;
    }

    my $redirecturl;

    if( $saveaction eq 'checkpoint' ) {
        $query->param( -name=>'dontnotify', -value=>'checked' );
        my $editURL = $session->getScriptUrl( 1, $edit, $web, $topic );
        $redirecturl = $editURL.'?t='.time();
        $redirecturl .= '&redirectto='.$query->param( 'redirectto' )
          if $query->param( 'redirectto' );
        # select the appropriate edit template
        $redirecturl .= '&action='.$editaction if $editaction;
        $redirecturl .= '&skin='.$query->param('skin')
          if $query->param('skin');
        $redirecturl .= '&cover='.$query->param('cover')
          if $query->param('cover');
        $redirecturl .= '&nowysiwyg='.$query->param('nowysiwyg')
          if $query->param('nowysiwyg');
        $redirecturl .= $editparams
          if $editparams;  # May contain anchor
        my $lease = $store->getLease( $web, $topic );
        if( $lease && $lease->{user} eq $user ) {
            $store->setLease( $web, $topic, $user, $TWiki::cfg{LeaseLength} );
        }
        # drop through
    }

    if( $saveaction eq 'quietsave' ) {
        $query->param( -name=>'dontnotify', -value=>'checked' );
        $saveaction = 'save';
        # drop through
    }

    if( $saveaction =~ /^(del|rep)Rev$/ ) {
        # hidden, largely undocumented functions, used by administrators for
        # reverting spammed topics. These functions support rewriting
        # history, in a Joe Stalin kind of way. They should be replaced with
        # mechanisms for hiding revisions.
        $query->param( -name => 'cmd', -value => $saveaction );
        # drop through
    }

    my $saveCmd = $query->param( 'cmd' ) || 0;
    if ( $saveCmd &&
         ! $session->{users}->isAdmin( $session->{user}, $topic, $web )
    ) {
        throw TWiki::OopsException(
            'accessdenied',
            def => 'only_group',
            web => $web, topic => $topic,
            params => [ ] );
    }

    #success - redirect to topic view (unless its a checkpoint save)
    $redirecturl ||= $session->getScriptUrl( 1, 'view', $web, $topic );

    if( $saveCmd eq 'delRev' ) {
        # delete top revision
        try {
            $store->delRev( $user, $web, $topic );
        } catch Error::Simple with {
            throw TWiki::OopsException(
                'attention',
                def => 'save_error',
                web => $web,
                topic => $topic,
                params => [ shift->{-text} ]);
        };

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

    if( $saveCmd eq 'repRev' ) {
        # replace top revision with the text from the query, trying to
        # make it look as much like the original as possible. The query
        # text is expected to contain %META as well as text.
        my $meta = new TWiki::Meta( $session, $web, $topic,
                                    $query->param( 'text' ));
        my $saveOpts = {
            timetravel => 1,
            operation => 'cmd',
           };
        try {
            $store->repRev( $user, $web, $topic,
                            $meta->text(), $meta, $saveOpts );
        } catch Error::Simple with {
            throw TWiki::OopsException(
                'attention',
                def => 'save_error',
                web => $web,
                topic => $topic,
                params => [ shift->{-text} ] );
        };

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

    my( $newMeta, $newText, $saveOpts, $merged ) =
      buildNewTopic($session, 'save');

    if( $saveaction =~ /^(save|checkpoint)$/ ) {
        $session->{plugins}->dispatch(
            'afterEditHandler', $newText, $topic, $web, $newMeta );
    }

    try {
        $store->saveTopic( $user, $web, $topic,
                           $newText, $newMeta, $saveOpts );
    } catch Error::Simple with {
        throw TWiki::OopsException(
            'attention',
            def => 'save_error',
            web => $web,
            topic => $topic,
            params => [ shift->{-text} ] );
    };

    my $lease = $store->getLease( $web, $topic );
    # clear the lease, if (and only if) we own it
    if( $lease && $lease->{user} eq $user ) {
        $store->clearLease( $web, $topic );
    }

    if( $session->{topicName} ne $topic ) {
        # TWikibug:Item6813: update $topic because it has changed in an plugin afterSaveHandler
        $topic = $session->{topicName};
        $redirecturl =~ s/([\/\\])[^\/\\]+([?#]|$)/$1$topic$2/; # replace topic
    }

    if( $merged ) {
        throw TWiki::OopsException(
            'attention',
            def => 'merge_notice',
            web => $web, topic => $topic,
            params => $merged );
    }

    if ( $session->{rcsFileNull} ) {
        throw TWiki::OopsException(
            'attention',
            def => 'prior_versions_lost',
            web => $web,
            topic => $topic,
            params => "past revisions are lost."  );
    }

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

1;