upload of large files...
Mariano Vazquez <[email protected]> Wed, 2 Jul 2003 16:18:01 +0200
| Newsgroups | gmane.comp.windows.devel.soap.general |
|---|---|
| Message-ID | <[email protected]> |
hi all,
i know that this is a problem that is broadcasted VERY VERY often... but
well, it should be
easier to implement!!
i have been googling this problem and i have been trying some of the
solutions proposed,
but it doesn't work at all...
i would love to upload files without loading it in my machine memory, or
doing it by chunks.
i post below my piece of code... it simply flies, without doing
anything. without even starting
the request, with no error. it just pass by, like a seagull...
could somebody kindly help me...???
thanks a lot
mariano
================
use strict;
use HTTP::Request;
use HTTP::Request::Common;
use HTTP::Request::Common qw(POST $DYNAMIC_FILE_UPLOAD);
use HTML::Entities;
use HTML::HeadParser;
use HTML::Parser;
use HTTP::Date;
use HTTP::Headers;
use HTTP::Message;
use HTTP::Response;
use HTTP::Status;
use LWP;
use LWP::Protocol;
use LWP::UserAgent;
use URI;
use URI::Escape;
use URI::URL;
my $URL_ = "http://10.20.30.40:7181/images/hp.bmp";
my $file_ ="c:\\hp.bmp";
my $usr = "username";
my $pwd = "password";
{
my $file = $file_;
my $tfile = "-";
#
# Set to use dyn file uploading for largish files (> 5K)
#
$DYNAMIC_FILE_UPLOAD = 1; # if ((-s $file) > 5120);
{
# Creates some kind of magical munging for the URL string given
my $URI = new URI::URL($URL_);
my $UA = new LWP::UserAgent;
# Set up the user/password for the access realm
$UA->credentials($URI->netloc,
"Basic",
$usr,
$pwd
);
# Actual request made to the remote host
my $request = POST ($URI,
Content_Type => 'form-data',
Content => [ input_file => [$file],]);
$request->authorization_basic($usr,$pwd);
# Make sure we have a content length
unless (defined $request->content_length)
{
print("-- ENTRA--\n");
my $code = $request->content;
# create anonymous temporary file
my $tmpfile = "c:\\tmp\\form-data-content-$$";
my $fh = gensym;
unless (open($fh, "+>$tmpfile"))
{
die "Can't create $tmpfile: $!";
}
unless (unlink($tmpfile))
{
die "Can't unlink $tmpfile";
}
# fill it with data
my $chunk;
my $size = 0;
while (defined($chunk = &$code) && length($chunk))
{
print $fh $chunk;
$size += length($chunk);
}
unless (seek($fh, 0, 0))
{
die "Can't rewind: $!";
}
# Update request
$request->content_length($size);
# Update content as a closure that reads the file back
$request->content(sub {
my $buf = "";
my $n = read($fh, $buf, 1024);
unless (length $buf)
{
seek($fh, 0, 0);
}
$buf;
});
}
}
}