view release on metacpan or  search on metacpan

lib/App/Perlbrew/HTTP.pm  view on Meta::CPAN

package App::Perlbrew::HTTP;
use strict;
use warnings;
use 5.008;

use Exporter 'import';
our @EXPORT_OK = qw(http_user_agent_program http_user_agent_command http_get http_download);

our $HTTP_VERBOSE = 0;
our $HTTP_USER_AGENT_PROGRAM;

my %commands = (
    curl => {
        test     => '--version >/dev/null 2>&1',
        get      => '--silent --location --fail -o - {url}',
        download => '--silent --location --fail -o {output} {url}',
        order    => 1,

        # Exit code is 22 on 404s etc
        die_on_error => sub { die 'Page not retrieved; HTTP error code 400 or above.' if ($_[ 0 ] >> 8 == 22); },
    },
    wget => {
        test     => '--version >/dev/null 2>&1',
        get      => '--quiet -O - {url}',
        download => '--quiet -O {output} {url}',
        order    => 2,

        # Exit code is not 0 on error
        die_on_error => sub { die 'Page not retrieved: fetch failed.' if ($_[ 0 ]); },
    },
    fetch => {
        test     => '--version >/dev/null 2>&1',
        get      => '-o - {url}',
        download => '-o {output} {url}',
        order    => 3,

        # Exit code is 8 on 404s etc
        die_on_error => sub { die 'Server issued an error response.' if ($_[ 0 ] >> 8 == 8); },
    }
);

sub http_user_agent_program {
    $HTTP_USER_AGENT_PROGRAM ||= do {
        my $program;

        for my $p (sort {$commands{$a}{order}<=>$commands{$b}{order}} keys %commands) {
            my $code = system("$p $commands{$p}->{test}") >> 8;
            if ($code != 127) {
                $program = $p;
                last;
            }
        }

        unless ($program) {
            die "[ERROR] Cannot find a proper http user agent program. Please install curl or wget.\n";
        }

        $program;
    };

    die "[ERROR] Unrecognized http user agent program: $HTTP_USER_AGENT_PROGRAM. It can only be one of: ".join(",", keys %commands)."\n" unless $commands{$HTTP_USER_AGENT_PROGRAM};

    return $HTTP_USER_AGENT_PROGRAM;
}

sub http_user_agent_command {
    my ($purpose, $params) = @_;
    my $ua = http_user_agent_program;
    my $cmd = $commands{ $ua }->{ $purpose };
    for (keys %$params) {
        $cmd =~ s!{$_}!\Q$params->{$_}\E!g;
    }

    if ($HTTP_VERBOSE) {
        unless ($ua eq "fetch") {
            $cmd =~ s/(silent|quiet)/verbose/;
        }
    }

    $cmd = $ua . " " . $cmd;
    return ($ua, $cmd) if wantarray;
    return $cmd;
}

sub http_download {
    my ($url, $path) = @_;

    if (-e $path) {
        die "ERROR: The download target < $path > already exists.\n";
    }

    my $partial = 0;
    local $SIG{TERM} = local $SIG{INT} = sub { $partial++ };

    my $download_command = http_user_agent_command(download => { url => $url, output => $path });

    my $status = system($download_command);