1 files changed, 160 insertions, 0 deletions
diff --git a/lib/App/Beam/Backend/Tar.pm b/lib/App/Beam/Backend/Tar.pm
new file mode 100644
index 0000000..c6d1da7
--- /dev/null
+++ b/lib/App/Beam/Backend/Tar.pm
@@ -0,0 +1,160 @@
+package App::Beam::Backend::Tar;
+
+use strict;
+use Carp;
+
+require App::Beam::Backend;
+use Data::Dumper;
+our @ISA = qw(App::Beam::Backend);
+
+use POSIX qw(strftime);
+use App::Beam::Command qw(:channels);
+
+sub ck_dir {
+    my ($v) = @_;
+    
+    if (-d $$v) {
+	return undef;
+    } elsif (! -e $$v) {
+	return "directory does not exist";
+    } else {
+	return "not a directory";
+    }
+}
+
+my %synt = (
+    backend => {
+	section => {
+	    tar => {
+		section => {
+		    binary => {
+			default => '/bin/tar',
+			check => sub {
+			    my ($v) = @_;
+			    if (! -x $$v) {
+				if (! -e $$v) {
+				    return "binary does not not exist";
+				} else {
+				    return "not an executable";
+				}
+			    }
+			    return undef;
+			}
+		    },
+		    options => {
+			array => 1
+		    },
+		    suffix => { default => 'tar' },
+		    'snapshot-dir' => {
+			default => '/var/lib/backups',
+			check => \&ck_dir,
+		    },
+		}
+	    }
+	}
+    },
+    item => {
+	section => {
+	    '*' => {
+		select => sub {
+		    my ($vref, @path) = @_;
+		    return 0 unless ref($vref) eq 'HASH';
+		    return $vref->{backend}->{-value} eq 'tar';
+		},
+		section => {
+		    backend => 1,
+		    directory => {
+			mandatory => 1,
+			check => \&ck_dir
+		    },
+		    files => 1,
+		    options => {
+			array => 1
+		    }
+		}
+	    }
+	}
+    }
+);
+
+sub new {
+    my $class = shift;
+    my $self = $class->SUPER::new(@_);
+
+    unless ($self->{beam}->lint(\%synt)) {
+	return undef;
+    }
+
+    return $self;
+}
+
+sub snapshot_name {
+    my ($self, $basename, $idx) = @_;
+    my $name = $self->{beam}->format_name($basename, $idx);
+    if ($name) {
+	$name = $self->get('backend', 'tar', 'snapshot-dir')
+	        . '/' . $name . '.db';
+    }
+    return $name;
+}
+
+sub mksnapshot {
+    my ($self, $item) = @_;
+    my $snapshot = $self->snapshot_name($item);
+    if ($self->status('level') != 0) {
+	my $prev = $self->snapshot_name($item, 1);
+	if ($prev) {
+	    $self->debug(1, "cp $prev $snapshot");
+	    unless ($self->dry_run) {
+		use File::Copy;
+		unless (copy($prev, $snapshot)) {
+		    $self->error("can't copy $prev to $snapshot: $!");
+		} 
+	    }
+	} else {
+	    $self->error("$item: warning: can't locate previous snapshot\n"
+			 . "falling back to level 0");
+	}
+    }
+    return $snapshot;
+}
+
+sub backup {
+    my ($self, $item) = @_;   
+
+    my $basename = $self->{beam}->format_name($item);
+    croak "undefined basename" unless defined $basename;
+    my $archive = $self->get('core', 'archivedir')
+                  . '/'
+	          . $basename
+		  . '.'
+		  . $self->get('backend', 'tar', 'suffix');
+
+    my $cmd = new App::Beam::Command($self->get('backend', 'tar', 'binary'));
+    if ($self->isset('backend', 'tar', 'options')) {
+	$cmd->add($self->get('backend', 'tar', 'options'));
+    }
+    if ($self->isset('item', $item, 'options')) {
+	$cmd->add($self->get('item', $item, 'options'));
+    }
+    $cmd->add('-c');
+    $cmd->add('-f', $archive);
+    $cmd->add('-C', $self->get('item', $item, 'directory'));
+    $cmd->add('--listed', $self->mksnapshot($item));
+
+    if ($self->isset('item', $item, 'files')) {
+	$cmd->add($self->get('item', $item, 'files'));
+    } else {
+	$cmd->add('.');
+    }
+
+    $self->debug(1, "running ".$cmd->command_line);
+    unless ($self->dry_run) {
+	$cmd->run;
+	$self->logcommand($cmd);
+	my $ret = $cmd->exit_code;
+	$self->set_result('FAILURE') if ($ret && $ret != 2);
+    }
+}
+    
+1;