# TWiki Enterprise Collaboration Platform, http://TWiki.org/
#
# Copyright (C) 1999-2007 Peter Thoeny, peter@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:
#
# 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 2
# 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::Upload

UI delegate for attachment management functions

=cut

package TWiki::UI::Upload;

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

require TWiki;
require TWiki::UI;
require TWiki::Sandbox;
require TWiki::OopsException;

=pod

---++ StaticMethod attach( $session )

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

Generates a prompt page for adding an attachment.

=cut

sub attach {
    my $session = shift;

    my $query = $session->{cgiQuery};
    my $webName = $session->{webName};
    my $topic = $session->{topicName};

    my $fileName = $query->param( 'filename' ) || '';
    my $skin = $session->getSkin();

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

    my $tmpl = '';
    my $text = '';
    my $meta = '';
    my $atext = '';
    my $fileUser = '';
    my $isHideChecked = '';
    my $users = $session->{users};

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

    TWiki::UI::checkAccess( $session, $webName, $topic,
                            'CHANGE', $session->{user} );
    TWiki::UI::checkTopicExists( $session, $webName, $topic,
                                 'upload files to' );

    ( $meta, $text ) =
      $session->{store}->readTopic( $session->{user}, $webName, $topic, undef );
    my $args = $meta->get( 'FILEATTACHMENT', $fileName );
    $args = {
             name => $fileName,
             attr => '',
             path => '',
             comment => ''
            } unless( $args );

    if ( $args->{attr} =~ /h/o ) {
        $isHideChecked = 'checked';
    }

    # SMELL: why log attach before post is called?
    # FIXME: Move down, log only if successful (or with error msg?)
    # Attach is a read function, only has potential for a change
    if( $TWiki::cfg{Log}{attach} ) {
        # write log entry
        $session->writeLog( 'attach', $webName.'.'.$topic, $fileName );
    }

    my $fileWikiUser = '';
    if( $fileName ) {
        $tmpl = $session->templates->readTemplate( 'attachagain', $skin );
        my $u = $args->{user};
        $fileWikiUser = $users->webDotWikiName($u) if $u;
    } else {
        $tmpl = $session->templates->readTemplate( 'attachnew', $skin );
    }
    if ( $fileName ) {
        # must come after templates have been read
        $atext .= $session->attach->formatVersions( $webName, $topic, %$args );
    }
    $tmpl =~ s/%ATTACHTABLE%/$atext/g;
    $tmpl =~ s/%FILEUSER%/$fileWikiUser/g;
    $tmpl =~ s/%FILENAME%/$fileName/g;
    $session->enterContext( 'can_render_meta', $meta );
    $tmpl = $session->handleCommonTags( $tmpl, $webName, $topic );
    $tmpl = $session->renderer->getRenderedVersion( $tmpl, $webName, $topic );
    $tmpl =~ s/%HIDEFILE%/$isHideChecked/g;
    $tmpl =~ s/%FILEPATH%/$args->{path}/g;
    $args->{comment} = TWiki::entityEncode( $args->{comment} );
    $tmpl =~ s/%FILECOMMENT%/$args->{comment}/g;

    $session->writeCompletePage( $tmpl );
}

=pod

---++ StaticMethod upload( $session )

=upload= command handler.
This method is designed to be
invoked via the =UI::run= method.
CGI parameters, passed in $query:

| =hidefile= | if defined, will not show file in attachment table |
| =filepath= | |
| =filename= | |
| =filecomment= | comment to associate with file in attachment table |
| =createlink= | if defined, will create a link to file at end of topic |
| =changeproperties= | |
| =redirectto= | URL to redirect to after upload. ={AllowRedirectUrl}= must be enabled in =configure=. The parameter value can be a =TopicName=, a =Web.TopicName=, or a URL. Redirect to a URL only works if it is enabled in =configure=. |

