summaryrefslogtreecommitdiff
diff options
context:
space:
mode:
-rw-r--r--Makefile.PL4
-rw-r--r--lib/SlackBuild/Archive/Extractor.pm25
-rw-r--r--lib/SlackBuild/Counter.pm195
-rw-r--r--lib/SlackBuilder.pm45
-rwxr-xr-xslackbuilder3
-rw-r--r--t/counter.t59
6 files changed, 293 insertions, 38 deletions
diff --git a/Makefile.PL b/Makefile.PL
index e92a8b5..e58e897 100644
--- a/Makefile.PL
+++ b/Makefile.PL
@@ -26,8 +26,8 @@ WriteMakefile(NAME => 'slackbuilder',
'YAML' => '1.20',
'LWP::UserAgent' => '6.29',
'List::Regexp' => '1.03',
- 'Log::Log4perl' => '1.48',
- 'Log::Dispatch' => '2.67',
+ 'Log::Log4perl' => '1.46',
+ 'Log::Dispatch' => '2.44',
#Net::SBo
'POSIX' => 0,
'POSIX::Run::Capture' => 0,
diff --git a/lib/SlackBuild/Archive/Extractor.pm b/lib/SlackBuild/Archive/Extractor.pm
index 90a833f..15ed76f 100644
--- a/lib/SlackBuild/Archive/Extractor.pm
+++ b/lib/SlackBuild/Archive/Extractor.pm
@@ -12,14 +12,19 @@ sub new {
}
sub backend {
- my $class = shift;
- return $class->new(@_)->_backend;
+ my ($class, $archive, @args) = @_;
+ if ($archive->downloaded_html) {
+ return new SlackBuild::Archive::Extractor::HTTP($archive, @args);
+ } else {
+ return new SlackBuild::Archive::Extractor::Tar($archive, @args);
+ }
}
-sub archive { shift->{_archive} };
-sub destdir { shift->{_destdir} };
-sub tempfile { shift->{_tempfile} };
+sub archive { shift->{_archive} }
+sub destdir { shift->{_destdir} }
+sub tempfile { shift->{_tempfile} }
sub rewind { seek shift->tempfile, 0, 0 }
+
sub error {
my $self = shift;
return $self->archive->error(@_);
@@ -32,14 +37,4 @@ sub extract {
return $self->archive->error('unrecognized download format');
}
-sub _backend {
- my $self = shift;
-
- if ($self->archive->downloaded_html) {
- return bless $self, 'SlackBuild::Archive::Extractor::HTTP';
- } else {
- return bless $self, 'SlackBuild::Archive::Extractor::Tar';
- }
-}
-
1;
diff --git a/lib/SlackBuild/Counter.pm b/lib/SlackBuild/Counter.pm
new file mode 100644
index 0000000..89c7d58
--- /dev/null
+++ b/lib/SlackBuild/Counter.pm
@@ -0,0 +1,195 @@
+package SlackBuild::Counter;
+use strict;
+use warnings;
+use Carp;
+
+=head1 NAME
+
+Slackbuild::Counter - collection of increasing counters
+
+=head1 SYNOPSIS
+
+ $c = new SlackBuild::Counter;
+ $c->more('errors');
+ $c += 'errors';
+ $c->more('warnings');
+ if ($c) {
+ print "there are messages: ".join(',',$c->categories)."\n";
+ print "total: $c\n";
+ }
+ $c->clear;
+
+=head1 DESCRIPTION
+
+Holds a collection of counters. Counters are named by arbitrary strings,
+called I<categories>. Counters spring into existence when they are
+I<increased> and are destroyed when they are I<cleared>.
+
+To increase, each counter use the B<incr>, or B<more> method:
+
+ $c->more('errors')
+
+The above increases it C<errors> counter by 1. The same effect can be
+achieved using the following construct:
+
+ $c += 'errors'
+
+To get the names of existing categories (i.e. categories with non-zero
+counters), use
+
+ $c->categories()
+
+In scalar context, it returns the number of existing categories.
+
+To get the counter for a given category (e.g. 'errors'), use
+the B<get> method. If you are sure that the category exists (you can
+check it via B<exists>), then the name of the category can be used as
+a method of this class:
+
+ if ($c->exists('messages')) {
+ print $c->messages;
+ }
+
+To get the total of all counters, use the B<total> method, or simply B<$c> in
+scalar context.
+
+=cut
+
+sub new { bless {}, shift }
+
+=head1 METHODS
+
+=head2 incr, more
+
+ $c->incr($category)
+ $c->more($category)
+ $c += $category;
+
+Increment counter for the given I<$category>.
+
+=cut
+
+sub incr {
+ my ($self, $category) = @_;
+ $self->{$category}++;
+}
+
+sub more { shift->incr(@_) }
+
+=head2 clear
+
+ $c->clear;
+ $c->clear(@names);
+
+Without arguments, clear all counters. With arguments, clear only counters
+for named categories.
+
+=cut
+
+sub clear {
+ my $self = shift;
+ if (@_) {
+ delete @$self{@_};
+ } else {
+ delete @$self{(keys %$self)};
+ }
+}
+
+=head2 categories
+
+ $n = $c->categories();
+
+Return the number of defined categories.
+
+=cut
+
+sub categories {
+ my $self = shift;
+ return keys %$self;
+}
+
+=head2 exists
+
+ if ($c->exists($category)) {
+ ...
+ }
+
+Return true if the B<$category> exists.
+
+=cut
+
+sub exists {
+ my ($self, $category) = @_;
+ return exists $self->{$category};
+}
+
+=head2 get
+
+ $n = $c->get($category)
+
+Return the counter value for the specified category. Return C<undef>
+if the category does not exist.
+
+You can also use the name of the category as the class method for this
+purpose. For example, to get the C<errors> counter:
+
+ $n = $c->errors
+
+The difference is that it will croak if there is no such counter.
+
+=cut
+
+sub get {
+ my ($self, $category) = @_;
+ return unless $self->exists($category);
+ return $self->{$category};
+}
+
+=head2 total
+
+ $n = $c->total;
+
+Return the total number of all counters. The same value is returned
+if B<$c> is used in scalar context.
+
+=cut
+
+sub total {
+ my $self = shift;
+ my $total = 0;
+ map { $total += $_ } values %$self;
+ return $total;
+}
+
+our $AUTOLOAD;
+
+sub AUTOLOAD {
+ my $self = shift;
+ (my $category = $AUTOLOAD) =~ s/^.*:://;
+ if (defined(my $n = $self->get($category))) {
+ return $n;
+ }
+ croak "no such category";
+}
+
+use overload
+ "0+" => sub { shift->total },
+ "bool" => sub { shift->categories() },
+ "+" => sub {
+ my ($self, $other) = @_;
+ $self->more($other);
+ return $self;
+ },
+ "==" => sub {
+ my ($self, $other) = @_;
+ $self->total == $other;
+ },
+ "eq" => sub {
+ my ($self, $other) = @_;
+ $self->total eq $other;
+ };
+
+1;
+
+
+
diff --git a/lib/SlackBuilder.pm b/lib/SlackBuilder.pm
index 00a1228..633bd5e 100644
--- a/lib/SlackBuilder.pm
+++ b/lib/SlackBuilder.pm
@@ -8,6 +8,7 @@ use SlackBuild::Archive;
use SlackBuild::Registry;
use SlackBuild::Request;
use SlackBuild::Rc;
+use SlackBuild::Counter;
use File::Spec;
use File::Basename;
use File::Temp qw/ tempfile tempdir /;
@@ -104,10 +105,6 @@ sub error {
$self->logger->error($diag);
}
-sub errors { # FIXME
- shift->{_error_count};
-}
-
sub errno {
my $self = shift;
croak "bad number of arguments" if @_ > 1;
@@ -117,6 +114,8 @@ sub errno {
return $self->{_errno};
}
+sub errors { shift->{_error_counter} //= new SlackBuild::Counter }
+
sub is_success {
shift->errno == E_OK;
}
@@ -124,7 +123,7 @@ sub is_success {
sub clear {
my $self = shift;
$self->{_errno} = E_OK;
- $self->{_error_count} = 0;
+ $self->errors->clear();
delete $self->{_request};
delete $self->{_result};
}
@@ -374,15 +373,17 @@ use constant {
# goto ST_CREATING
ST_CREATING => 1, # [expect OUT] Empty line
# goto ST_LISTING
- # [else] goto ST_INIT
+ # [else] goto ST_BUILT
ST_LISTING => 2, # [expect ERR] File name (matching $file_name_rx)
# remain in this state
- # [else] goto ST_INIT
+ # [else] keep state
# [expect OUT] Empty line
# goto ST_CREATED
- # [else] goto ST_INIT
- ST_CREATED => 3 # [expect OUT] "Slackware package foo created"
- # goto ST_INIT
+ # [else] goto ST_BUILT
+ ST_CREATED => 3, # [expect OUT] "Slackware package foo created"
+ # goto ST_BUILT
+ ST_BUILT => 4, # Essentially same as ST_INIT, except that we
+ # know that the package has been built
};
# state([$newstate])
@@ -413,7 +414,12 @@ sub _st_init_out {
sub _st_default_err {
my ($self, $input) = @_;
- $self->logger->error($input);
+ $self->errors->more('build');
+}
+
+sub _st_built_err {
+ my ($self, $input) = @_;
+ $self->errors->more('packaging');
}
sub _st_created_out {
@@ -421,10 +427,11 @@ sub _st_created_out {
if ($input =~ m{^Slackware package /tmp/(.+?) created}) {
$self->file($1);
$self->logger->info($input);
+ $self->state(ST_BUILT);
} else {
$self->logger->error("unexpected output: $input");
+ $self->state(ST_INIT);
}
- $self->state(ST_INIT);
}
sub _st_creating_out {
@@ -432,7 +439,7 @@ sub _st_creating_out {
if ($input eq '') {
$self->state(ST_LISTING);
} else {
- $self->state(ST_INIT);
+ $self->state(ST_BUILT);
}
}
@@ -442,7 +449,6 @@ sub _st_listing_err {
$self->logger->debug("adding file $input");
} else {
$self->logger->error($input);
- $self->state(ST_INIT);
}
}
@@ -450,8 +456,6 @@ sub _st_listing_out {
my ($self, $input) = @_;
if ($input eq '') {
$self->state(ST_CREATED);
- } else {
- $self->state(ST_INIT);
}
}
@@ -461,14 +465,16 @@ my @parser_out = (
\&_st_init_out,
\&_st_creating_out,
\&_st_listing_out,
- \&_st_created_out
+ \&_st_created_out,
+ \&_st_init_out
);
my @parser_err = (
\&_st_default_err,
\&_st_default_err,
\&_st_listing_err,
- \&_st_default_err
+ \&_st_default_err,
+ \&_st_built_err
);
# Finally, parser functions to be called for each channel:
@@ -533,9 +539,6 @@ sub _build {
chomp($line);
$self->parser_err($line);
});
- if ($self->state != ST_INIT) {
- $self->logger->error("parser left in inconsistent state");
- }
$self->{_result}{docker} = $obj;
if ($obj->run) {
$self->_runcap_diag($obj);
diff --git a/slackbuilder b/slackbuilder
index 5ec4fd0..41826f0 100755
--- a/slackbuilder
+++ b/slackbuilder
@@ -45,6 +45,9 @@ GetOptions("h" => sub {
abend(EX_USAGE, "bad number of arguments") unless @ARGV == 1;
my $builder = new SlackBuilder(%sbargs);
$builder->run($ARGV[0]);
+if ($builder->errors) {
+ $builder->logger->warn("there are messages in the following categories: ".join(', ', $builder->errors->categories));
+}
if ($builder->is_success) {
if ($builder->output_files == 0) {
print STDERR "Build exited successfully, but no output files were generated\n";
diff --git a/t/counter.t b/t/counter.t
new file mode 100644
index 0000000..c28b3d9
--- /dev/null
+++ b/t/counter.t
@@ -0,0 +1,59 @@
+# -*- perl -*-
+use lib qw(t lib);
+use strict;
+use warnings;
+use SlackBuild::Counter;
+use Test;
+
+plan tests => 13;
+
+my $c = new SlackBuild::Counter;
+
+# 1
+ok($c->categories(),0);
+
+# 2
+$c->more('errors');
+$c->more('warnings');
+$c->more('messages');
+$c->incr('messages');
+$c += 'messages';
+
+ok(scalar($c->categories()), 3);
+
+# 3
+ok(join(',', sort $c->categories),'errors,messages,warnings');
+
+# 4
+ok($c->total, 5);
+
+# 5
+ok(scalar($c), 5);
+
+# 6
+ok($c == 5);
+
+# 7
+ok($c->get('messages'),3);
+
+# 8
+ok($c->messages,3);
+
+# 9
+ok($c->get('panic'),undef);
+
+# 10
+ok((eval { $c->panic }, $@), '/no such category/' );
+
+# 11
+$c->clear('messages','warnings');
+ok(join(',',$c->categories()),'errors');
+# 12
+ok($c->total, 1);
+
+# 13
+$c->clear;
+ok($c->total, 0);
+
+
+

Return to:

Send suggestions and report system problems to the System administrator.