lib/TWiki/UI/Upload.pm
changeset 0 414e01d06fd5
     1.1 --- /dev/null	Thu Jan 01 00:00:00 1970 +0000
     1.2 +++ b/lib/TWiki/UI/Upload.pm	Sat Jan 26 15:50:53 2008 +0100
     1.3 @@ -0,0 +1,279 @@
     1.4 +# TWiki Enterprise Collaboration Platform, http://TWiki.org/
     1.5 +#
     1.6 +# Copyright (C) 1999-2007 Peter Thoeny, peter@thoeny.org
     1.7 +# and TWiki Contributors. All Rights Reserved. TWiki Contributors
     1.8 +# are listed in the AUTHORS file in the root of this distribution.
     1.9 +# NOTE: Please extend that file, not this notice.
    1.10 +#
    1.11 +# Additional copyrights apply to some or all of the code in this
    1.12 +# file as follows:
    1.13 +#
    1.14 +# This program is free software; you can redistribute it and/or
    1.15 +# modify it under the terms of the GNU General Public License
    1.16 +# as published by the Free Software Foundation; either version 2
    1.17 +# of the License, or (at your option) any later version. For
    1.18 +# more details read LICENSE in the root of this distribution.
    1.19 +#
    1.20 +# This program is distributed in the hope that it will be useful,
    1.21 +# but WITHOUT ANY WARRANTY; without even the implied warranty of
    1.22 +# MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.
    1.23 +#
    1.24 +# As per the GPL, removal of this notice is prohibited.
    1.25 +
    1.26 +=pod
    1.27 +
    1.28 +---+ package TWiki::UI::Upload
    1.29 +
    1.30 +UI delegate for attachment management functions
    1.31 +
    1.32 +=cut
    1.33 +
    1.34 +package TWiki::UI::Upload;
    1.35 +
    1.36 +use strict;
    1.37 +use Assert;
    1.38 +use Error qw( :try );
    1.39 +
    1.40 +require TWiki;
    1.41 +require TWiki::UI;
    1.42 +require TWiki::Sandbox;
    1.43 +require TWiki::OopsException;
    1.44 +
    1.45 +=pod
    1.46 +
    1.47 +---++ StaticMethod attach( $session )
    1.48 +
    1.49 +=attach= command handler.
    1.50 +This method is designed to be
    1.51 +invoked via the =UI::run= method.
    1.52 +
    1.53 +Generates a prompt page for adding an attachment.
    1.54 +
    1.55 +=cut
    1.56 +
    1.57 +sub attach {
    1.58 +    my $session = shift;
    1.59 +
    1.60 +    my $query = $session->{cgiQuery};
    1.61 +    my $webName = $session->{webName};
    1.62 +    my $topic = $session->{topicName};
    1.63 +
    1.64 +    my $fileName = $query->param( 'filename' ) || '';
    1.65 +    my $skin = $session->getSkin();
    1.66 +
    1.67 +    TWiki::UI::checkWebExists( $session, $webName, $topic, 'attach' );
    1.68 +
    1.69 +    my $tmpl = '';
    1.70 +    my $text = '';
    1.71 +    my $meta = '';
    1.72 +    my $atext = '';
    1.73 +    my $fileUser = '';
    1.74 +    my $isHideChecked = '';
    1.75 +    my $users = $session->{users};
    1.76 +
    1.77 +    TWiki::UI::checkMirror( $session, $webName, $topic );
    1.78 +
    1.79 +    TWiki::UI::checkAccess( $session, $webName, $topic,
    1.80 +                            'CHANGE', $session->{user} );
    1.81 +    TWiki::UI::checkTopicExists( $session, $webName, $topic,
    1.82 +                                 'upload files to' );
    1.83 +
    1.84 +    ( $meta, $text ) =
    1.85 +      $session->{store}->readTopic( $session->{user}, $webName, $topic, undef );
    1.86 +    my $args = $meta->get( 'FILEATTACHMENT', $fileName );
    1.87 +    $args = {
    1.88 +             name => $fileName,
    1.89 +             attr => '',
    1.90 +             path => '',
    1.91 +             comment => ''
    1.92 +            } unless( $args );
    1.93 +
    1.94 +    if ( $args->{attr} =~ /h/o ) {
    1.95 +        $isHideChecked = 'checked';
    1.96 +    }
    1.97 +
    1.98 +    # SMELL: why log attach before post is called?
    1.99 +    # FIXME: Move down, log only if successful (or with error msg?)
   1.100 +    # Attach is a read function, only has potential for a change
   1.101 +    if( $TWiki::cfg{Log}{attach} ) {
   1.102 +        # write log entry
   1.103 +        $session->writeLog( 'attach', $webName.'.'.$topic, $fileName );
   1.104 +    }
   1.105 +
   1.106 +    my $fileWikiUser = '';
   1.107 +    if( $fileName ) {
   1.108 +        $tmpl = $session->templates->readTemplate( 'attachagain', $skin );
   1.109 +        my $u = $args->{user};
   1.110 +        $fileWikiUser = $users->webDotWikiName($u) if $u;
   1.111 +    } else {
   1.112 +        $tmpl = $session->templates->readTemplate( 'attachnew', $skin );
   1.113 +    }
   1.114 +    if ( $fileName ) {
   1.115 +        # must come after templates have been read
   1.116 +        $atext .= $session->attach->formatVersions( $webName, $topic, %$args );
   1.117 +    }
   1.118 +    $tmpl =~ s/%ATTACHTABLE%/$atext/g;
   1.119 +    $tmpl =~ s/%FILEUSER%/$fileWikiUser/g;
   1.120 +    $tmpl =~ s/%FILENAME%/$fileName/g;
   1.121 +    $session->enterContext( 'can_render_meta', $meta );
   1.122 +    $tmpl = $session->handleCommonTags( $tmpl, $webName, $topic );
   1.123 +    $tmpl = $session->renderer->getRenderedVersion( $tmpl, $webName, $topic );
   1.124 +    $tmpl =~ s/%HIDEFILE%/$isHideChecked/g;
   1.125 +    $tmpl =~ s/%FILEPATH%/$args->{path}/g;
   1.126 +    $args->{comment} = TWiki::entityEncode( $args->{comment} );
   1.127 +    $tmpl =~ s/%FILECOMMENT%/$args->{comment}/g;
   1.128 +
   1.129 +    $session->writeCompletePage( $tmpl );
   1.130 +}
   1.131 +
   1.132 +=pod
   1.133 +
   1.134 +---++ StaticMethod upload( $session )
   1.135 +
   1.136 +=upload= command handler.
   1.137 +This method is designed to be
   1.138 +invoked via the =UI::run= method.
   1.139 +CGI parameters, passed in $query:
   1.140 +
   1.141 +| =hidefile= | if defined, will not show file in attachment table |
   1.142 +| =filepath= | |
   1.143 +| =filename= | |
   1.144 +| =filecomment= | comment to associate with file in attachment table |
   1.145 +| =createlink= | if defined, will create a link to file at end of topic |
   1.146 +| =changeproperties= | |
   1.147 +| =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=. |
   1.148 +
   1.149 +Does the work of uploading a file to a topic. Designed to be useable for
   1.150 +a crude RPC (it will redirect to the 'view' script unless the
   1.151 +'noredirect' parameter is specified, in which case it will print a message to
   1.152 +STDOUT, starting with 'OK' on success and 'ERROR' on failure.
   1.153 +
   1.154 +=cut
   1.155 +
   1.156 +sub upload {
   1.157 +    my $session = shift;
   1.158 +
   1.159 +    my $query = $session->{cgiQuery};
   1.160 +    my $webName = $session->{webName};
   1.161 +    my $topic = $session->{topicName};
   1.162 +    my $user = $session->{user};
   1.163 +
   1.164 +    my $hideFile = $query->param( 'hidefile' ) || '';
   1.165 +    my $fileComment = $query->param( 'filecomment' ) || '';
   1.166 +    my $createLink = $query->param( 'createlink' ) || '';
   1.167 +    my $doPropsOnly = $query->param( 'changeproperties' );
   1.168 +    my $filePath = $query->param( 'filepath' ) || '';
   1.169 +    my $fileName = $query->param( 'filename' ) || '';
   1.170 +    if ( $filePath && ! $fileName ) {
   1.171 +        $filePath =~ m|([^/\\]*$)|;
   1.172 +        $fileName = $1;
   1.173 +    }
   1.174 +
   1.175 +    $fileComment =~ s/\s+/ /go;
   1.176 +    $fileComment =~ s/^\s*//o;
   1.177 +    $fileComment =~ s/\s*$//o;
   1.178 +    $fileName =~ s/\s*$//o;
   1.179 +    $filePath =~ s/\s*$//o;
   1.180 +
   1.181 +    TWiki::UI::checkWebExists( $session, $webName, $topic, 'attach files to' );
   1.182 +    TWiki::UI::checkTopicExists( $session, $webName, $topic, 'attach files to' );
   1.183 +    TWiki::UI::checkMirror( $session, $webName, $topic );
   1.184 +    TWiki::UI::checkAccess( $session, $webName, $topic,
   1.185 +                            'CHANGE', $user );
   1.186 +
   1.187 +    my $origName = $fileName;
   1.188 +    my $stream;
   1.189 +    my ( $fileSize, $fileDate, $tmpFilePath ) = '';
   1.190 +
   1.191 +    unless( $doPropsOnly ) {
   1.192 +        my $fh = $query->param( 'filepath' );
   1.193 +        # $fh is both a file name *and* a file handle (see the CGI doc)
   1.194 +
   1.195 +        try {
   1.196 +            # SMELL: use of undocumented CGI::tmpFileName
   1.197 +            $tmpFilePath = $query->tmpFileName( $fh );
   1.198 +        } catch Error::Simple with {
   1.199 +            # Item5130, Item5133 - Illegal file name, bad path,
   1.200 +            # something like that
   1.201 +            throw TWiki::OopsException(
   1.202 +                'attention',
   1.203 +                def => 'zero_size_upload',
   1.204 +                web => $webName,
   1.205 +                topic => $topic,
   1.206 +                params => [ ($filePath || '""') ] );
   1.207 +        };
   1.208 +
   1.209 +        $stream = $query->upload( 'filepath' );
   1.210 +        ( $fileName, $origName ) =
   1.211 +          TWiki::Sandbox::sanitizeAttachmentName( $fileName );
   1.212 +
   1.213 +        # check if upload has non zero size
   1.214 +        if( $stream ) {
   1.215 +            my @stats = stat $stream;
   1.216 +            $fileSize = $stats[7];
   1.217 +            $fileDate = $stats[9];
   1.218 +        }
   1.219 +        unless( $fileSize && $fileName ) {
   1.220 +            throw TWiki::OopsException(
   1.221 +                'attention',
   1.222 +                def => 'zero_size_upload',
   1.223 +                web => $webName,
   1.224 +                topic => $topic,
   1.225 +                params => [ ($filePath || '""') ] );
   1.226 +        }
   1.227 +
   1.228 +        my $maxSize = $session->{prefs}->getPreferencesValue(
   1.229 +            'ATTACHFILESIZELIMIT' );
   1.230 +        $maxSize = 0 unless ( $maxSize =~ /([0-9]+)/o );
   1.231 +
   1.232 +        if( $maxSize && $fileSize > $maxSize * 1024 ) {
   1.233 +            throw TWiki::OopsException(
   1.234 +                'attention',
   1.235 +                def => 'oversized_upload',
   1.236 +                web => $webName,
   1.237 +                topic => $topic,
   1.238 +                params => [ $fileName, $maxSize ] );
   1.239 +        }
   1.240 +    }
   1.241 +    try {
   1.242 +        $session->{store}->saveAttachment(
   1.243 +            $webName, $topic, $fileName, $user,
   1.244 +            {
   1.245 +                dontlog => !$TWiki::cfg{Log}{upload},
   1.246 +                comment => $fileComment,
   1.247 +                hide => $hideFile,
   1.248 +                createlink => $createLink,
   1.249 +                stream => $stream,
   1.250 +                filepath => $filePath,
   1.251 +                filesize => $fileSize,
   1.252 +                filedate => $fileDate,
   1.253 +                tmpFilename => $tmpFilePath,
   1.254 +            } );
   1.255 +    } catch Error::Simple with {
   1.256 +        throw TWiki::OopsException( 'attention',
   1.257 +                                    def => 'save_error',
   1.258 +                                    web => $webName,
   1.259 +                                    topic => $topic,
   1.260 +                                    params => [ shift->{-text} ] );
   1.261 +    };
   1.262 +    close( $stream ) if $stream;
   1.263 +
   1.264 +    if( $fileName eq $origName ) {
   1.265 +        $session->redirect(
   1.266 +            $session->getScriptUrl( 1, 'view', $webName, $topic ), undef, 1 );
   1.267 +    } else {
   1.268 +        throw TWiki::OopsException( 'attention',
   1.269 +                                    def => 'upload_name_changed',
   1.270 +                                    web => $webName,
   1.271 +                                    topic => $topic,
   1.272 +                                    params => [ $origName, $fileName ] );
   1.273 +    }
   1.274 +
   1.275 +    # generate a message useful for those calling this script from the command line
   1.276 +    my $message = ( $doPropsOnly ) ?
   1.277 +      'properties changed' : "$fileName uploaded";
   1.278 +
   1.279 +    print 'OK ',$message,"\n";
   1.280 +}
   1.281 +
   1.282 +1;