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__
[download]