httpd-apreq-dev mailing list archives

Site index · List index
Message view « Date » · « Thread »
Top « Date » · « Thread »
From Randy Kobes <ra...@theoryx5.uwinnipeg.ca>
Subject Re: Problem use Apache::Upload
Date Fri, 30 Jul 2004 14:49:52 GMT
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

Mime
View raw message