httpd-apreq-dev mailing list archives

Site index · List index
Message view « Date » · « Thread »
Top « Date » · « Thread »
From "Keith C. Perry" <netad...@vcsn.com>
Subject Re: Problem use Apache::Upload
Date Fri, 30 Jul 2004 16:27:54 GMT
Quoting Randy Kobes <randy@theoryx5.uwinnipeg.ca>:

> On Fri, 30 Jul 2004, Keith C. Perry wrote:
> 
> [ ... ]
> > Now, I tried...
> >
> > my $upload = $req->upload('sentfile');
> > my $fname  = $upload->filename('origname');
> >
> > I get this error...
> >
> > [Fri Jul 30 09:40:12 2004] [error] Can't call method
> > "filename" on an undefined value at /www/local/upload.mpl
> > line 18.\n
> 
> It seems then that $req isn't getting created. I take
> it that this is a ModPerl::Registry script? Here's an
> example for your form
> 
> ==============================================================
> <!DOCTYPE HTML PUBLIC "-//W3C//DTD HTML 4.01 Transitional//EN"
>  "http://www.w3.org/TR/html4/loose.dtd">
> <html>
> <head>
> <title>File Upload</title>
> </head>
> <body>
> <form name="uploadform"
>    action="/perl/upload.pl?method=fh;has_md5=1"
>    method="post" enctype="multipart/form-data"><br>
> <input name="sentfile" type="file">
> <input value="Send File" type="submit">
> </form>
> </body>
> </html>
> ==============================================================
> where /perl is handled by ModPerl::Registry, and the script
> upload.pl (adapted from upload.pm in the httpd-apreq-2 test
> in glue/perl/t/response/TestApReq/) takes a "method" arg
> (one of slurp, fh, tempname, link, or io) which chooses
> how you want to handle the upload:
> ===============================================================
> # file upload.pl
> use strict;
> use warnings FATAL => 'all';
> 
> use Apache::RequestRec;
> use Apache::RequestIO;
> use Apache::Request ();
> use Apache::Upload;
> use File::Spec;
> require File::Basename;
> 
> my $r = shift;
> my $req = Apache::Request->new($r);
> my $temp_dir = File::Spec->tmpdir;
> 
> my $method  = $req->args('method');
> my $has_md5  = $req->args('has_md5');
> require Digest::MD5 if $has_md5;
> my $upload = $req->upload('sentfile');
> my $type = $upload->type;
> my $basename = File::Basename::basename($upload->filename);
> my ($data, $fh);
> 
> if ($method eq 'slurp') {
>     $upload->slurp($data);
> }
> elsif ($method eq 'fh') {
>     read $upload->fh, $data, $upload->size;
> }
> elsif ($method eq 'tempname') {
>     my $name = $upload->tempname;
>     open $fh, "<", $name or die "Can't open $name: $!";
>     binmode $fh;
>     read $fh, $data, $upload->size;
>     close $fh;
> }
> elsif ($method eq 'link') {
>     my $link_file = File::Spec->catfile($temp_dir, "linkfile");
>     unlink $link_file if -f $link_file;
>     $upload->link($link_file) or die "Can't link to $link_file: $!";
>     open $fh, "<", $link_file or die "Can't open $link_file: $!";
>     binmode $fh;
>     read $fh, $data, $upload->size;
>     close $fh;
>     unlink $link_file if -f $link_file;
> }
> elsif ($method eq 'io') {
>     read $upload->io, $data, $upload->size;
> }
> else  {
>     die "unknown method: $method";
> }
> 
> my $temp_file = File::Spec->catfile($temp_dir, $basename);
> unlink $temp_file if -f $temp_file;
> open my $wfh, ">", $temp_file or die "Can't open $temp_file: $!";
> binmode $wfh;
> print $wfh $data;
> close $wfh;
> my $cs = $has_md5 ? cs($temp_file) : 0;
> 
> $req->content_type('text/plain');
> my $size = -s $temp_file;
> $r->print(<<END);
> 
> type: $type
> size: $size
> filename: $basename
> md5: $cs
> END
> 
> unlink $temp_file if -f $temp_file;
> 
> sub cs {
>     my $file = shift;
>     open my $fh, '<', $file or die qq{Cannot open "$file": $!};
>     binmode $fh;
>     my $md5 = Digest::MD5->new->addfile($fh)->hexdigest;
>     close $fh;
>     return $md5;
> }
> ===================================================================
> 
> -- 
> best regards,
> randy kobes
> 

Whoa, Randy thanks a lot man.  I'm going to hold onto this script since more
functional.  Much appreciated!

-- 
Keith C. Perry, MS E.E.
Director of Networks & Applications
VCSN, Inc.
http://vcsn.com
 
____________________________________
This email account is being host by:
VCSN, Inc : http://vcsn.com

Mime
View raw message