summaryrefslogtreecommitdiffabout
authorSergey Poznyakoff <gray@gnu.org.ua>2019-03-21 19:53:48 (GMT)
committer Sergey Poznyakoff <gray@gnu.org.ua>2019-03-21 20:23:25 (GMT)
commita6c49ece1afd23cc6c8ffaf05cfebaa60ccebd1a (patch) (side-by-side diff)
treeb78f70e587c2651a56daa1cbd5a60a3d974b9b93
parenta003af805f0f20533159f6c8d19d72ab46176ed1 (diff)
downloadslackbuilder-a6c49ece1afd23cc6c8ffaf05cfebaa60ccebd1a.tar.gz
slackbuilder-a6c49ece1afd23cc6c8ffaf05cfebaa60ccebd1a.tar.bz2
Rewrite downloaders.
* lib/SlackBuild/Download.pm: New file. * lib/SlackBuild/Archive.pm (iterate): Remove. Declare $AUTOLOAD. * lib/SlackBuild/Archive/Extractor.pm (download): Update. (content_type): New method. (error,success): Remove methods. * lib/SlackBuild/Archive/Extractor/HTTP.pm: Return SlackBuild::Download. * lib/SlackBuild/Archive/Extractor/Tar.pm: Likewise. * lib/SlackBuild/URI.pm: Likewise. * lib/SlackBuilder.pm: Change usage of download functions. * slackbuilder: Minor fix.
Diffstat (more/less context) (ignore whitespace changes)
-rw-r--r--lib/SlackBuild/Archive.pm32
-rw-r--r--lib/SlackBuild/Archive/Extractor.pm23
-rw-r--r--lib/SlackBuild/Archive/Extractor/HTTP.pm30
-rw-r--r--lib/SlackBuild/Archive/Extractor/Tar.pm45
-rw-r--r--lib/SlackBuild/Download.pm106
-rw-r--r--lib/SlackBuild/URI.pm29
-rw-r--r--lib/SlackBuilder.pm20
-rwxr-xr-xslackbuilder3
8 files changed, 195 insertions, 93 deletions
diff --git a/lib/SlackBuild/Archive.pm b/lib/SlackBuild/Archive.pm
index 03fd17b..ac6b6af 100644
--- a/lib/SlackBuild/Archive.pm
+++ b/lib/SlackBuild/Archive.pm
@@ -10,6 +10,7 @@ use File::Spec;
use Log::Log4perl;
use Carp;
+our $AUTOLOAD;
*AUTOLOAD = \&SlackBuild::URI::AUTOLOAD;
sub new {
@@ -29,14 +30,6 @@ sub dir {
return @{$self->{_dir}}
}
-sub iterate {
- my ($self, $cb) = @_;
- for (my $i = 0; my $file = $self->dir($i); $i++) {
- return 0 unless &{$cb}($file);
- }
- return 1;
-}
-
sub add_file {
my $self = shift;
push @{$self->{_dir}}, map {
@@ -64,15 +57,24 @@ sub download {
croak "bad number of arguments" unless @_ == 2;
my ($self, $dst) = @_;
my (undef, $tmp) = tempfile(DIR => dirname($dst), UNLINK => 1);
- unless ($self->SUPER::download($tmp)) {
- return $self->error($self->SUPER::download_status);
+ my $result = $self->SUPER::download($tmp);
+ if ($result) {
+ $result = SlackBuild::Archive::Extractor
+ ->backend($result, $tmp, $dst)
+ ->extract;
+ if ($result) {
+ $self->_read_info($dst);
+ }
}
- unless (SlackBuild::Archive::Extractor->backend($self, $tmp, $dst)
- ->extract) {
- return 0;
+ return $result;
+}
+
+sub content_type {
+ my ($self, $newtype) = @_;
+ if (defined($newtype)) {
+ $self->{_content_type} = $newtype;
}
- $self->_read_info($dst);
- return 1;
+ return $self->{_content_type};
}
sub _read_info {
diff --git a/lib/SlackBuild/Archive/Extractor.pm b/lib/SlackBuild/Archive/Extractor.pm
index 15ed76f..de48962 100644
--- a/lib/SlackBuild/Archive/Extractor.pm
+++ b/lib/SlackBuild/Archive/Extractor.pm
@@ -11,12 +11,17 @@ sub new {
_destdir => $destdir }, $class;
}
+sub logger {
+ my $self = shift;
+ $self->{_logger} //= Log::Log4perl::get_logger(ref($self))
+}
+
sub backend {
- my ($class, $archive, @args) = @_;
- if ($archive->downloaded_html) {
- return new SlackBuild::Archive::Extractor::HTTP($archive, @args);
+ my ($class, $download, @args) = @_;
+ if ($download->is_html) {
+ return new SlackBuild::Archive::Extractor::HTTP($download, @args);
} else {
- return new SlackBuild::Archive::Extractor::Tar($archive, @args);
+ return new SlackBuild::Archive::Extractor::Tar($download, @args);
}
}
@@ -25,16 +30,10 @@ sub destdir { shift->{_destdir} }
sub tempfile { shift->{_tempfile} }
sub rewind { seek shift->tempfile, 0, 0 }
-sub error {
- my $self = shift;
- return $self->archive->error(@_);
-}
-
-sub success { shift->archive->download_status }
-
sub extract {
my $self = shift;
- return $self->archive->error('unrecognized download format');
+ $self->logger->error('unrecognized download format');
+ return new SlackBuild::Download($self)
}
1;
diff --git a/lib/SlackBuild/Archive/Extractor/HTTP.pm b/lib/SlackBuild/Archive/Extractor/HTTP.pm
index 0d72916..4676d95 100644
--- a/lib/SlackBuild/Archive/Extractor/HTTP.pm
+++ b/lib/SlackBuild/Archive/Extractor/HTTP.pm
@@ -2,6 +2,7 @@ package SlackBuild::Archive::Extractor::HTTP;
use strict;
use warnings;
use parent 'SlackBuild::Archive::Extractor';
+use SlackBuild::Download;
use HTML::Parser;
use File::Basename;
use File::Temp;
@@ -13,15 +14,15 @@ sub extract {
my $self = shift;
my $dst = $self->destdir;
-
+ my $result = new SlackBuild::Download($self->archive);
unless ($self->_html_list($self->tempfile)) {
- return $self->error("$self: bad index file");
+ $self->logger->error($self->archive . ": bad index file");
+ return $result;
}
+
+ return $result unless $self->archive->verify;
- return 0 unless $self->archive->verify;
-
- return $self->archive->iterate(sub {
- my $file = shift;
+ for (my $i = 0; my $file = $self->archive->dir($i); $i++) {
my $subdir = dirname($file);
my $dir = File::Spec->catfile($dst, $subdir);
unless (-d $dir) {
@@ -35,27 +36,26 @@ sub extract {
$self->error("can't create $file: $message");
}
}
- return 0;
+ return $result;
}
}
my $uri = $self->archive->new_abs($file);
my ($dh,$tmp) = File::Temp::tempfile(DIR => $dir, UNLINK => 1);
chmod 0644, $dh;
unless ($uri->download($tmp)) {
- return $self->error("can't download $uri: "
- . $uri->download_status);
- }
+ return $result;
+ }
my $destfile = File::Spec->catfile($dst, $file);
- if ($uri->downloaded_html && $self->_html_list($tmp, $file)) {
+ if ($result->is_html && $self->_html_list($tmp, $file)) {
;
} else {
rename $tmp, $destfile
- or $self->error("can't rename $tmp to $destfile: $!");
+ or $self->logger->error("can't rename $tmp to $destfile: $!");
}
close $dh;
- return 1;
- });
- return 1;
+ }
+ $result->success(1);
+ return $result;
}
sub _html_list {
diff --git a/lib/SlackBuild/Archive/Extractor/Tar.pm b/lib/SlackBuild/Archive/Extractor/Tar.pm
index 1fcd428..3466582 100644
--- a/lib/SlackBuild/Archive/Extractor/Tar.pm
+++ b/lib/SlackBuild/Archive/Extractor/Tar.pm
@@ -2,6 +2,7 @@ package SlackBuild::Archive::Extractor::Tar;
use strict;
use warnings;
use parent 'SlackBuild::Archive::Extractor';
+use SlackBuild::Download;
use POSIX::Run::Capture qw(:all);
use POSIX qw(:sys_wait_h);
@@ -11,19 +12,19 @@ sub _runcap_diag {
return 1 if $obj->status == 0;
while (my $s = $obj->next_line(SD_STDERR)) {
chomp($s);
- $self->error($s);
+ $self->logger->error($s);
}
- $self->error("program "
+ $self->logger->error("program "
. $obj->program
. " terminated with code "
. WEXITSTATUS($obj->status));
} elsif (WIFSIGNALED($obj->status)) {
- $self->error("program "
+ $self->logger->error("program "
. $obj->program
. " terminated on signal "
. WTERMSIG($obj->status));
} else {
- $self->error("program "
+ $self->logger->error("program "
. $obj->program
. " terminated with unrecogized code "
. $obj->status);
@@ -36,12 +37,11 @@ sub _run_tar {
my $obj = new POSIX::Run::Capture(argv => [ 'tar', @_ ],
timeout => 10);
if ($obj->run) {
- return undef unless $self->_runcap_diag($obj);
+ return $obj if $self->_runcap_diag($obj);
} else {
- $self->error("can't run tar: ".strerror($obj->errno));
- return undef;
+ $self->logger->error("can't run tar: ".strerror($obj->errno));
}
- return $obj;
+ return 0;
}
sub _check_build {
@@ -50,17 +50,20 @@ sub _check_build {
my $name = $self->archive->package_name;
my $rx = qr($name);
my $prefix;
-
+ my $success = 1;
+
while (my $s = $obj->next_line(SD_STDOUT)) {
chomp($s);
$s =~ s{^\./}{};
if ($s =~ m{^\./}) {
- $self->error($self->slackbuild_uri .": bad file: $s");
+ $self->logger->error($self->slackbuild_uri .": bad file: $s");
+ $success = 0;
}
if ($s =~ s{^$rx/}{}) {
if (defined($prefix)) {
if (!$prefix) {
- $self->error($self->slackbuild_uri .": bad file: $s");
+ $self->logger->error($self->slackbuild_uri .": bad file: $s");
+ $success = 0;
}
} else {
$prefix = 1;
@@ -68,7 +71,8 @@ sub _check_build {
} else {
if (defined($prefix)) {
if ($prefix) {
- $self->error($self->slackbuild_uri .": bad file: $s");
+ $self->logger->error($self->slackbuild_uri .": bad file: $s");
+ $success = 0;
}
} else {
$prefix = 0;
@@ -77,17 +81,20 @@ sub _check_build {
$self->archive->add_file($s);
}
$self->{_skip} = $prefix;
- return $self->success;
+ return $success;
}
sub extract {
my $self = shift;
- return 0 unless $self->_check_build && $self->archive->verify;
- return $self->_run_tar('-C', $self->destdir,
- '--strip', $self->{_skip},
- '-x',
- '-f',
- $self->tempfile);
+ my $result = new SlackBuild::Download($self->archive);
+ if ($self->_check_build && $self->archive->verify) {
+ $result->success($self->_run_tar('-C', $self->destdir,
+ '--strip', $self->{_skip},
+ '-x',
+ '-f',
+ $self->tempfile));
+ }
+ return $result;
}
1;
diff --git a/lib/SlackBuild/Download.pm b/lib/SlackBuild/Download.pm
new file mode 100644
index 0000000..11af9ca
--- a/dev/null
+++ b/lib/SlackBuild/Download.pm
@@ -0,0 +1,106 @@
+package SlackBuild::Download;
+use strict;
+use warnings;
+use SlackBuild::Base qw(archive success content_type);
+use Carp;
+
+=head1 NAME
+
+SlackBuild::Download - download result class
+
+=head1 DESCRIPTION
+
+Objects of this class represent the return type of download operations.
+Each object has two mandatory associated attributes: archive that performed
+the download (a SlackBuild::Archive object) and the success marker (true or
+false. When used in scalar context, B<SlackBuild::Download> behaves as a
+boolean value (true if the download succeeded and false otherwise),
+
+=head1 CONSTRUCTOR
+
+ $result = new SlackBuild::Download($archive);
+
+Creates a failed download objects. The object will yield B<false> when used
+in scalar context.
+
+ $result = new SlackBuild::Download($archive, success => 1);
+
+Creates a success download object. This object will evaluate to B<true> when
+used in scalar context.
+
+Any of the object attributes can be initialized using keyword arguments. E.g.:
+
+ $result = new SlackBuild::Download($archive, success => 1,
+ content_type => 'text/plain');
+
+=cut
+
+sub new {
+ my $class = shift;
+ my $archive = shift or croak "too few arguments";
+ my $self = bless {}, $class;
+ $self->archive($archive);
+ croak "odd number of arguments"
+ if @_ % 2;
+ local %_ = @_;
+ while (my ($k,$v) = each %_) {
+ if (my $method = $self->can($k)) {
+ $self->${\$method}($v);
+ } else {
+ croak "unknown keyword $k"
+ }
+ }
+ return $self;
+}
+
+=head1 ATTRIBUTES
+
+=head2 archive
+
+ $a = $self->archive;
+ $self->archive($a);
+
+Return or set and return the associated archive.
+
+=head2 success
+
+Return or set and return the success status (boolean value).
+
+=head2 content_type
+
+Return or set and return the content type (string).
+
+=head2 is_html
+
+ if ($dn->is_html) {
+ ...
+ }
+
+Return B<true> if downloaded object is an HTML page.
+
+=cut
+
+sub is_html {
+ my $self = shift;
+ $self->content_type =~ m{^(?:application/xhtml\+xml|text/(?:css|html))$};
+}
+
+use overload
+ "bool" => sub { shift->success },
+ "0+" => sub { shift->success },
+ '""' => sub { shift->success ? "" : "ok" };
+
+our $AUTOLOAD;
+
+sub AUTOLOAD {
+ my $self = shift;
+ (my $name = $AUTOLOAD) =~ s/^.*:://;
+ if (my $method = $self->archive->can($name)) {
+ croak "can't apply method $name to a failed download"
+ unless $self->success;
+ return $self->archive->${\$method}(@_);
+ }
+ croak "unknown method $name in ".ref($self->archive);
+}
+
+1;
diff --git a/lib/SlackBuild/URI.pm b/lib/SlackBuild/URI.pm
index 21d19f9..91b10c2 100644
--- a/lib/SlackBuild/URI.pm
+++ b/lib/SlackBuild/URI.pm
@@ -7,6 +7,8 @@ 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;
@@ -72,27 +74,14 @@ sub download {
my $ua = LWP::UserAgent->new();
$ua->agent('Slackbuilder/$SlackBuilder::VERSION');
my $response = $ua->get($self->as_string, ':content_file' => $dst);
- $self->download_response($response);
- return $response->is_success;
-}
-
-sub download_response {
- my $self = shift;
- croak "too many arguments" if (@_ > 1);
- if (my $v = shift) {
- $self->{_response} = $v;
+ my $result = new SlackBuild::Download($self,
+ success => $response->is_success);
+ if ($response->is_success) {
+ $result->content_type($response->content_type);
+ } else {
+ $self->logger->error("$self: " . $response->status_line);
}
- return $self->{_response};
-}
-
-sub download_status {
- my $self = shift;
- return $self->download_response->status_line;
-}
-
-sub downloaded_html {
- my $self = shift;
- return $self->download_response->content_type =~ m{^(?:application/xhtml\+xml|text/(?:css|html))$};
+ return $result;
}
1;
diff --git a/lib/SlackBuilder.pm b/lib/SlackBuilder.pm
index 633bd5e..bf792bf 100644
--- a/lib/SlackBuilder.pm
+++ b/lib/SlackBuilder.pm
@@ -270,8 +270,9 @@ sub run {
my $err = (split /\n/)[0];
$err =~ s{\s+at .* line \d+\.$}{};
$self->error("$name: $err");
- return $self->errno(E_SYNTAX);
+ undef
};
+ return $self->errno(E_SYNTAX) unless $req;
}
unless ($req->package) {
@@ -288,12 +289,9 @@ sub run {
my $archive = new SlackBuild::Archive($self->package_name,
$self->slackbuild_uri);
-
- unless ($archive->download($self->wd)) {
- $self->error("can't download $archive: "
- . $archive->download_status);
- return $self->errno(E_FAIL);
- }
+
+ return $self->errno(E_FAIL)
+ unless $archive->download($self->wd);
$self->os_probe;
return $self->errno if $self->errno;
@@ -305,10 +303,8 @@ sub run {
my $uri = new SlackBuild::URI($s);
my $dest = File::Spec->catfile($self->wd,
$self->request->extract_local_name($uri->as_string));
- unless ($uri->download($dest)) {
- $self->error("can't download $uri: ".$uri->download_status);
- return $self->errno(E_FAIL);
- }
+ return $self->errno(E_FAIL)
+ unless $uri->download($dest);
}
}
@@ -530,12 +526,14 @@ sub _build {
stdout => sub {
my $line = shift;
print $logfd "OUT: $line";
+ $logfd->flush();
chomp($line);
$self->parser_out($line);
},
stderr => sub {
my $line = shift;
print $logfd "ERR: $line";
+ $logfd->flush();
chomp($line);
$self->parser_err($line);
});
diff --git a/slackbuilder b/slackbuilder
index 41826f0..88c7a07 100755
--- a/slackbuilder
+++ b/slackbuilder
@@ -57,6 +57,7 @@ if ($builder->is_success) {
foreach my $f ($builder->output_files) {
print "$f\n";
}
+ exit(EX_OK);
} else {
- print STDERR "ERROR: " . $builder->errno . "\n";
+ exit($builder->errno);
}

Return to:

Send suggestions and report system problems to the System administrator.