CGI::UploadEasy - request for comments

Hi all,

Judging from questions to these groups and other similar forums, one
area where beginners often encounter difficulties is file uploads. The
just uploaded CPAN module CGI::UploadEasy is an attempt to help prevent
possible hazzle with upload scripts.

<Quoted from README>
CGI::UploadEasy is a wrapper around, and relies heavily on, CGI.pm.
Its purpose is to provide a simple interface to the upload
functionality of CGI.pm.

At creation of the CGI::UploadEasy object, the module saves one or
more files from a file upload request in the upload directory, and
information about uploaded files is made available via the fileinfo()
method. CGI::UploadEasy performs a number of tests, which limit the
risk that you encounter difficulties when developing a file upload
application.
</Quoted from README>

Actually, with CGI::UploadEasy, Perl code for handling file uploads is
as easy to write as the code for ordinary CGI parsing using CGI.pm. :)

Any kind of comments on the module would be much appreciated.

CGI::UploadEasy is available at CPAN:
[url]http://search.cpan.org/CPAN/authors/id/G/GU/GUNNAR/CGI-UploadEasy-0.10.tar.gz[/url
]
(but not yet via "perl -MCPAN -e shell") and to make it easy to acquaint
oneself with it, I wrote this script:
http://www.gunnar.cc/programs/upload.pl.txt

The whole UploadEasy.pm file follows below. ( Yes, I know, 300
additional lines, but it's with the aim of facilitating comments on
details in the code or POD... ;-) )

Thanks in advance!


 ++++++++++++++++++++++++++++++++++++++++
+++++++++++++

package CGI::UploadEasy;

use 5.006;
use strict;
use warnings;
use CGI 2.76;
use File::Spec;

our $VERSION = '0.10';
# $Id: UploadEasy.pm,v 1.1.1.1 2005/03/31 15:21:01 gunnarh Exp $

=head1 NAME

CGI::UploadEasy - Facilitate file uploads

=head1 SYNOPSIS

use CGI::UploadEasy;
my $ue = CGI::UploadEasy->new(-uploaddir => '/path/to/upload/dir');
my $cgi = $ue->cgiobject;
my $info = $ue->fileinfo;

=head1 DESCRIPTION

C<CGI::UploadEasy> is a wrapper around, and relies heavily on,
L<CGI.pm|CGI>. Its purpose is to provide a simple interface to the
upload functionality of C<CGI.pm>.

At creation of the C<CGI::UploadEasy> object, the module saves one or
more files from a file upload request in the upload directory, and
information about uploaded files is made available via the B<fileinfo()>
method. C<CGI::UploadEasy> performs a number of tests, which limit the
risk that you encounter difficulties when developing a file upload
application.

=head2 Methods

=cut

sub new {
my $class = shift;
my $self = {
maxsize => 1000,
_argscheck( \@_ ),
};

$CGI::POST_MAX = $self->{maxsize} * 1024;
$CGI::DISABLE_UPLOADS = 0;
$CGITempFile::TMPDIRECTORY = $self->{tempdir} if $self->{tempdir};
$self->{cgi} = CGI->new;
if ( my $status = $self->{cgi}->cgi_error ) {
_error($self, $status, "Post too large: "
. "Maxsize $self->{maxsize} KiB exceeded.");
}

if ( $ENV{REQUEST_METHOD} eq 'POST' and
$ENV{CONTENT_TYPE} !~ /^multipart\/form-data\b/i ) {
_error($self, '400 Bad Request', 'The content-type at file '
. "uploads shall be 'multipart/form-data'.<br />\nMake "
. "sure that the 'FORM' tag includes the "
. 'attribute: enctype="multipart/form-data"');
}

$self->{files} = _upload($self);

bless $self, $class;
}

=over 4

=item B<my $ue = CGI::UploadEasy-E<gt>new( -uploaddir =E<gt> $dir [ ,
-maxsize =E<gt> $kibibytes, ... ] )>

The B<new()> constructor takes hash style arguments. The following
arguments are recognized:

