Merge tag 'upstream/3.3.3'

[debian/amanda] / perl / Amanda / Extract.pm

diff --git a/perl/Amanda/Extract.pm b/perl/Amanda/Extract.pm
new file mode 100644 (file)
index 0000000..390f31f
--- /dev/null
+++ b/perl/Amanda/Extract.pm
@@ -0,0 +1,130 @@
+# vim:ft=perl
+# Copyright (c) 2008-2012 Zmanda, Inc.  All Rights Reserved.
+#
+# This program is free software; you can redistribute it and/or modify it
+# under the terms of the GNU General Public License version 2 as published
+# by the Free Software Foundation.
+#
+# This program is distributed in the hope that it will be useful, but
+# WITHOUT ANY WARRANTY; without even the implied warranty of MERCHANTABILITY
+# or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU General Public License
+# for more details.
+#
+# You should have received a copy of the GNU General Public License along
+# with this program; if not, write to the Free Software Foundation, Inc.,
+# 59 Temple Place, Suite 330, Boston, MA  02111-1307 USA
+#
+# Contact information: Zmanda Inc, 465 S. Mathilda Ave., Suite 300
+# Sunnyvale, CA 94086, USA, or: http://www.zmanda.com
+
+package Amanda::Extract;
+
+use strict;
+use warnings;
+use IPC::Open3;
+
+use Amanda::Debug qw( :logging );
+use Amanda::Paths;
+
+=head1 NAME
+
+Amanda::Extract - perl utilities to run scripts and applications
+
+=head1 SYNOPSIS
+
+  use Amanda::Extract;
+
+  my (@bsu, @err)= Amanda::Extract::BSU(application => $application,
+                                       config      => $config,
+                                       host        => $host,
+                                       disk        => $disk,
+                                       device      => $device);
+  my (@bsu, @err)= Amanda::Extract::Run($application_name, \@g_options,
+                                       $hdr, @properties);
+
+=cut
+
+sub BSU {
+    my (%params) = @_;
+
+    my %bsu;
+    my @err;
+    my @command;
+
+    push @command, $Amanda::Paths::APPLICATION_DIR . '/' . $params{'application'};
+    push @command, "support";
+    push @command, "--config", $params{'config'} if $params{'config'};
+    push @command, "--host"  , $params{'host'}   if $params{'host'};
+    push @command, "--disk"  , $params{'disk'}   if $params{'disk'};
+    push @command, "--device", $params{'device'} if $params{'device'};
+    debug("Running: " . join(' ', @command));
+
+    my $in;
+    my $out;
+    my $err = Symbol::gensym;
+    my $pid = open3($in, $out, $err, @command);
+
+    close($in);
+    while (my $line = <$out>) {
+       chomp $line;
+       debug("support: $line");
+       my ($name, $value) = split ' ', $line;
+
+       $name = lc($name);
+
+       if ($name eq 'config' ||
+           $name eq 'host' ||
+           $name eq 'disk' ||
+           $name eq 'index-line' ||
+           $name eq 'index-xml' ||
+           $name eq 'message-line' ||
+           $name eq 'message-xml' ||
+           $name eq 'record' ||
+           $name eq 'include-file' ||
+           $name eq 'include-list' ||
+           $name eq 'include-list-glob' ||
+           $name eq 'include-optional' ||
+           $name eq 'exclude-file' ||
+           $name eq 'exclude-list' ||
+           $name eq 'exclude-list-glob' ||
+           $name eq 'exclude-optional' ||
+           $name eq 'collection' ||
+           $name eq 'caclsize' ||
+           $name eq 'client-estimate' ||
+           $name eq 'multi-estimate' ||
+           $name eq 'amfeatures') {
+           $bsu{$name} = ($value eq "YES");
+       } elsif ($name eq 'max-level') {
+           $bsu{$name} = $value;
+       } elsif ($name eq 'recover-mode') {
+           $bsu{'smb-recover-mode'} = $value eq 'SMB';
+       } elsif ($name eq 'recover-path') {
+           $bsu{'recover-path-cwd'} = $value eq 'CWD';
+           $bsu{'recover-path-remote'} = $value eq 'REMOTE';
+       } elsif ($name eq 'data-path') {
+           if ($value eq 'AMANDA') {
+               $bsu{'data-path-amanda'} = 1;
+           } elsif ($value eq 'DIRECTTCP') {
+               $bsu{'data-path-directtcp'} = 1;
+           }
+       }
+    }
+    close($out);
+
+    while (my $line = <$err>) {
+       chomp($line);
+       next if $line == '';
+       push @err, $line;
+    }
+    close($err);
+
+    waitpid($pid, 0);
+    my $child_exit_status = $? >> 8;
+
+    if ($child_exit_status != 0) {
+       push @err, "exited with status $child_exit_status";
+    }
+    return (\%bsu, \@err);
+}
+
+1;