view release on metacpan or  search on metacpan

lib/App/Fetchware/Util.pm  view on Meta::CPAN

    return $file;
}



sub download_http_url {
    my $http_url = shift;

    # Forward any other options over to HTTP::Tiny. This is used mostly to
    # support changing user agent strings, but why not support them all.
    my %opts = @_ if @_ % 2 == 0;

    # Append user_agent if specified.
    $opts{agent} = config('user_agent') if config('user_agent');

    my $http = HTTP::Tiny->new(%opts);
    ###BUGALERT### Should use request() instead of get, because request can
    #directly write the chunks of the file to disk as they are downloaded. get()
    #just uses RAM, so a 50Meg file takes up 50 megs of ram, and so on.
    my $response = $http->get($http_url);

#use Test::More;
#diag("RESPONSE OBJECT[");
#diag explain $response->{status};
#diag explain $response->{headers};
#diag explain $response->{url};
#diag explain $response->{reason};
#diag explain $response->{success};
## Should be commented out to avoid borking the terminal, but is needed when
## HTTP::Tiny has internal 599 errors, because the error message is in the
## content.
##diag explain $response->{content}; 
#diag("]");

    die <<EOD unless $response->{success};
App-Fetchware: run-time error. HTTP::Tiny failed to download a file or directory
listingfrom your provided url [$http_url]. HTTP status code
[$response->{status} $response->{reason}] HTTP headers
[@{[Data::Dumper::Dumper($response->{headers})]}].
See man App::Fetchware.
EOD

    # In this case the content is binary, so it will mess up your terminal.
    #diag($response->{content}) if length $response->{content};
    die <<EOD unless length $response->{content};
App-Fetchware: run-time error. The url [$http_url] you provided downloaded
nothing.  HTTP status code [$response->{status} $response->{reason}]
HTTP headers [@{[Data::Dumper::Dumper($response)]}].
See man App::Fetchware.
EOD

    # Must convert the worthless $response->{content} variable into a real file
    # on the filesystem. Note: start() should have cd()d us into a suitable
    # tempdir.
    my $path = $http_url;
    $path =~ s!^http://!!;
    # Determine filename from the $path.
    my ($volume, $directories, $filename) = splitpath($path);
    # If $filename is empty string, then its probably a index directory listing.
    $filename ||= 'index.html';
    ###BUGALERT### Need binmode() on Windows???
    ###BUGALERT### Switch to safe_open()????
    open(my $fh, '>', $filename) or die <<EOD;
App-Fetchware: run-time error. Fetchware failed to open a file necessary for
fetchware to store HTTP::Tiny's output. Os error [$!]. See perldoc
App::Fetchware.
EOD
    # Write HTTP::Tiny's downloaded file to a real file on the filesystem.
    print $fh $response->{content};
    close $fh
        or die <<EOS;
App-Fetchware: run-time error. Fetchware failed to close the file it created to
save the content it downloaded from HTTP::Tiny. This file was [$filename]. OS
error [$!]. See perldoc App::Fetchware.
EOS

    # The caller needs the $filename to determine the $package_path later.
    return $filename;
}




sub download_file_url {
    my $url = shift;

    $url =~ s!^file://!!; # Strip useless URL scheme.
    
    # Prepend original_cwd() only if the $url is *not* absolute, which will mess
    # it up.
    $url = catdir(original_cwd(), $url) unless file_name_is_absolute($url);

    # Download the file:// URL to the current directory, which should already be
    # in $temp_dir, because of start()'s chdir().
    #
    # Don't forget to clear taint. Fetchware does *not* run in taint mode, but
    # for some reason, bug?, File::Copy checks if data is tainted, and then
    # retaints it if it is already tainted, but for some reason I get "Insecure
    # dependency" taint failure exceptions when drop priving. The fix is to
    # always untaint my data as done below.
    ###BUGALERT### Investigate this as a possible taint bug in perl or just
    #File::Copy. Perhaps the cause is using File::Copy::cp(copy) after drop
    #priving with data from root?
    $url =~ /(.*)/;
    my $untainted_url = $1;
    my $cwd = cwd();
    $cwd =~ /(.*)/;
    my $untainted_cwd = $1;
    cp($untainted_url, $untainted_cwd) or die <<EOD;
App::Fetchware: run-time error. Fetchware failed to copy the download URL
[$untainted_url] to the working directory [$untainted_cwd]. Os error [$!].
EOD

    # Return just file filename of the downloaded file.
    return file($url)->basename();
}