=over 4

=item B<-uploaddir>

Specifying the upload directory is mandatory.

=item B<-tempdir>

To control which directory will be used for temporary files, set the
-tempdir argument.

=item B<-maxsize>

Specifies the maximum size in KiB (kibibytes) of a POST request data
set. -maxsize is 1,000 KiB by default. To disable this ceiling for POST
requests, give -maxsize a negative value.

=back

=back

=cut

sub cgiobject {
my $self = shift;
$self->{cgi};
}

=over 4

=item B<$ue-E<gt>cgiobject>

Returns a reference to the C<CGI> object that C<CGI::UploadEasy> uses
internally, which gives access to all the L<CGI.pm|CGI> methods.

If you prefer the function-oriented style, you can import a set of
methods instead. Example:

use CGI qw/:standard/;
print header;

=back

=cut

sub fileinfo {
my $self = shift;
my ($file, $line) = (caller)[1,2];
if ( @_ ) { die "The 'fileinfo' method does not take arguments ",
"at $file line $line.\n" }
$self->{files};
}

=over 4

=item B<$ue-E<gt>fileinfo>

Returns a reference to a 'hash of hashes' with info about uploaded
files. The info may be of use for a result page and/or an email
notification, and it lets you use e.g. MIME type and file size as
criteria for how to further process the files.

=back

=cut

sub otherparam {
my $self = shift;
my ($file, $line) = (caller)[1,2];
if ( @_ ) { die "The 'otherparam' method does not take ",
"arguments--use CGI.pm's 'param' method to access values at ",
"$file line $line.\n" }
my $cgi = $self->{cgi};
grep { ! ref $cgi->param($_) and $cgi->param($_) } $cgi->param;
}

=over 4

=item B<$ue-E<gt>otherparam>

The B<otherparam()> method returns a list of parameter names
representing POSTed data besides uploaded files. To access the values,
use L<CGI.pm's|CGI> B<param()> method.

=back

=cut

sub _argscheck {
my $ref = shift;
my %args;
my %names = (
-uploaddir => 'uploaddir',
-tempdir   => 'tempdir',
-maxsize   => 'maxsize',
);
my $context = sprintf 'at %s line %s', (caller 1)[1,2];

@$ref % 2 == 0 and @$ref > 0 or die 'One or more name=>argument '
. 'pairs are expected at the creation of the CGI::UploadEasy '
. "object $context.\n";

while ( local $_ = shift @$ref ) {
my $name = lc;
$names{$name} or die "Unknown argument: '$_' $context.\n";
$args{ $names{$name} } = shift @$ref;
}
$args{uploaddir} or die "The compulsory argument '-uploaddir' is "
. "missing $context.\n";

for my $dir ( @args{ grep exists $args{$_},
qw/uploaddir tempdir/ } ) {
-d $dir or die "Can't find any directory '$dir' $context.\n";
-r $dir and -w _ and -x _ or die 'The user this script runs as '
. "does not have write access to '$dir' $context.\n";
}
$args{maxsize} and $args{maxsize} !~ /^-?\d+$/ and
die "The '-maxsize' argument shall be an integer $context.\n";

%args;
}

sub _upload {
my $self = shift;
my $cgi = $self->{cgi};
my %files;

for my $TEMP ( map $cgi->upload($_), $cgi->param ) {
( my $name = $TEMP ) =~ s#.*[\]:\\/]##;
$name =~ tr/ /_/ unless $^O eq 'MSWin32';
$name =~ tr/-+@a-zA-Z0-9. /_/cs;
($name) = $name =~ /^([-+@\w. ]+)$/;
my $path = File::Spec->catfile( $self->{uploaddir}, $name );

# don't overwrite file with same name
my $i = 2;
while (1) {
last unless -e $path;
$name =~ s/([^.]+?)(?:_\d+)?(\.|$)/$1_$i$2/;
$path = File::Spec->catfile( $self->{uploaddir}, $name );
$i++;
}

my ($cntrname) =
$cgi->uploadInfo($TEMP)->{'Content-Disposition'} =~
/\bname="([^"]+)"/;
$files{$name} = {
ctrlname => $cntrname,
mimetype => $cgi->uploadInfo($TEMP)->{'Content-Type'},
};

