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__
=head1 NAME
SVN::Notify::Snapshot - Take snapshots from Subversion activity
=head1 VERSION
This document describes version 0.04 of SVN::Notify::Snapshot,
released June 28, 2008.
=head1 SYNOPSIS
Use F<svnnotify> in F<post-commit>:
svnnotify --repos-path "$1" --revision "$2" \
--to "/tmp/snapshot-$2.tar.gz" --handler Snapshot \
[--append-rev] --handle-path pathname [options]
[--tag-regex]
or as part of a SVN::Notify::Config YAML file:
#!/usr/bin/perl -MSVN::Notify::Config=$0
--- #YAML:1.0
'':
PATH: "/usr/local/bin:/usr/bin"
'/project1/trunk':
handler: Snapshot
append-rev: 1
to: "/srv/www/htdocs/snapshot.tgz"
Produce snapshots of a repository path. Typically used as part of a
postcommit script, which will automatically e.g. a trunk-latest.tar.gz
file for every commit to a specified path.
=head1 USAGE
As a subclass of L<SVN::Notify>, there are several ways to integrate this
module into your postcommit script:
=over 4
=item 1. postcommit script
Add a line to an existing postcommit script that sets the C<--handler>
commandline option to "Snapshot". This method has the drawback that it
will require multiple Perl interpreters to start up (one per handler
line), which B<will> delay the commit from completing on the client.
Unless you use C<--to-regex-map>, it will also mean that each line will be
called for each revision committed, even if the path of interest hasn't
changed.
=item 2. SVN::Notify::Config stanza
Multiple handlers can be configured in a single L<SVN::Notify::Config>
YAML file, which acts both as the configuration data as well as the
postcommit script itself. This method also ensures that the Snapshot
handler will only be called when a change is made to the associated path
(like C<--to-regex-map> in the commandline case).
=back
=head2 Options
In addition to all of the options available to the base L<SVN::Notify>
class, there are several that are specific to the Snapshot handler.
=over 4
=item * handle-path
This commandline argument specifies the portion of the repository to take
snapshot from, is not optional. It will be automatically set when using
either C<--to-regex-map> or when executed within a L<SVN::Notify::Config>
script, however.
=item * snapshot-base
By default, the base path inside the snapshot will be the basename of
the C<--to> argument, but you may override it with C<--snapshot-base>.
For example, if you are taking a snapshot of C<project1/trunk>, you may
want to set the snapshot-base to "project1" instead.
=item * append-rev
If you are passing both the C<--revision> and C<--to> arguments to
svnnotify on the commandline, you can always construct the filename to
include the revision by using shell substitution variables (like the
example in the L<SYNOPSIS>. However, if you are using a YAML config file
or the C<--to-regex-map> commandline option, you may want to use the
C<append-rev> option, which will insert a hyphen and the revision into the
destination filename between the basename and the suffix.
For example, in the L<SYNOPSIS> above, the YAML stanza will generate files
like:
/srv/www/htdocs/snapshot-1.tgz
/srv/www/htdocs/snapshot-5.tgz
/srv/www/htdocs/snapshot-6.tgz
assuming that the C</project1/trunk> changed in revs 1, 5, and 6.
=back
=head1 AUTHORS
John Peacock E<lt>jpeacock@cpan.orgE<gt>
Autrijus Tang E<lt>autrijus@autrijus.orgE<gt>
=head1 SEE ALSO
L<SVN::Notify>, L<SVN::Notify::Config>
=head1 BUGS
No bugs have been reported.
Please report any bugs or feature requests to
C<bug-svn-notify-snapshot@rt.cpan.org>, or through the web interface at
L<http://rt.cpan.org>.
=head1 LICENCE AND COPYRIGHT
Copyright (c) 2007-2008 John Peacock E<lt>jpeacock@cpan.orgE<gt>.
Portions copyright 2004 by Autrijus Tang E<lt>autrijus@autrijus.orgE<gt>.
This program is free software; you can redistribute it and/or modify it
under the same terms as Perl itself.
See L<http://www.perl.com/perl/misc/Artistic.html>
=cut
