diff options
-rw-r--r-- | Makefile.PL | 4 | ||||
-rw-r--r-- | lib/SlackBuild/Archive/Extractor.pm | 25 | ||||
-rw-r--r-- | lib/SlackBuild/Counter.pm | 195 | ||||
-rw-r--r-- | lib/SlackBuilder.pm | 45 | ||||
-rwxr-xr-x | slackbuilder | 3 | ||||
-rw-r--r-- | t/counter.t | 59 |
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); + + + |