my $res = $ua->request(HTTP::Request->new(GET => $url),
    sub {
        unless(defined $file) {

        my $res = $_[1];

        my $directory;
        if (defined $argfile && -d $argfile) {
        ($directory, $argfile) = ($argfile, undef);
        }

        unless (defined $argfile) {
        # must find a suitable name to use.  First thing
        # to do is to look for the "Content-Disposition"
        # header defined by RFC1806.  This is also supported
        # by Netscape
        my $cd = $res->header("Content-Disposition");
        if ($cd && $cd =~ /\bfilename\s*=\s*(\S+)/) {
            $file = $1;
            $file =~ s/;$//;
            $file =~ s/^([\"\'])(.*)\1$/$2/;
            $file =~ s,.*[\\/],,;  # basename
        }

        # if this fails we try to make something from the URL
        unless ($file) {
            my $req = $res->request;  # now always there
            my $rurl = $req ? $req->url : $url;

            $file = ($rurl->path_segments)[-1];
            if (!defined($file) || !length($file)) {
            $file = "index";
            my $suffix = media_suffix($res->content_type);
            $file .= ".$suffix" if $suffix;
            }
            elsif ($rurl->scheme eq 'ftp' ||
               $file =~ /\.t[bg]z$/   ||
               $file =~ /\.tar(\.(Z|gz|bz2?))?$/
            ) {
              # leave the filename as it was
            }
            else {
            my $ct = guess_media_type($file);
            unless ($ct eq $res->content_type) {
                # need a better suffix for this type
                my $suffix = media_suffix($res->content_type);
                $file .= ".$suffix" if $suffix;
            }
            }
        }

        # validate that we don't have a harmful filename now.  The ser
+ver
        # might try to trick us into doing something bad.
        if (!length($file) || $file =~ s/([^a-zA-Z0-9_\.\-\+\~])/sprin
+tf "\\x%02x", ord($1)/ge) {
          die "Will not save <$url> as \"$file\".\nPlease override fil
+e name on the command line.\n";
        }

        if (defined $directory) {
            require File::Spec;
            $file = File::Spec->catfile($directory, $file);
        }

        # Check if the file is already present
        if (-l $file) {
            die "Will not save <$url> to link \"$file\".\nPlease overr
+ide file name on the command line.\n";
        }
        elsif (-f _) {
            die "Will not save <$url> as \"$file\" without verificatio
+n.\nEither run from terminal or override file name on the command lin
+e.\n"
            unless -t;
            $shown = 1;
            print "Overwrite $file? [y] ";
            my $ans = <STDIN>;
            unless (defined($ans) && $ans =~ /^y?\n/) {
            if (defined $ans) {
                print "Ok, aborting.\n";
            }
            else {
                print "\nAborting.\n";
            }
            exit 1;
            }
            $shown = 0;
        }
        elsif (-e _) {
            die "Will not save <$url> as \"$file\".  Path exists.\n";
        }
        else {
            print "Saving to '$file'...\n";
        }
        }
        else {
        $file = $argfile;
        }

        open(FILE, ">$file") || die "Can't open $file: $!\n";
        binmode FILE;
        $length = $res->content_length;
        $flength = fbytes($length) if defined $length;
        $start_t = time;
        $last_dur = 0;
    }

    print FILE $_[0] or die "Can't write to $file: $!\n";
    $size += length($_[0]);

    if (defined $length) {
        my $dur  = time - $start_t;
        if ($dur != $last_dur) {  # don't update too often
        $last_dur = $dur;
        my $perc = $size / $length;
        my $speed;
        $speed = fbytes($size/$dur) . "/sec" if $dur > 3;
        my $secs_left = fduration($dur/$perc - $dur);
        $perc = int($perc*100);
        my $show = "$perc% of $flength";
        $show .= " (at $speed, $secs_left remaining)" if $speed;
        show($show, 1);
        }
    }
    else {
        show( fbytes($size) . " received");
    }
    }
    );
[download]