Beefy Boxes and Bandwidth Generously Provided by pair Networks
The stupid question is the question not asked
 
PerlMonks  

CGI::Upload - CGI class for handling browser file uploads

by rob_au (Abbot)
on Mar 10, 2002 at 14:27 UTC ( #150713=sourcecode: print w/ replies, xml ) Need Help??

Category: CGI Programming
Author/Contact Info rob_au
Description: This module has been written to provide a simple and secure manner by which to handle files uploaded in multipart/form-data requests through a web browser.

The following methods are exported upon request:

new($cgi)

This method creates a new CGI::Upload object. The only mandatory argument is a CGI.pm object - This is because only a single CGI.pm object can be initiated within a CGI script.
 

file_handle('field_name')

Returns the file handle to the uploaded file.
 

file_name('field_name')

Returns the filename of the uploaded file as supplied by the client web browser - This filename does not reflect the local temporary filename of the uploaded file.
 

file_type('field_name')

Returns the file type of the uploaded file as indicated by the file extension - This does not necessarily reflect the nature of the file uploaded, but allows CGI scripts to perform cursory validation on the file uploaded.
 

mime_magic('/path/to/mime.types')

This method sets and/or returns the external magic mime types file to be used for identification of files via the mime_type method. By default, identification is based upon internal mime types defined within the File::MMagic module.
 

mime_type('field_name')

Returns the file type of the uploaded file as indicated by the file magic numbers. This is the best means by which to validate the nature of the uploaded file.

 

Code updated to include Exporter - Thanks gellyfish++

package CGI::Upload;

use Carp;
use Exporter;
use File::Basename;
use File::MMagic;
use IO::File;

use strict;
use vars qw/ $VERSION @ISA @EXPORT @EXPORT_OK /;

@ISA = qw/ Exporter /;

@EXPORT_OK = qw/ file_handle file_name file_type mime_magic mime_type 
+/;

$VERSION = '1.0';


sub _handle_file {
    my $self = shift;
    my ($cgi, $param) = @_;

    my $mime_magic = $self->mime_magic;
    my $magic =
        ( length $mime_magic ) ?
        File::MMagic->new( $mime_magic ) :
        File::MMagic->new;

    my @file = fileparse($cgi->param($param), '\..*');

    return undef unless $file[0];

    my $fh = IO::File->new_tmpfile;
    my $buffer;
    while (read($cgi->param($param), $buffer, 1024)) {
        $fh->write($buffer, length($buffer));
    }
    $fh->seek(0, 0);

    my $object = {
        'file_handle'   =>  $fh,
        'file_name'     =>  $file[0] . $file[2],
        'file_type'     =>  substr(lc $file[2], 1),
        'mime_type'     =>  $magic->checktype_filehandle($fh)
    };
    $fh->seek(0, 0);

    return $object;
}


sub file_handle {
    my $self = shift;
    my ($param) = @_;
    my $cgi = $self->{'_CGI'};

    return undef unless defined $cgi->param($param);

    $self->{'_PARAMS'}->{$param} = $self->_handle_file( $cgi, $param)
        unless exists $self->{'_PARAMS'}->{$param};

    return $self->{'_PARAMS'}->{$param}->{'file_handle'};
}


sub file_name {
    my $self = shift;
    my ($param) = @_;
    my $cgi = $self->{'_CGI'};

    return undef unless defined $cgi->param($param);

    $self->{'_PARAMS'}->{$param} = $self->_handle_file( $cgi, $param)
        unless exists $self->{'_PARAMS'}->{$param};

    return $self->{'_PARAMS'}->{$param}->{'file_name'};
}


sub file_type {
    my $self = shift;
    my ($param) = @_;
    my $cgi = $self->{'_CGI'};

    return undef unless defined $cgi->param($param);

    $self->{'_PARAMS'}->{$param} = $self->_handle_file( $cgi, $param)
        unless exists $self->{'_PARAMS'}->{$param};

    return $self->{'_PARAMS'}->{$param}->{'file_type'};
}


sub mime_magic {
    my $self = shift;
    my ($magic) = @_;
    if (defined $magic) {
        $self->{'_MMAGIC'} = $magic if -e $magic;
    }
    return $self->{'_MMAGIC'};
}


sub mime_type {
    my $self = shift;
    my ($param) = @_;
    my $cgi = $self->{'_CGI'};

    return undef unless defined $cgi->param($param);

    $self->{'_PARAMS'}->{$param} = $self->_handle_file( $cgi, $param)
        unless exists $self->{'_PARAMS'}->{$param};

    return $self->{'_PARAMS'}->{$param}->{'mime_type'};
}


sub new {
    my $class = shift;
    $class = ref $class if ref $class;

    my ($cgi) = @_;
    unless (( defined $cgi ) && ( $cgi->isa('CGI') )) {
        croak( "CGI::Upload->new : Single argument to method should be
+ CGI.pm object" );
    }
    my $self = bless {
        '_CGI'      =>  $cgi,
        '_MMAGIC'   =>  '',
        '_PARAMS'   =>  {}
    }, $class;
    return $self;
}


1;


__END__

Comment on CGI::Upload - CGI class for handling browser file uploads
Download Code
Re: CGI::Upload - CGI class for handling browser file uploads
by gellyfish (Monsignor) on Mar 10, 2002 at 14:33 UTC

    Looks nice, but there is one small niggle - you have:

    use vars qw/ $VERSION @ISA @EXPORT @EXPORT_OK /; @EXPORT_OK = qw/ file_handle file_name file_type mime_magic mime_type/ +;
    However you neither require Exporter nor do @ISA = qw/Exporter/ so you will have trouble if someone does:
    use CGI::Upload qw(file_name);
    Update Glad to be of help, only sad I've run out of votes today :)

    /J\

Re: CGI::Upload - CGI class for handling browser file uploads
by princepawn (Parson) on Mar 10, 2002 at 19:30 UTC
    Hmmm, care to take over/update my CPAN module HTTP::File?

    I have become far more a chess player than a Perl programmer thanks to this economy!

Re: CGI::Upload - CGI class for handling browser file uploads
by Anonymous Monk on Mar 11, 2002 at 00:36 UTC
    Hi, would someone please be kind and post an example cgi script that uses this nice module for uploading?
      The following is a quick modification of an older script which I've now rewritten to use the CGI::Upload module - This little script will accept uploaded files of a specified mime type, in this example image/gif, and send them through to the email address specified.

      #!/usr/bin/perl -Tw use EMAIL => 'user@yourdomain.com'; use SERVER => 'mail.yourdomain.com'; use CGI; use CGI::Upload; use Mail::Mailer; use Net::SMTP; use strict; my $cgi = CGI->new; my $upload = CGI::Upload->new( $cgi ); if ( $upload->mime_type('upload') eq 'image/gif' ) { my $mail = Mail::Mailer->new( 'smtp', Server => SERVER ); $mail->open({ 'To' => EMAIL, 'From' => 'root@yourdomain.com' }); my $buffer; my @results; my $fh = $upload->file_handle('upload'); while (read($fh, $buffer, 45)) { push (@results, pack("u", $buffer)); } $fh->close; print $mail join "", "begin 600 " . $upload->file_name('upload') . "\n", @results, "end\n\n"; $mail->close; } print STDOUT $cgi->redirect( $ENV{'HTTP_REFERER'} ); exit 0;

       

      perl -e 's&&rob@cowsnet.com.au&&&split/[@.]/&&s&.com.&_&&&print'

Re: CGI::Upload - CGI class for handling browser file uploads
by miyagawa (Chaplain) on Mar 12, 2002 at 11:16 UTC
    I've made a module with exactly the same name once in a while. CGI-Upload-0.01.tar.gz...

    And I remember CGI::Upload was once registered on CPAN modules list with me the author. (But I thought my CGI::Upload implementation was not enough to publish, so had kept it hidden on the list).

    You can go your way, but mine also handles MacIE's macbinary stuff automagicaly. So give it a shot before uploading it to CPAN.

    --
    Tatsuhiko Miyagawa
    miyagawa@cpan.org

Re: CGI::Upload - CGI class for handling browser file uploads
by $code or die (Deacon) on Mar 12, 2002 at 15:14 UTC

    Looks really good. I really like the interface.

    I'm curious though, CGI->upload() returns a filehandle, so does CGI->param() for that matter. I am wondering why in _handle_file() you read from this filehandle and write to a new tempfile so you can provide your own filehandle. Wouldn't it be easier to use the filehandle the CGI.pm provides?

    One more thing, if you do need the new filhandle do you need to binmode() it for compatability?

    ___ Simon Flack ($code or die)
    $,=reverse'"ro_';s,$,\$,;s,$,lc ref sub{},e;$,
    =~y'_"' ';eval"die";print $_,lc substr$@,0,3;
      I'm curious though, CGI->upload() returns a filehandle, so does CGI->param() for that matter. I am wondering why in _handle_file() you read from this filehandle and write to a new tempfile so you can provide your own filehandle. Wouldn't it be easier to use the filehandle the CGI.pm provides?

      I have actually considered this but haven't had a chance to read through the CGI.pm in detail to see exactly how it handles its temporary files. Much of this module code has evolved from subroutines that I have used in some CGI scripts in the past.

      If anything, you might view the method I have taken as the defensive approach in the absence of any better informed opinion :-) This can also be seen in my resetting of the file pointer for the temporary file after calling the checktype_filehandle function from File::MMagic - While this resetting of the file pointer is in all likelihood unnecessary, I have included it for the sake of a "defensive" approach to this code.

      As for the binmode on the newly-created file handle, this is a very good point - Again, I will look into this and the handling of temporary files by CGI.pm and revise this code accordingly.

      Thanks again for you comments $code or die++

       

      Update - I've had a look at the implementation of temporary files within CGI.pm and at this stage, I believe I will remain with the implementation I have in the code above - This is in part because of the robustness of the POSIX-based new_tmpfile method exported from IO::File which I am quite comfortable with from a "paranoia" perspective :-)

       

      perl -e 's&&rob@cowsnet.com.au&&&split/[@.]/&&s&.com.&_&&&print'

Re: CGI::Upload - CGI class for handling browser file uploads
by NodeReaper (Curate) on Jan 02, 2005 at 02:19 UTC
    This node was taken out by the NodeReaper on Sun Jan 2 21:27:15 2005 (EST)
    Reason: [Arunbear]: Delete: Anonymous Monk has just reposted rob_au's code

    For more information on this node visit: this

Back to Code Catacombs

Log In?
Username:
Password:

What's my password?
Create A New User
Node Status?
node history
Node Type: sourcecode [id://150713]
help
Chatterbox?
and the web crawler heard nothing...

How do I use this? | Other CB clients
Other Users?
Others chanting in the Monastery: (12)
As of 2014-08-01 09:36 GMT
Sections?
Information?
Find Nodes?
Leftovers?
    Voting Booth?

    My favorite superfluous repetitious redundant duplicative phrase is:









    Results (258 votes), past polls