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:
|
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__ |
|
---|
Replies are listed 'Best First'. | |
---|---|
Re: CGI::Upload - CGI class for handling browser file uploads
by gellyfish (Monsignor) on Mar 10, 2002 at 14:33 UTC | |
Re: CGI::Upload - CGI class for handling browser file uploads
by miyagawa (Chaplain) on Mar 12, 2002 at 11:16 UTC | |
Re: CGI::Upload - CGI class for handling browser file uploads
by $code or die (Deacon) on Mar 12, 2002 at 15:14 UTC | |
by rob_au (Abbot) on Mar 12, 2002 at 22:56 UTC | |
Re: CGI::Upload - CGI class for handling browser file uploads
by princepawn (Parson) on Mar 10, 2002 at 19:30 UTC | |
Re: CGI::Upload - CGI class for handling browser file uploads
by Anonymous Monk on Mar 11, 2002 at 00:36 UTC | |
by rob_au (Abbot) on Mar 11, 2002 at 03:27 UTC |
Back to
Code Catacombs