Does the work of uploading a file to a topic. Designed to be useable for
a crude RPC (it will redirect to the 'view' script unless the
'noredirect' parameter is specified, in which case it will print a message to
STDOUT, starting with 'OK' on success and 'ERROR' on failure.

=cut

sub upload {
    my $session = shift;

    my $query = $session->{cgiQuery};
    my $webName = $session->{webName};
    my $topic = $session->{topicName};
    my $user = $session->{user};

    my $hideFile = $query->param( 'hidefile' ) || '';
    my $fileComment = $query->param( 'filecomment' ) || '';
    my $createLink = $query->param( 'createlink' ) || '';
    my $doPropsOnly = $query->param( 'changeproperties' );
    my $filePath = $query->param( 'filepath' ) || '';
    my $fileName = $query->param( 'filename' ) || '';
    if ( $filePath && ! $fileName ) {
        $filePath =~ m|([^/\\]*$)|;
        $fileName = $1;
    }

    $fileComment =~ s/\s+/ /go;
    $fileComment =~ s/^\s*//o;
    $fileComment =~ s/\s*$//o;
    $fileName =~ s/\s*$//o;
    $filePath =~ s/\s*$//o;

    if( $query->request_method() !~ /^POST$/i ) {
        # upload script can only be called via POST method
        throw TWiki::OopsException(
            'attention',
            def => 'post_method_only',
            web => $webName,
            topic => $topic,
            params => [ 'upload' ]);
    }

    TWiki::UI::checkWebExists( $session, $webName, $topic, 'attach files to' );
    TWiki::UI::checkTopicExists( $session, $webName, $topic, 'attach files to' );
    TWiki::UI::checkMirror( $session, $webName, $topic );
    TWiki::UI::checkAccess( $session, $webName, $topic,
                            'CHANGE', $user );

    my $origName = $fileName;
    my $stream;
    my ( $fileSize, $fileDate, $tmpFilePath ) = '';

    unless( $doPropsOnly ) {
        my $fh = $query->param( 'filepath' );
        # $fh is both a file name *and* a file handle (see the CGI doc)

        try {
            # SMELL: use of undocumented CGI::tmpFileName
            $tmpFilePath = $query->tmpFileName( $fh );
        } catch Error::Simple with {
            # Item5130, Item5133 - Illegal file name, bad path,
            # something like that
            throw TWiki::OopsException(
                'attention',
                def => 'zero_size_upload',
                web => $webName,
                topic => $topic,
                params => [ ($filePath || '""') ] );
        };

        $stream = $query->upload( 'filepath' );
        ( $fileName, $origName ) =
          TWiki::Sandbox::sanitizeAttachmentName( $fileName );

        # check if upload has non zero size
        if( $stream ) {
            my @stats = stat $stream;
            $fileSize = $stats[7];
            $fileDate = $stats[9];
        }
        unless( $fileSize && $fileName ) {
            throw TWiki::OopsException(
                'attention',
                def => 'zero_size_upload',
                web => $webName,
                topic => $topic,
                params => [ ($filePath || '""') ] );
        }

        my $maxSize = $session->{prefs}->getPreferencesValue(
            'ATTACHFILESIZELIMIT' );
        $maxSize = 0 unless ( $maxSize =~ /([0-9]+)/o );

        if( $maxSize && $fileSize > $maxSize * 1024 ) {
            throw TWiki::OopsException(
                'attention',
                def => 'oversized_upload',
                web => $webName,
                topic => $topic,
                params => [ $fileName, $maxSize ] );
        }
    }
    try {
        $session->{store}->saveAttachment(
            $webName, $topic, $fileName, $user,
            {
                dontlog => !$TWiki::cfg{Log}{upload},
                comment => $fileComment,
                hide => $hideFile,
                createlink => $createLink,
                stream => $stream,
                filepath => $filePath,
                filesize => $fileSize,
                filedate => $fileDate,
                tmpFilename => $tmpFilePath,
            } );
    } catch Error::Simple with {
        throw TWiki::OopsException( 'attention',
                                    def => 'save_error',
                                    web => $webName,
                                    topic => $topic,
                                    params => [ shift->{-text} ] );
    };
    close( $stream ) if $stream;

    if( $fileName eq $origName ) {
        $session->redirect(
            $session->getScriptUrl( 1, 'view', $webName, $topic ), undef, 1 );
    } else {
        throw TWiki::OopsException( 'attention',
                                    def => 'upload_name_changed',
                                    web => $webName,
                                    topic => $topic,
                                    params => [ $origName, $fileName ] );
    }

    # generate a message useful for those calling this script from the command line
    my $message = ( $doPropsOnly ) ?
      'properties changed' : "$fileName uploaded";

    print 'OK ',$message,"\n";
}

1;
