File Coverage

blib/lib/SVN/Notify/Snapshot.pm

Criterion	Covered	Total	%
statement	21	67	31.3
branch	0	20	0.0
condition	0	4	0.0
subroutine	7	14	50.0
pod	2	2	100.0
total	30	107	28.0

package SVN::Notify::Snapshot;
$SVN::Notify::Snapshot::VERSION = '0.04';

use strict;
use File::Spec;
use File::Path qw( mkpath );
use File::Temp qw( tempdir );
use File::Basename qw( dirname fileparse );
use SVN::Notify ();
@SVN::Notify::Snapshot::ISA = qw(SVN::Notify);

use constant SuffixMap => {
    '.tar'      => '_tar',
    '.tar.gz'   => '_tar_gzip',
    '.tgz'      => '_tar_gzip',
    '.tbz'      => '_tar_bzip2',
    '.tbz2'     => '_tar_bzip2',
    '.tar.bz2'  => '_tar_bzip2',
    '.zip'      => '_zip',
};

__PACKAGE__->register_attributes(
    handle_path => 'handle-path=s',
    append_rev  => 'append-rev',
    tag_regex	=> 'tag-regex=s',
);

sub prepare {
    my $self = shift;
    $self->prepare_recipients;
    $self->prepare_files;
}

sub execute {
    my ($self) = @_;
    my $repos = $self->{repos_path} or return;
    my $path = $self->{handle_path} or die "Must specify handle_path";
    $DB::single = 1;
    foreach my $to ( @{$self->{to}} ) {
	my $temp = tempdir( CLEANUP => 0 );

	my ($to_base, $to_path, $to_suffix) = fileparse($to, qr{\..*});
	my $method = $self->SuffixMap->{lc($to_suffix)}
	    or die "Unknown suffix: $to_suffix";

	my $base = (
	    defined($self->{snapshot_base})
		? $self->{snapshot_base} : $to_base
	);

	if ( $self->append_rev ) {
	    $to = "$to_path/$to_base-".$self->{revision}.$to_suffix;
	    $base .= '-'.$self->{revision};
	}

	if ( defined $self->{tag_regex} ) {
	    my $regex = $self->{tag_regex};
            my ($tag) = grep /$regex/, @{$self->{'files'}->{'A'}};
	    return unless $tag;
	    $path = $tag;
	    unless ( $self->append_rev ) {
		$tag =~ s/^.+\/tags\/(.+)/$1/;
		$base = $tag;
	    }
	}

	my $from = File::Spec->catdir($temp, $base);
	mkpath([ dirname($from) ]) unless -d dirname($from);

	$self->_run(
	    'svn', 'export',
	    -r => $self->{revision},
	    "file://$repos/$path" => $from,
	);

	$self->can($method)->($self, $temp, $from, $to);
    }
}

sub _tar {
    my ($self, $temp, $from, $to, $mode) = @_;
    my $TAR = SVN::Notify->find_exe('tar') || '/bin/tar';

    $mode ||= '-cf';
    $self->_run( $TAR, $mode, $to, '-C' => $temp, '.' ) ;
}

sub _tar_gzip {
    my $self = shift;
    $self->_tar(@_, '-czf');
}

sub _tar_bzip2 {
    my $self = shift;
    $self->_tar(@_, '-cjf');
}

sub _zip {
    my ($self, $temp, $from, $to, $mode) = @_;
    my $ZIP = SVN::Notify->find_exe('zip');

    require Cwd;
    my $dir = Cwd::getcwd();
    chdir $temp;

    $self->_run( $ZIP, -r => $to, '.' );
}

sub _run {
    my $self = shift;
    (system { $_[0] } @_) == 0 or die "Running [@_] failed with $?: $!";
}

1;

__END__