|
Posted by Gunnar Hjalmarsson on March 31, 2005, 10:16 pm
Please log in for more thread options
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:
http://search.cpan.org/CPAN/authors/id/G/GU/GUNNAR/CGI-UploadEasy-0.10.tar.gz
(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-> * 1024;
$CGI::DISABLE_UPLOADS = 0;
$CGITempFile::TMPDIRECTORY = $self-> if $self->;
$self-> = CGI->new;
if ( my $status = $self->->cgi_error ) {
_error($self, $status, "Post too large: "
. "Maxsize $self-> KiB exceeded.");
}
if ( $ENV eq 'POST' and
$ENV !~ /^multipart/form-datab/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-> = _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->;
}
=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->;
}
=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->;
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 or die "Unknown argument: '$_' $context.n";
$args{ $names } = shift @$ref;
}
$args 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 and $args !~ /^-?d+$/ and
die "The '-maxsize' argument shall be an integer $context.n";
%args;
}
sub _upload {
my $self = shift;
my $cgi = $self->;
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->, $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->, $name );
$i++;
}
my ($cntrname) =
$cgi->uploadInfo($TEMP)-> =~
/bname="([^"]+)"/;
$files = {
ctrlname => $cntrname,
mimetype => $cgi->uploadInfo($TEMP)->,
};
open my $OUT, '>', $path or die "Couldn't open file: $!";
if ( $files =~ /^textb/ ) {
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 = -s $path;
}
%files;
}
sub _error {
my ($self, $status, $msg) = @_;
my $cgi = $self->;
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
|
|
Posted by Gunnar Hjalmarsson on April 3, 2005, 12:27 pm
Please log in for more thread options
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
|
| Similar Threads | Posted | | Shell::Jobs - request for comments | February 12, 2005, 2:33 pm |
| Patent::Retrieve Request for Comments | February 12, 2005, 8:52 pm |
| Namespace and comments on usefulness sought | October 26, 2004, 9:52 am |
| SNMP Set Request | July 26, 2004, 8:42 pm |
| not able to fetch the request | December 28, 2005, 8:58 pm |
| Namespace request: SPC? | March 2, 2007, 10:58 am |
| http request headers | October 1, 2004, 12:47 pm |
| Help regarding HTTP::Request:POST | February 24, 2006, 11:31 pm |
| install Apache::Request problems. | July 21, 2004, 8:54 pm |
| HTTP::Request::Common::POST and UTF-8 | September 27, 2005, 12:21 pm |
|
XML Sitemap