Store backup results for each backup item individually

* lib/App/Beam.pm (RESULT_*): New constants.
(set_result): Take 3 arguments.
* lib/App/Beam/Backend/Tar.pm (backup): Capture stderr.
* lib/App/Beam/Backup.pm: Check number of command line arguments.
* lib/App/Beam/Command.pm (set_logger): New method.
* lib/App/Beam/List.pm: New command line option --verbose.

6 files changed, 99 insertions, 17 deletions

diff --git a/lib/App/Beam.pm b/lib/App/Beam.pm
index 6a654ca..b7e004e 100644
--- a/lib/App/Beam.pm
+++ b/lib/App/Beam.pm
@@ -11,6 +11,10 @@ use POSIX qw(strftime floor);
 
 require App::Beam::Config;
 our @ISA = qw(App::Beam::Config);
+our @EXPORT_OK = qw(RESULT_PENDING RESULT_SUCCESS RESULT_FAILURE);
+our %EXPORT_TAGS = (
+    result => [ qw(RESULT_PENDING RESULT_SUCCESS RESULT_FAILURE) ]
+);
 
 my $default_config_file = '/etc/beam.conf';
 
@@ -251,6 +255,12 @@ sub abend {
     exit($code);
 }
 
+use constant {
+    RESULT_PENDING => 0,
+    RESULT_SUCCESS => 1,
+    RESULT_FAILURE => 2
+};
+
 # Locks the statfile and retrieves data from it into {status}
 sub lock {
     my $self = shift;
@@ -273,7 +283,7 @@ sub lock {
     }
     my ($cycle, $round, $level) = $self->compute_triplet(1);
     unshift @{$self->{status}}, { timestamp => time(),
-				  result => 'PENDING',
+				  result => RESULT_PENDING,
 				  cycle => $cycle,
 				  round => $round,
 				  level => $level };
@@ -284,7 +294,7 @@ sub unlock {
     my ($self) = @_;
     croak "unlock without lock" unless defined $self->{statfd};
     $self->debug(1, "saving state: ".$self->status('result'));
-    if (!$self->{dry_run} && $self->status('result') ne 'PENDING') {
+    if (!$self->{dry_run} && $self->status('result') != RESULT_PENDING) {
 	seek($self->{statfd}, 0, SEEK_SET);
 	truncate($self->{statfd}, 0);
 	nstore_fd($self->{status}, $self->{statfd});
@@ -353,8 +363,10 @@ sub result {
 }
 
 sub set_result {
-    my ($self, $result) = @_;
-    $self->{status}[0]{result} = $result;
+    my ($self, $item, $result) = @_;
+    $self->{status}[0]{detail}{$item} = $result;
+    $self->{status}[0]{result} = $result
+	unless $self->{status}[0]{result} == RESULT_FAILURE;
 }
 
 sub format_name {
diff --git a/lib/App/Beam/Backend.pm b/lib/App/Beam/Backend.pm
index 7d23156..c0b8ee3 100644
--- a/lib/App/Beam/Backend.pm
+++ b/lib/App/Beam/Backend.pm
@@ -69,14 +69,19 @@ sub logcommand {
 	} elsif (my $e = ($ret >> 8)) {
 	    $self->logger('err',
 			  "$comname exited with status $e");
+	} else {
+	    use Data::Dumper;
+	    print Dumper([$ret]);
 	}
 	$self->logger('err', "command line was: ".$cmd->command_line);
     }
 
     my $fd = $cmd->channel(CHAN_STDERR);
-    while (<$fd>) {
-	chomp;
-	$self->logger('err', "[$comname]: $_");
+    if (defined($fd)) {
+	while (<$fd>) {
+	    chomp;
+	    $self->logger('err', "[$comname]: $_");
+	}
     }
 }
 
diff --git a/lib/App/Beam/Backend/Tar.pm b/lib/App/Beam/Backend/Tar.pm
index c6d1da7..9035427 100644
--- a/lib/App/Beam/Backend/Tar.pm
+++ b/lib/App/Beam/Backend/Tar.pm
@@ -8,6 +8,7 @@ use Data::Dumper;
 our @ISA = qw(App::Beam::Backend);
 
 use POSIX qw(strftime);
+use App::Beam qw(:result);
 use App::Beam::Command qw(:channels);
 
 sub ck_dir {
@@ -131,6 +132,7 @@ sub backup {
 		  . $self->get('backend', 'tar', 'suffix');
 
     my $cmd = new App::Beam::Command($self->get('backend', 'tar', 'binary'));
+    $cmd->set_logger(CHAN_STDERR, sub {	$self->logger('err', $_) });
     if ($self->isset('backend', 'tar', 'options')) {
 	$cmd->add($self->get('backend', 'tar', 'options'));
     }
@@ -153,7 +155,9 @@ sub backup {
 	$cmd->run;
 	$self->logcommand($cmd);
 	my $ret = $cmd->exit_code;
-	$self->set_result('FAILURE') if ($ret && $ret != 2);
+	$self->{beam}->set_result($item,
+			  ($ret == 0 || $ret == 2)
+			    ? RESULT_SUCCESS : RESULT_FAILURE);
     }
 }
     
diff --git a/lib/App/Beam/Backup.pm b/lib/App/Beam/Backup.pm
index b026f30..7d217e0 100644
--- a/lib/App/Beam/Backup.pm
+++ b/lib/App/Beam/Backup.pm
@@ -9,12 +9,13 @@ our @ISA = qw(App::Beam);
 sub run {
     my $self = shift;
 
+    $self->abend(EX_USAGE, "bad number of arguments") if @_;
+
     $self->lock();
     foreach my $item (split /\s+/, $self->get('core.items')) {
 	my $backend = $self->{backend}{$self->get("item.$item.backend")};
 	$backend->backup($item);
     }
-    $self->set_result('OK') if $self->result eq 'PENDING';
     $self->unlock();
 }
 
diff --git a/lib/App/Beam/Command.pm b/lib/App/Beam/Command.pm
index 79b8b06..4f92cdf 100644
--- a/lib/App/Beam/Command.pm
+++ b/lib/App/Beam/Command.pm
@@ -12,6 +12,7 @@ our %EXPORT_TAGS = (
 
 use IPC::Open3;
 use Symbol 'gensym';
+use POSIX qw(:sys_wait_h);
 
 sub new {
     my $class = shift;
@@ -28,6 +29,24 @@ use constant {
     CHAN_STDERR => 1
 };
 
+sub start_log {
+    my ($self, $chan, $rfd) = @_;
+
+    if (exists($self->{log}) && defined($self->{log}[$chan])) {
+	local $^F = fileno($rfd);
+	my $pid = fork();
+	if ($pid == 0) {
+	    local $_ = $rfd;
+	    &{$self->{log}[CHAN_STDERR]};
+	    exit(0);
+	} else {
+	    push @{$self->{pids}}, $pid;
+	    return undef;
+	}
+    }
+    return $rfd;
+}
+
 sub run {
     my $self = shift;
     my $out = gensym;
@@ -36,25 +55,39 @@ sub run {
     return $self->{status} if exists($self->{status});
 
     eval {
-	my $pid = open3(\*STDIN, $out, $err, @{$self->{argv}});
-	waitpid($pid, 0);
+	push @{$self->{pids}},
+	     open3(\*STDIN, $out, $err, @{$self->{argv}});
+	$out = $self->start_log(CHAN_STDOUT, $out);
+	$err = $self->start_log(CHAN_STDERR, $err);
+	do {
+	    my $pid = waitpid(-1, 0);
+	    if ($pid > 0) {
+		@{$self->{pids}} = grep { $pid != $_ } @{$self->{pids}};
+	    }
+	} while ($#{$self->{pids}} >= 0);
     };
     if ($@) {
 	$self->{status} = $@;
     } else {
 	$self->{status} = $?;
 	local $/ = undef;
-	$self->{channel}[CHAN_STDOUT] = <$out>;
-	$self->{channel}[CHAN_STDERR] = <$err>;
+	$self->{channel}[CHAN_STDOUT] = defined($out) ? <$out> : undef;
+	$self->{channel}[CHAN_STDERR] = defined($err) ? <$err> : undef;
     }
     return $self->{status};
 }
 
+sub set_logger {
+    my ($self, $chan, $fun) = @_;
+    $self->{log}[$chan] = $fun;
+}
+
 sub restart {
     my $self = shift;
 
     delete $self->{status};
     delete $self->{channel};
+    delete $self->{pids};
     return $self->run;
 }
 
@@ -66,7 +99,8 @@ sub status {
 
 sub channel {
     my ($self, $chan) = @_;
-    return undef if !exists($self->{channel}) || $chan > $#{$self->{channel}};
+    return undef
+	unless (exists($self->{channel}) && defined($self->{channel}[$chan]));
     open(my $fd, '<', \$self->{channel}[$chan]) or croak "can't dup: $!"; 
     return $fd;
 }
diff --git a/lib/App/Beam/List.pm b/lib/App/Beam/List.pm
index 3bba7e0..ac7031f 100644
--- a/lib/App/Beam/List.pm
+++ b/lib/App/Beam/List.pm
@@ -3,21 +3,47 @@ package App::Beam::List;
 use strict;
 use Carp;
 use POSIX qw(strftime);
+use Unix::Sysexits;
+use Getopt::Long qw(GetOptionsFromArray);
 
-require App::Beam;
+use App::Beam qw(:result);
 our @ISA = qw(App::Beam);
 
+my %result_string = (
+    RESULT_PENDING() => 'PENDING',
+    RESULT_SUCCESS() => 'SUCCESS',
+    RESULT_FAILURE() => 'FAILURE'
+);
+
 sub run {
     my $self = shift;
-
+    my $verbose;
+    
+    shift;
+    GetOptionsFromArray(\@_, "verbose|v" => \$verbose);
+    $self->abend(EX_USAGE, "bad number of arguments") if @_;
+    
     $self->lock();
     my @stat = @{$self->{status}};
     shift @stat;
     foreach my $ent (@stat) {
 	print strftime "%c ", localtime $ent->{timestamp};
 	printf("% 3d% 3d% 3d  %s", $ent->{cycle}, $ent->{round}, $ent->{level},
-	       $ent->{result});
+	       $result_string{$ent->{result}});
 	print "\n";
+	if ($verbose) {
+	    my %detail;
+	    @detail{keys %{$ent->{detail}}} = values %{$ent->{detail}};
+	    foreach my $item (split /\s+/, $self->get('core.items')) {
+		if (exists($detail{$item})) {
+		    printf("# %-24s %s\n", $item, $result_string{$detail{$item}});
+		    delete $detail{$item};
+		}
+	    }
+	    foreach my $item (sort keys %detail) {
+		printf("# %-24s %s\n", $item, $result_string{$detail{$item}});
+	    }
+	}		    
     }
     $self->unlock();
 }