view release on metacpan or  search on metacpan

lib/App/Wax.pm  view on Meta::CPAN

);

has timeout => (
    is      => 'rw',
    isa     => 'Int',
    default => TIMEOUT,
    trigger => method ($timeout, $old = undef) { $self->_lwp_user_agent->timeout($timeout) },
);

has user_agent => (
    is      => 'rw',
    isa     => 'Str',
    default => USER_AGENT,
    trigger => method ($user_agent, $old = undef) { $self->_lwp_user_agent->agent($user_agent) },
);

has verbose => (
    is      => 'rw',
    isa     => 'Bool',
    default => VERBOSE,
    trigger => method ($verbose, $old = undef) { $| = 1 }, # unbuffer output
);

# log the path. if the directory doesn't exist, create it if its parent directory
# exists; otherwise, raise an error
method _check_directory ($dir) {
    $self->debug("directory: $dir");

    unless (-d $dir) {
        unless (mkdir $dir) {
            $self->log(ERROR => "Can't create directory (%s): %s", $dir, $!);
            exit E_INVALID_DIRECTORY;
        }
    }
}

# lazy constructor for the default LWP::UserAgent instance
method _build_lwp_user_agent () {
    LWP::UserAgent->new(
        env_proxy => ENV_PROXY,
        timeout   => $self->timeout,
        agent     => $self->user_agent,
        send_te   => 0,
    )
}

# set `keep` to true if --cache or --mirror are set,
# but raise an error if both are set
method _check_keep ($keep, $old = undef) {
    if ($keep && $self->cache && $self->mirror) {
        $self->log(ERROR => "--cache and --mirror can't be used together");
        exit E_INVALID_OPTIONS;
    } else {
        $self->_set_keep($keep);
    }
}

# remove temporary files
method _unlink ($unlink) {
    for my $filename (@$unlink) {
        chmod 0600, $filename; # borrowed from File::Temp (may be needed on Windows)
        $self->debug('removing: %s', $filename);
        unlink($filename) || $self->log(WARN => "Can't unlink %s: %s", $filename, $!);
    }
}

# return the URL's content-type or an empty string if the request fails
method content_type ($_url) {
    my ($url, $url_index) = @$_url;
    my $response = $self->_lwp_user_agent->head($url);
    my $content_type = '';

    if ($response->is_success) {
        # the initial (pre-semicolon) part of the mime-type, trimmed and lowercased.
        $content_type = $response->headers->content_type;

        if ($content_type) {
            $self->debug('content-type (%d): %s', $url_index, $content_type);
        } else {
            $content_type = DEFAULT_CONTENT_TYPE;
            $self->debug('content-type (%d): %s (default)', $url_index, $content_type);
        }
    }

    return $content_type;
}

# save the URL to a local filename; returns an error message if an error occurred,
# or a falsey value otherwise
method download ($_url, $filename) {
    my ($url, $url_index) = @$_url;
    my $ua = $self->_lwp_user_agent;
    my ($downloaded, $error, $response);

    if ($self->cache && (-e $filename)) {
        $downloaded = 0;
    } elsif ($self->mirror) {
        $response = $ua->mirror($url, $filename);

        if ($response->is_success) {
            $downloaded = 1;
        } elsif ($response->code == 304) {
            $downloaded = 0;
        }
    } else {
        $response = $ua->get($url, ':content_file' => $filename);

        if ($response->is_success) {
            $downloaded = 1;
        }
    }

    if (defined $downloaded) {
        $self->debug('download (%d): %s', $url_index,  ($downloaded ? 'yes' : 'no'));
    } else {
        my $status = $response->status_line;
        $error = "can't download URL #$url_index ($url) to filename ($filename): $status";
    }

    return $error;
}