view release on metacpan or  search on metacpan

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

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

# helper for `dump_command`: escape/quote a shell argument on POSIX shells
fun _escape ($arg) {
    # https://stackoverflow.com/a/1250279
    # https://github.com/boazy/any-shell-escape/issues/1#issuecomment-36226734
    $arg =~ s!('{1,})!'"$1"'!g;
    $arg = "'$arg'";
    $arg =~ s{^''|''$}{}g;

    return $arg;
}

method _use_default_directory () {
    # "${XDG_CACHE_HOME:-$HOME/.cache}/wax"
    require File::BaseDir;
    $self->directory(File::BaseDir::cache_home($self->app_name));
}

# print the version and exit
method _dump_version () {
    print $VERSION, $/;
    exit 0;
}

# log a message to stderr with the app's name and message's log level
method log ($level, $template, @args) {
    my $name = $self->app_name;
    my $message = @args ? sprintf($template, @args) : $template;
    warn "$name: $level: $message", $/;
}

# return a best-effort guess at the URL's file extension based on its content
# type, e.g. ".md" or ".tar.gz", or an empty string if one can't be determined.
# XXX note: makes a network request to determine the content type
method extension ($_url) {
    my ($url, $url_index) = @$_url;
    my $extension = '';
    my $split = $self->is_url($url);

    return $extension unless ($split);

    my ($scheme, $domain, $path, $query, $fragment) = @$split;
    my $content_type = $self->content_type($_url);

    return $extension unless ($content_type); # won't be defined if the URL is invalid

    if (INFER_EXTENSION->{$content_type}) {
        # try to get a more specific extension from the path
        if (not(defined $query) && $path && ($path =~ EXTENSION)) {
            $extension = $+;
        }
    }

    unless ($extension) {
        my $mime_type = $self->mime_types->type($content_type);
        my @extensions = $mime_type->extensions;

        if (@extensions) {
            $extension = '.' . $extensions[0];
        }
    }

    $self->debug('extension (%d): %s', $url_index, $extension);

    return $extension;
}

# return a truthy value (an arrayref containing the URL's components)
# if the supplied value can be parsed as a URL, or a falsey value otherwise
method is_url ($url) {
    if ($url =~ m{^[a-zA-Z][\w+]*://}) { # basic sanity check
        my ($scheme, $domain, $path, $query, $fragment) = uri_split($url);

        if ($scheme && ($domain || $path)) { # no domain for file:// URLs
            return [$scheme, $domain, $path, $query, $fragment];
        }
    }
}

# log a message to stderr if logging is enabled
method debug ($template, @args) {
    if ($self->verbose) {
        my $name = $self->app_name;
        my $message = @args ? sprintf($template, @args) : $template;
        warn "$name: $message", $/;
    }
}

# perform housekeeping after a download: replace the placeholder with the file
# path; push the path onto the delete list if it's a temporary file; and log any
# errors
#