Beefy Boxes and Bandwidth Generously Provided by pair Networks
Syntactic Confectionery Delight
 
PerlMonks  

Comment on

( #3333=superdoc: print w/ replies, xml ) Need Help??
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__

In reply to CGI::Upload - CGI class for handling browser file uploads by rob_au

Title:
Use:  <p> text here (a paragraph) </p>
and:  <code> code here </code>
to format your post; it's "PerlMonks-approved HTML":



  • Posts are HTML formatted. Put <p> </p> tags around your paragraphs. Put <code> </code> tags around your code and data!
  • Read Where should I post X? if you're not absolutely sure you're posting in the right place.
  • Please read these before you post! —
  • Posts may use any of the Perl Monks Approved HTML tags:
    a, abbr, b, big, blockquote, br, caption, center, col, colgroup, dd, del, div, dl, dt, em, font, h1, h2, h3, h4, h5, h6, hr, i, ins, li, ol, p, pre, readmore, small, span, spoiler, strike, strong, sub, sup, table, tbody, td, tfoot, th, thead, tr, tt, u, ul, wbr
  • Outside of code tags, you may need to use entities for some characters:
            For:     Use:
    & &amp;
    < &lt;
    > &gt;
    [ &#91;
    ] &#93;
  • Link using PerlMonks shortcuts! What shortcuts can I use for linking?
  • See Writeup Formatting Tips and other pages linked from there for more info.
  • Log In?
    Username:
    Password:

    What's my password?
    Create A New User
    Chatterbox?
    and the web crawler heard nothing...

    How do I use this? | Other CB clients
    Other Users?
    Others examining the Monastery: (10)
    As of 2014-12-20 05:20 GMT
    Sections?
    Information?
    Find Nodes?
    Leftovers?
      Voting Booth?

      Is guessing a good strategy for surviving in the IT business?





      Results (95 votes), past polls