lib/TWiki/UI/Upload.pm
author Colas Nahaboo <colas@nahaboo.net>
Sat, 26 Jan 2008 15:50:53 +0100
changeset 0 414e01d06fd5
permissions -rw-r--r--
RELEASE 4.2.0 freetown
colas@0
     1
# 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
#
colas@0
    11
# This program is free software; you can redistribute it and/or
colas@0
    12
# modify it under the terms of the GNU General Public License
colas@0
    13
# as published by the Free Software Foundation; either version 2
colas@0
    14
# of the License, or (at your option) any later version. For
colas@0
    15
# more details read LICENSE in the root of this distribution.
colas@0
    16
#
colas@0
    17
# This program is distributed in the hope that it will be useful,
colas@0
    18
# but WITHOUT ANY WARRANTY; without even the implied warranty of
colas@0
    19
# MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.
colas@0
    20
#
colas@0
    21
# As per the GPL, removal of this notice is prohibited.
colas@0
    22
colas@0
    23
=pod
colas@0
    24
colas@0
    25
---+ package TWiki::UI::Upload
colas@0
    26
colas@0
    27
UI delegate for attachment management functions
colas@0
    28
colas@0
    29
=cut
colas@0
    30
colas@0
    31
package TWiki::UI::Upload;
colas@0
    32
colas@0
    33
use strict;
colas@0
    34
use Assert;
colas@0
    35
use Error qw( :try );
colas@0
    36
colas@0
    37
require TWiki;
colas@0
    38
require TWiki::UI;
colas@0
    39
require TWiki::Sandbox;
colas@0
    40
require TWiki::OopsException;
colas@0
    41
colas@0
    42
=pod
colas@0
    43
colas@0
    44
---++ StaticMethod attach( $session )
colas@0
    45
colas@0
    46
=attach= command handler.
colas@0
    47
This method is designed to be
colas@0
    48
invoked via the =UI::run= method.
colas@0
    49
colas@0
    50
Generates a prompt page for adding an attachment.
colas@0
    51
colas@0
    52
=cut
colas@0
    53
colas@0
    54
sub attach {
colas@0
    55
    my $session = shift;
colas@0
    56
colas@0
    57
    my $query = $session->{cgiQuery};
colas@0
    58
    my $webName = $session->{webName};
colas@0
    59
    my $topic = $session->{topicName};
colas@0
    60
colas@0
    61
    my $fileName = $query->param( 'filename' ) || '';
colas@0
    62
    my $skin = $session->getSkin();
colas@0
    63
colas@0
    64
    TWiki::UI::checkWebExists( $session, $webName, $topic, 'attach' );
colas@0
    65
colas@0
    66
    my $tmpl = '';
colas@0
    67
    my $text = '';
colas@0
    68
    my $meta = '';
colas@0
    69
    my $atext = '';
colas@0
    70
    my $fileUser = '';
colas@0
    71
    my $isHideChecked = '';
colas@0
    72
    my $users = $session->{users};
colas@0
    73
colas@0
    74
    TWiki::UI::checkMirror( $session, $webName, $topic );
colas@0
    75
colas@0
    76
    TWiki::UI::checkAccess( $session, $webName, $topic,
colas@0
    77
                            'CHANGE', $session->{user} );
colas@0
    78
    TWiki::UI::checkTopicExists( $session, $webName, $topic,
colas@0
    79
                                 'upload files to' );
colas@0
    80
colas@0
    81
    ( $meta, $text ) =
colas@0
    82
      $session->{store}->readTopic( $session->{user}, $webName, $topic, undef );
colas@0
    83
    my $args = $meta->get( 'FILEATTACHMENT', $fileName );
colas@0
    84
    $args = {
colas@0
    85
             name => $fileName,
colas@0
    86
             attr => '',
colas@0
    87
             path => '',
colas@0
    88
             comment => ''
colas@0
    89
            } unless( $args );
colas@0
    90
colas@0
    91
    if ( $args->{attr} =~ /h/o ) {
colas@0
    92
        $isHideChecked = 'checked';
colas@0
    93
    }
colas@0
    94
colas@0
    95
    # SMELL: why log attach before post is called?
colas@0
    96
    # FIXME: Move down, log only if successful (or with error msg?)
colas@0
    97
    # Attach is a read function, only has potential for a change
colas@0
    98
    if( $TWiki::cfg{Log}{attach} ) {
colas@0
    99
        # write log entry
colas@0
   100
        $session->writeLog( 'attach', $webName.'.'.$topic, $fileName );
colas@0
   101
    }
colas@0
   102
colas@0
   103
    my $fileWikiUser = '';
colas@0
   104
    if( $fileName ) {
colas@0
   105
        $tmpl = $session->templates->readTemplate( 'attachagain', $skin );
colas@0
   106
        my $u = $args->{user};
colas@0
   107
        $fileWikiUser = $users->webDotWikiName($u) if $u;
colas@0
   108
    } else {
colas@0
   109
        $tmpl = $session->templates->readTemplate( 'attachnew', $skin );
colas@0
   110
    }
colas@0
   111
    if ( $fileName ) {
colas@0
   112
        # must come after templates have been read
colas@0
   113
        $atext .= $session->attach->formatVersions( $webName, $topic, %$args );
colas@0
   114
    }
colas@0
   115
    $tmpl =~ s/%ATTACHTABLE%/$atext/g;
colas@0
   116
    $tmpl =~ s/%FILEUSER%/$fileWikiUser/g;
colas@0
   117
    $tmpl =~ s/%FILENAME%/$fileName/g;
colas@0
   118
    $session->enterContext( 'can_render_meta', $meta );
colas@0
   119
    $tmpl = $session->handleCommonTags( $tmpl, $webName, $topic );
colas@0
   120
    $tmpl = $session->renderer->getRenderedVersion( $tmpl, $webName, $topic );
colas@0
   121
    $tmpl =~ s/%HIDEFILE%/$isHideChecked/g;
colas@0
   122
    $tmpl =~ s/%FILEPATH%/$args->{path}/g;
colas@0
   123
    $args->{comment} = TWiki::entityEncode( $args->{comment} );
colas@0
   124
    $tmpl =~ s/%FILECOMMENT%/$args->{comment}/g;
colas@0
   125
colas@0
   126
    $session->writeCompletePage( $tmpl );
colas@0
   127
}
colas@0
   128