open my $OUT, '>', $path or die "Couldn't open file: $!";
if ( $files{$name}{mimetype} =~ /^text\b/ ) {
binmode $TEMP, ':crlf';
print $OUT $_ while <$TEMP>;
} else {
binmode $OUT, ':raw';
while ( read $TEMP, my $buffer, 1024 ) {
print $OUT $buffer;
}
}
close $TEMP or die $!;  # so the temporary file gets deleted
close $OUT or die $!;   # so file size can be grabbed below

$files{$name}{bytes} = -s $path;
}

\%files;
}

sub _error {
my ($self, $status, $msg) = @_;
my $cgi = $self->{cgi};
print $cgi->header(-status => $status),
$cgi->start_html(-title => "Error $status"),
$cgi->h1('Error'),
$cgi->tt($msg),
$cgi->end_html;
exit 1;
}

1;

__END__

=head1 EXAMPLE

This script handles a file upload request by saving a number of files
in the upload directory and printing the related info:

#!/usr/bin/perl -T
use strict;
use warnings;
use CGI::UploadEasy;
use Data::Dumper;
my $ue = CGI::UploadEasy->new(-uploaddir => '/path/to/upload/dir');
my $info = $ue->fileinfo;
my $cgi = $ue->cgiobject;
print $cgi->header('text/plain');
print Dumper $info;

=head1 CAVEATS

Since C<CGI::UploadEasy> is meant for file uploads, it requires that the
request data is C<multipart/form-data> encoded. An
C<application/x-www-form-urlencoded> POST request will cause a fatal
error.

No C<CGI> object may be created before the C<CGI::UploadEasy> object has
been created, or else the upload will fail. Likewise, if you import
method names from C<CGI.pm>, be careful not to call any C<CGI> functions
before the creation of the C<CGI::UploadEasy> object.

=head1 AUTHOR, COPYRIGHT AND LICENSE

Copyright © 2005 Gunnar Hjalmarsson
http://www.gunnar.cc/cgi-bin/contact.pl

This module is free software; you can redistribute it and/or modify it
under the same terms as Perl itself.

=head1 SEE ALSO

L<CGI.pm|CGI>

=cut


--
Gunnar Hjalmarsson
Email: http://www.gunnar.cc/cgi-bin/contact.pl


--
PLEASE NOTE: comp.infosystems.www.authoring.cgi is a
SELF-MODERATED newsgroup. aa.net and boutell.com are
NOT the originators of the articles and are NOT responsible
for their content.

HOW TO POST to comp.infosystems.www.authoring.cgi:
http://www.thinkspot.net/ciwac/howtopost.html

At March 31 Gunnar Hjalmarsson wrote:
>
> CGI::UploadEasy is an attempt to help prevent possible hazzle with
> upload scripts.
>
> CGI::UploadEasy is a wrapper around, and relies heavily on, CGI.pm.
> Its purpose is to provide a simple interface to the upload
> functionality of CGI.pm.

I found a bug, so a new version (0.11) has been uploaded to CPAN.

> Any kind of comments on the module would be much appreciated.
> ...
> to make it easy to acquaint oneself with it, I wrote this script:
> http://www.gunnar.cc/programs/upload.pl.txt

After the bug fix, and if nobody tells me otherwise, I take it that I
wrote TPPM (The Perfect Perl Module). ;-)

--
Gunnar Hjalmarsson
Email: http://www.gunnar.cc/cgi-bin/contact.pl

--
PLEASE NOTE: comp.infosystems.www.authoring.cgi is a
SELF-MODERATED newsgroup. aa.net and boutell.com are
NOT the originators of the articles and are NOT responsible
for their content.

HOW TO POST to comp.infosystems.www.authoring.cgi:
http://www.thinkspot.net/ciwac/howtopost.html