blob: b0d67242d6948c34bc15540c216b0aca6b268e42 (
plain)
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
|
package SlackBuild::URI;
use strict;
use warnings;
use URI;
use Carp;
use LWP::UserAgent;
use File::Basename;
use File::Spec;
use Log::Log4perl;
use SlackBuild::Download;
# use LWP::Protocol::https;
# use LWP::Protocol::file;
# use LWP::Protocol::ftp;
our $AUTOLOAD;
sub AUTOLOAD {
my $self = shift;
# The Perl interpreter places the name of the
# message in a variable called $AUTOLOAD.
# DESTROY messages should never be propagated.
return if $AUTOLOAD =~ /::DESTROY$/;
# Remove the package name.
$AUTOLOAD =~ s/^.*:://;
# Pass the message to the delegate.
return $self->{_uri}->$AUTOLOAD(@_);
}
sub _valid_scheme {
my $scheme = shift->scheme;
return eval { require "LWP/Protocol/$scheme.pm" };
}
sub new {
my $class = shift;
my $uri = new URI(@_);
$uri->scheme('file') unless $uri->scheme;
my $self = bless { _uri => $uri }, $class;
croak "$self: unsupported scheme"
unless $self->_valid_scheme;
return $self;
}
sub logger {
my $self = shift;
return $self->{_logger} //= Log::Log4perl::get_logger(__PACKAGE__);
}
sub clone {
my $self = shift;
return new SlackBuild::URI($self);
}
sub new_abs {
my ($self, $arg) = @_;
my $s = $self->clone;
$s->path(File::Spec->catfile($self->path, $arg));
return $s;
}
use overload '""' => sub { shift->as_string };
sub download {
my $self = shift;
my $dst = shift || basename($self->path);
my $scheme = $self->scheme;
require "LWP/Protocol/$scheme.pm";
$self->logger->info("downloading $self");
my $ua = LWP::UserAgent->new();
$ua->agent('Slackbuilder/$SlackBuilder::VERSION');
my $response = $ua->get($self->as_string, ':content_file' => $dst);
my $result = new SlackBuild::Download($self,
success => $response->is_success);
if ($response->is_success) {
$result->content_type(scalar($response->content_type));
} else {
$self->logger->error("$self: " . $response->status_line);
}
return $result;
}
1;
|