Apache-Upload-Slurp
view release on metacpan or search on metacpan
0.03 (2007-11-30)
- Find a little type error and solved
0.02 (2006-06-30)
- Now slurp has executed when methods has called and not during creation of the object
- Add upload method that return the upload info of only one upload form field.
0.01 (2006-06-29)
- First public release
Makefile.PL view on Meta::CPAN
my %makeconf = (
NAME => "Apache::Upload::Slurp",
VERSION_FROM => "Slurp.pm",
PREREQ_PM => {
'Apache' => 0,
'Test::More' => 0,
},
($] >= 5.005 ?
(
ABSTRACT => "Component to slurp all uploaded file via Apache",
AUTHOR => "Emiliano Bruni <info\@ebruni.it>") : ()),
clean => {
FILES => "@CLEAN_FILES"
},
);
if ($mp_version == 2) {
# 1.9922 is 2.0.0 RC5. mod_perl package renames happend at this release.
$makeconf{PREREQ_PM}{mod_perl2} = '1.9922';
$makeconf{PREREQ_PM}{CGI} = '3.12';
=head1 NAME
Apache::Upload::Slurp - Component to slurp all uploaded file
=head1 SYNOPSIS
use Apache::Upload::Slurp ();
my $obj = new Apache::Upload::Slurp;
my $uploads = $obj->uploads;
=head1 DESCRIPTION
I<Apache::Upload::Slurp> put all uploaded files via
I<application/x-www-form-urlencoded> and their information in an array
to be simply process by clients.
=head1 METHODS
=head2 new
Create a new I<Apache::Upload::Slurp> object and process uploads
my $obj = new Apache::Upload::Slurp;
=cut
package Apache::Upload::Slurp;
use strict;
use warnings;
sub new {
my $package = shift;
my $attribs = shift || {};
my $self = bless $attribs, $package;
return $self;
}
sub _slurp {
my $self = shift;
$self->{uploads} = {};
my $r = Apache::Request->instance( Apache->request );
for (my $upload = $r->upload; $upload; $upload = $upload->next) {
my $file_info = {};
my $fh = $upload->fh;
if (defined $fh) {
my $binary;
while (<$fh>) {
$binary .= $_;
}
$file_info->{data} = $binary;
$file_info->{filename} = $upload->filename;
$file_info->{size} = $upload->size;
$file_info->{name} = $upload->name;
$file_info->{type} = $upload->type;
my $info = $upload->info;
while (my($key, $val) = each %$info) {
$file_info->{$key} = $val;
}
$self->{uploads}->{$file_info->{name}} = $file_info;
}
}
}
sub _slurp_single {
my $self = shift;
my $upload_name = shift;
return $self->{uploads}->{$upload_name}
if (exists $self->{uploads}->{$upload_name});
my $r = Apache::Request->instance( Apache->request );
my $upload = $r->upload($upload_name);
my $file_info = {};
my $fh = $upload->fh;
if (defined $fh) {
my $binary;
while (<$fh>) {
$binary .= $_;
}
$file_info->{data} = $binary;
$file_info->{filename} = $upload->filename;
# IE add all path to filename, remove it
$file_info->{filename} =~ s/\w\:\\(.+\\)*//;
$file_info->{size} = $upload->size;
$file_info->{name} = $upload->name;
$file_info->{type} = $upload->type;
my $info = $upload->info;
while (my($key, $val) = each %$info) {
$file_info->{$key} = $val;
}
$self->{uploads}->{$file_info->{name}} = $file_info;
return $file_info;
}
}
=pod
=head2 uploads
Return an array or an arrayref with an hashref for every file uploaded.
The hashref has this structure:
=over 4
=item * data
The binary stream of the file
=item * filename
The filename from the client point of view
=item * size
The size of the uploaded file
=item * name
The name of the form field that uploaded file.
=item * type
The content type of the uploaded file.
=item * other keys
From the additional header information for the uploaded file
=back
=cut
sub uploads {
my $self = shift;
$self->_slurp;
my @uploads = values %{$self->{uploads}};
return wantarray ? @uploads : \@uploads;
}
=head2 upload(form_name)
Return an hash or hashref (based on contest) with infos for the single upload
The hashref has this structure:
=over 4
=item * data
The binary stream of the file
=item * filename
The filename from the client point of view
=item * size
The size of the uploaded file
=item * name
The name of the form field that uploaded file.
=item * type
The content type of the uploaded file.
=item * other keys
From the additional header information for the uploaded file
=back
=cut
sub upload {
my $self = shift;
my $upload_name = shift;
my $ret = $self->_slurp_single($upload_name);
return wantarray ? %$ret : $ret;
}
1;
=pod
=head1 LICENSE
Apache::Upload::Slurp - Component to slurp all uploaded file
Copyright (C) 2006 Bruni Emiliano <info AT ebruni DOT it>
This module is free software; you can redistribute it and/or modify it under the terms of
either:
a) the GNU General Public License as published by the Free Software Foundation;
either version 2, or (at your option) any later version, or
b) the "Artistic License" which comes with this module.
( run in 1.533 second using v1.01-cache-2.11-cpan-b16cb0d3907 )