+ # the callbacks that follow share these lexical variables
+ my $child_eof = 0;
+ my $child_output = '';
+ my $child_dead = 0;
+ my $child_exit_status = 0;
+ my ($fdsrc, $cwsrc);
+ my ($maybe_finished, $fd_source_cb, $child_watch_source_cb);
+
+ # Perl note: we have to use anonymous subs here, as they are instantiated
+ # at runtime, rather than at compile time.
+
+ $maybe_finished = sub {
+ return unless $child_eof;
+ return unless $child_dead;
+
+ # everything is finished -- process the results and invoke the callback
+ chomp $child_output;
+
+ # handle unexpected exit status as a fatal error
+ if (!POSIX::WIFEXITED($child_exit_status) || POSIX::WEXITSTATUS($child_exit_status) > 2) {
+ $run_cb->(POSIX::WEXITSTATUS($child_exit_status), undef,
+ "Fatal error from changer script: ".$child_output);
+ return;
+ }
+
+ # parse the child's output
+ my @child_output = split '\n', $child_output;
+ my $exitval = POSIX::WEXITSTATUS($child_exit_status);
+
+ debug("Amanda::Changer::compat: Got response '$child_output' with exit status $exitval");
+ if (@child_output < 1) {
+ $run_cb->(2, undef, "Malformed output from changer script -- no output");
+ return;
+ }
+ my $slotline = shift @child_output;
+ if ($slotline !~ /\s*([^\s]+)(?:\s+(.+))?/) {
+ $run_cb->(2, undef, "Malformed output from changer script: '$slotline'");
+ return;
+ }
+ my ($slot, $rest) = ($1, $2);
+
+ # append any additional lines to $rest
+ if (@child_output) {
+ $rest .= "\n" . join("\n", @child_output);
+ }
+
+ # let the callback take care of any further interpretation
+ $run_cb->($exitval, $slot, $rest);
+ };
+
+ $fd_source_cb = sub {
+ my ($fdsrc) = @_;
+ my ($len, $bytes);
+ $len = POSIX::read($readfd, $bytes, 1024);
+
+ # if we got an EOF, shut things down.
+ if ($len == 0) {
+ $child_eof = 1;
+ POSIX::close($readfd);
+ $fdsrc->remove();
+ $fdsrc = undef; # break a reference loop
+ $maybe_finished->();
+ } else {
+ # otherwise, just keep the bytes
+ $child_output .= $bytes;
+ }
+ };
+ $fdsrc = Amanda::MainLoop::fd_source($readfd, $G_IO_IN | $G_IO_ERR | $G_IO_HUP);
+ $fdsrc->set_callback($fd_source_cb);
+
+ $child_watch_source_cb = sub {
+ my ($cwsrc, $got_pid, $got_status) = @_;
+ $cwsrc->remove();
+ $cwsrc = undef; # break a reference loop
+ $child_dead = 1;
+ $child_exit_status = $got_status;