colas@0
   129
=pod
colas@0
   130
colas@0
   131
---++ StaticMethod upload( $session )
colas@0
   132
colas@0
   133
=upload= command handler.
colas@0
   134
This method is designed to be
colas@0
   135
invoked via the =UI::run= method.
colas@0
   136
CGI parameters, passed in $query:
colas@0
   137
colas@0
   138
| =hidefile= | if defined, will not show file in attachment table |
colas@0
   139
| =filepath= | |
colas@0
   140
| =filename= | |
colas@0
   141
| =filecomment= | comment to associate with file in attachment table |
colas@0
   142
| =createlink= | if defined, will create a link to file at end of topic |
colas@0
   143
| =changeproperties= | |
colas@0
   144
| =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=. |
colas@0
   145
colas@0
   146
Does the work of uploading a file to a topic. Designed to be useable for
colas@0
   147
a crude RPC (it will redirect to the 'view' script unless the
colas@0
   148
'noredirect' parameter is specified, in which case it will print a message to
colas@0
   149
STDOUT, starting with 'OK' on success and 'ERROR' on failure.
colas@0
   150
colas@0
   151
=cut
colas@0
   152
colas@0
   153
sub upload {
colas@0
   154
    my $session = shift;
colas@0
   155
colas@0
   156
    my $query = $session->{cgiQuery};
colas@0
   157
    my $webName = $session->{webName};
colas@0
   158
    my $topic = $session->{topicName};
colas@0
   159
    my $user = $session->{user};
colas@0
   160
colas@0
   161
    my $hideFile = $query->param( 'hidefile' ) || '';
colas@0
   162
    my $fileComment = $query->param( 'filecomment' ) || '';
colas@0
   163
    my $createLink = $query->param( 'createlink' ) || '';
colas@0
   164
    my $doPropsOnly = $query->param( 'changeproperties' );
colas@0
   165
    my $filePath = $query->param( 'filepath' ) || '';
colas@0
   166
    my $fileName = $query->param( 'filename' ) || '';
colas@0
   167
    if ( $filePath && ! $fileName ) {
colas@0
   168
        $filePath =~ m|([^/\\]*$)|;
colas@0
   169
        $fileName = $1;
colas@0
   170
    }
colas@0
   171
colas@0
   172
    $fileComment =~ s/\s+/ /go;
colas@0
   173
    $fileComment =~ s/^\s*//o;
colas@0
   174
    $fileComment =~ s/\s*$//o;
colas@0
   175
    $fileName =~ s/\s*$//o;
colas@0
   176
    $filePath =~ s/\s*$//o;
colas@0
   177
colas@0
   178
    TWiki::UI::checkWebExists( $session, $webName, $topic, 'attach files to' );
colas@0
   179
    TWiki::UI::checkTopicExists( $session, $webName, $topic, 'attach files to' );
colas@0
   180
    TWiki::UI::checkMirror( $session, $webName, $topic );
colas@0
   181
    TWiki::UI::checkAccess( $session, $webName, $topic,
colas@0
   182
                            'CHANGE', $user );
colas@0
   183
colas@0
   184
    my $origName = $fileName;
colas@0
   185
    my $stream;
colas@0
   186
    my ( $fileSize, $fileDate, $tmpFilePath ) = '';
colas@0
   187
colas@0
   188
    unless( $doPropsOnly ) {
colas@0
   189
        my $fh = $query->param( 'filepath' );
colas@0
   190
        # $fh is both a file name *and* a file handle (see the CGI doc)
colas@0
   191
colas@0
   192
        try {
colas@0
   193
            # SMELL: use of undocumented CGI::tmpFileName
colas@0
   194
            $tmpFilePath = $query->tmpFileName( $fh );
colas@0
   195
        } catch Error::Simple with {
colas@0
   196
            # Item5130, Item5133 - Illegal file name, bad path,
colas@0
   197
            # something like that
colas@0
   198
            throw TWiki::OopsException(
colas@0
   199
                'attention',
colas@0
   200
                def => 'zero_size_upload',
colas@0
   201
                web => $webName,
colas@0
   202
                topic => $topic,
colas@0
   203
                params => [ ($filePath || '""') ] );
colas@0
   204
        };
colas@0
   205
colas@0
   206
        $stream = $query->upload( 'filepath' );
colas@0
   207
        ( $fileName, $origName ) =
colas@0
   208
          TWiki::Sandbox::sanitizeAttachmentName( $fileName );
colas@0
   209
colas@0
   210
        # check if upload has non zero size
colas@0
   211
        if( $stream ) {
colas@0
   212
            my @stats = stat $stream;
colas@0
   213
            $fileSize = $stats[7];
colas@0
   214
            $fileDate = $stats[9];
colas@0
   215
        }
colas@0
   216
        unless( $fileSize && $fileName ) {
colas@0
   217
            throw TWiki::OopsException(
colas@0
   218
                'attention',
colas@0
   219
                def => 'zero_size_upload',
colas@0
   220
                web => $webName,
colas@0
   221
                topic => $topic,
colas@0
   222
                params => [ ($filePath || '""') ] );
colas@0
   223
        }
colas@0
   224
colas@0
   225
        my $maxSize = $session->{prefs}->getPreferencesValue(
colas@0
   226
            'ATTACHFILESIZELIMIT' );
colas@0
   227
        $maxSize = 0 unless ( $maxSize =~ /([0-9]+)/o );
colas@0
   228
colas@0
   229
        if( $maxSize && $fileSize > $maxSize * 1024 ) {
colas@0
   230
            throw TWiki::OopsException(
colas@0
   231
                'attention',
colas@0
   232
                def => 'oversized_upload',
colas@0
   233
                web => $webName,
colas@0
   234
                topic => $topic,
colas@0
   235
                params => [ $fileName, $maxSize ] );
colas@0
   236
        }
colas@0
   237
    }
colas@0
   238
    try {
colas@0
   239
        $session->{store}->saveAttachment(
colas@0
   240
            $webName, $topic, $fileName, $user,
colas@0
   241
            {
colas@0
   242
                dontlog => !$TWiki::cfg{Log}{upload},
colas@0
   243
                comment => $fileComment,
colas@0
   244
                hide => $hideFile,
colas@0
   245
                createlink => $createLink,
colas@0
   246
                stream => $stream,
colas@0
   247
                filepath => $filePath,
colas@0
   248
                filesize => $fileSize,
colas@0
   249
                filedate => $fileDate,
colas@0
   250
                tmpFilename => $tmpFilePath,
colas@0
   251
            } );
colas@0
   252
    } catch Error::Simple with {
colas@0
   253
        throw TWiki::OopsException( 'attention',
colas@0
   254
                                    def => 'save_error',
colas@0
   255
                                    web => $webName,
colas@0
   256
                                    topic => $topic,
colas@0
   257
                                    params => [ shift->{-text} ] );
colas@0
   258
    };
colas@0
   259
    close( $stream ) if $stream;
colas@0
   260
colas@0
   261
    if( $fileName eq $origName ) {
colas@0
   262
        $session->redirect(
colas@0
   263
            $session->getScriptUrl( 1, 'view', $webName, $topic ), undef, 1 );
colas@0
   264
    } else {
colas@0
   265
        throw TWiki::OopsException( 'attention',
colas@0
   266
                                    def => 'upload_name_changed',
colas@0
   267
                                    web => $webName,
colas@0
   268
                                    topic => $topic,
colas@0
   269
                                    params => [ $origName, $fileName ] );
colas@0
   270
    }
colas@0
   271
colas@0
   272
    # generate a message useful for those calling this script from the command line
colas@0
   273
    my $message = ( $doPropsOnly ) ?
colas@0
   274
      'properties changed' : "$fileName uploaded";
colas@0
   275
colas@0
   276
    print 'OK ',$message,"\n";
colas@0
   277
}
colas@0
   278
colas@0
   279
1;