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;
                              });
        }
        }
}