use Cwd;
use File::Temp 0.12 qw(tempdir tempfile);
use Getopt::Long 2.25;
use Pod::Usage;
use URI 1.17;
my $svn = '@SVN_BINDIR@/svn';
my $testscript = 0;
my $verbose = 0;
my $pin_externals = 0;
my $update_externals = 0;
my @sources;
my $destination;
my $message;
my @svn_options = ();
my %externals_hash;
my $temp_dir;
my @errors = ();
my @warnings = ();
my $hideerrors = 0;
GetOptions( "pin-externals|tag|t" => \$pin_externals,
"update-externals|branch|b" => \$update_externals,
"message|m=s" => \$message,
"revision|r=s" => \$revision,
"verbose!" => \$verbose,
"quiet|q" => sub { $verbose = 0; push( @svn_options, "--quiet" ) },
"file|F=s" => sub { push( @svn_options, "--file", $_[1] ) },
"username=s" => sub { push( @svn_options, "--username", $_[1] ) },
"password=s" => sub { push( @svn_options, "--password", $_[1] ) },
"no_auth_cache" => sub { push( @svn_options, "--no-auth-cache" ) },
"force-log" => sub { push( @svn_options, "--force-log" ) },
"encoding=s" => sub { push( @svn_options, "--encoding", $_[1] ) },
"config-dir=s" => sub { push( @svn_options, "--config-dir", $_[1] ) },
"help|?" => sub{ Usage() },
) or Usage();
sub catch_signal {
my $signal = shift;
warn "$0: caught signal $signal. Quitting now.\n";
exit 1;
}
$SIG{HUP} = \&catch_signal;
$SIG{INT} = \&catch_signal;
$SIG{TERM} = \&catch_signal;
$SIG{PIPE} = \&catch_signal;
if ( @ARGV < 2 )
{
Usage( "Please specify source and destination" );
exit 1;
}
push ( @sources, shift( @ARGV ) );
$destination = shift( @ARGV );
while ( scalar( @ARGV ) )
{
push( @sources, $destination );
$destination = shift( @ARGV );
}
if ( scalar( @errors ) > 0 )
{
print "\n", @errors;
Usage();
exit scalar( @errors );
}
if ( !DoCopy( \@sources, $destination, $message ) )
{
print "\n*****************************************************************\n";
print "Errors:\n";
print @errors;
}
exit scalar( @errors );
sub DoCopy
{
my ( $sourceref, $destination, $message ) = @_;
my @sources = @$sourceref;
my $revstr = "";
my $src;
my $startdir = cwd;
my $starterrors = scalar( @errors );
print "\n=================================================================\n";
$revstr = "\@$revision" if $revision;
print "=== Copying from:\n";
foreach $src ( @sources ) { print "=== $src$revstr\n"; }
print "===\n";
print "=== Copying to:\n";
print "=== $destination\n";
print "===\n";
print "=== - branching (updating fully-contained svn:externals definitions)\n" if $update_externals;
if ( $pin_externals )
{
my $revtext = $revision ? "revision $revision" : "current revision";
print "=== - tagging (pinning all svn:externals definitions to $revtext)\n";
}
print "===\n" if ( $update_externals or $pin_externals );
$destination =~ s|/*$||;
my $destination_uri = URI->new($destination);
unless ( $message )
{
$message = "svncopy.pl: Copied to '$destination'\n";
foreach $src ( @sources )
{
$message .= " Copied from '$src'\n";
}
}
my ( $auto_temp_dir, $dest_dir ) =
PrepareDirectory( $destination_uri, "svncopy.pl to '$destination'\n - creating intermediate directory" );
$temp_dir = $auto_temp_dir->temp_dir();
chdir( $temp_dir );
foreach $src ( @sources )
{
$src =~ s|/*$||;
my $source_uri = URI->new($src);
if ( !CopyToWorkDir( $src, $dest_dir ) )
{
error( "Copy failed" );
return 0;
}
}
if ( $pin_externals or $update_externals )
{
if ( !UpdateExternals( $sourceref, $destination, $dest_dir, \$message ) )
{
error( "Couldn't update svn:externals" );
return 0;
}
}
DoCommit( $dest_dir, $message ) or die "Couldn't commit\n";
chdir( $startdir );
print "=== ... copy complete\n";
print "=================================================================\n";
return ( scalar( @errors ) == $starterrors );
}
sub PrepareDirectory
{
my ( $destination, $message ) = @_;
my $auto_temp_dir = Temp::Delete->new();
$temp_dir = $auto_temp_dir->temp_dir();
info( "Using temporary directory $temp_dir\n" );
my @path_segments = grep { length($_) } $destination->path_segments;
my $new_dir = pop( @path_segments );
my $dest_dir = "$temp_dir/$new_dir";
info( "Creating intermediate directories (if necessary)\n" );
if ( !CreateSVNDirectories( $destination, $message ) )
{
error( "Couldn't create parent directories for '$destination'" );
return;
}
info( "Checking out destination directory '$destination'\n" );
if ( 0 != SVNCall( 'co', $destination, $dest_dir ) )
{
error( "Couldn't check out '$destination' into work directory." );
return;
}
return ( $auto_temp_dir, $dest_dir );
}
sub CopyToWorkDir
{
my ( $source, $work_dir ) = @_;
my $dest_dir = DestinationSubdir( $source, $work_dir );
my @commandline = ();
push( @commandline, "--revision", $revision ) if ( $revision );
push( @commandline, $source, $work_dir );
my $exit = SVNCall( "copy", @commandline );
error( "$0: svn copy failed" ) if ( 0 != $exit );
return ( 0 == $exit );
}
sub DestinationSubdir
{
my ( $source, $destination ) = @_;
my $subdir;
$source =~ s|\\|/|g;
$destination =~ s|\\|/|g;
if ( $source =~ m"/([^/]+)/*$" )
{
$subdir = $1;
}
else
{
$subdir = $source;
}
return "$destination/$subdir";
}
sub UpdateExternals
{
my ( $sourceref, $destination, $work_dir, $msgref ) = @_;
my @commandline = ();
my $msg;
my @dirfiles;
my %extlist;
info( "Checking '$work_dir'\n" );
%extlist = GetRecursiveExternals( $work_dir );
while ( my ( $subdir, $exts ) = each ( %extlist ) )
{
my @externals = @$exts;
if ( scalar( @externals ) )
{
UpdateExternalsOnDir( $sourceref, $destination, $subdir, $msgref, \@externals );
}
}
return 1;
}
sub UpdateExternalsOnDir
{
my ( $sourceref, $destination, $work_dir, $msgref, $externalsref ) = @_;
my @sources = @$sourceref;
my @externals = @$externalsref;
my @new_externals;
my %changed;
foreach my $external ( @externals )
{
chomp( $external );
next unless ( $external =~ m"^(\S+)(\s+)(?:-r\s*(\d+)\s+)?(.*)" );
my ( $ext_dir, $spacing, $ext_rev, $ext_val ) = ( $1, $2, $3, $4 );
info( " - Found $ext_dir => '$ext_val'" );
info( " ($ext_rev)" ) if $ext_rev;
info( "\n" );
$externals_hash{ "$ext_val" } = $ext_rev;
if ( !$ext_rev )
{
if ( $update_externals )
{
my $old_external = $external;
foreach my $source ( @sources )
{
my $dest_dir = DestinationSubdir( $source, $destination );
if ( $ext_val =~ s|^$source|$dest_dir| )
{
$external = "$ext_dir$spacing$ext_val";
info( " - updated '$old_external' to '$external'\n" );
$changed{$old_external} = $external;
}
}
}
elsif ( $pin_externals )
{
my $old_external = $external;
my $rev = LatestRevision( $ext_val, $revision );
$external = "$ext_dir -r $rev$spacing$ext_val";
info( " - updated '$old_external' to '$external'\n" );
$changed{$old_external} = $external;
}
}
push( @new_externals, $external );
}
if ( scalar( %changed ) )
{
my %info = SVNInfo( $work_dir );
$$msgref .= "\n * $info{URL}: update svn:externals\n";
while ( my ( $old, $new ) = each( %changed ) )
{
$$msgref .= " from '$old' to '$new'\n";
info( " '$old' => '$new'\n" );
}
my ($handle, $tmpfile) = tempfile( DIR => $temp_dir );
print $handle join( "\n", @new_externals );
close($handle);
SVNCall( "propset", "--file", $tmpfile, "svn:externals", $work_dir );
}
}
sub GetRecursiveExternals
{
my ( $location ) = @_;
my %retval;
my $externals;
my $subdir = ".";
my ( $status, @externals ) = SVNCall( "propget", "-R", "svn:externals", $location );
foreach my $external ( @externals )
{
chomp( $external );
if ( $external =~ m"(.*) - (.*\s.*)" )
{
$subdir = $1;
$external = $2;
}
push( @{$retval{$subdir}}, $external ) unless $external =~ m"^\s*$";
}
return %retval;
}
sub SVNInfo
{
my $file = shift;
my $old_verbose = $verbose;
$verbose = 0;
my ( $retval, @output ) = SVNCall( "info", $file );
$verbose = $old_verbose;
my %info;
return if ( 0 != $retval );
foreach my $line ( @output )
{
if ( $line =~ "^(.*): (.*)" )
{
$info{ $1 } = $2;
}
}
return %info;
}
sub LatestRevision
{
my ( $source, $revision ) = @_;
my $revtext = "";
if ( $revision )
{
$revtext = "--revision $revision:0";
}
my $old_verbose = $verbose;
$verbose = 0;
my ( $retval, @output ) = SVNCall( "log -q", $revtext, $source );
$verbose = $old_verbose;
if ( 0 != $retval )
{
error( "LatestRevision: log -q on '$source' failed" );
return -1;
}
if ( $output[1] =~ m"^r(\d+) \|" )
{
return $1;
}
error( "LatestRevision: log output not formatted as expected\n" );
return -1;
}
sub DoCommit
{
my ( $work_dir, $message ) = @_;
my @commandline = ();
my ($handle, $messagefile) = tempfile( DIR => $temp_dir );
print $handle $message;
close($handle);
push( @commandline, "--file", $messagefile );
push( @commandline, $work_dir );
my ( $exit ) = SVNCall( "commit", @commandline );
error( "$0: svn commit failed" ) if ( 0 != $exit );
return ( 0 == $exit );
}
sub SVNCall
{
my ( $command, @options ) = @_;
my @commandline = ( $svn, $command, @svn_options, @options );
info( " > ", join( " ", @commandline ), "\n" );
my @output = qx( @commandline 2>&1 );
my $result = $?;
my $exit = $result >> 8;
my $signal = $result & 127;
my $cd = $result & 128 ? "with core dump" : "";
if ($signal or $cd)
{
error( "$0: 'svn $command' failed $cd: exit=$exit signal=$signal\n" );
}
if ( $exit > 0 )
{
info( join( "\n", @output ) );
}
if ( wantarray )
{
return ( $exit, @output );
}
return $exit;
}
sub FindRepositoryRoot
{
my $URI = shift;
my $repos_root_uri;
my $repos_root_uri_path;
my $old_verbose = $verbose;
$verbose = 0;
info( "Finding the root URL of '$URI'.\n" );
my $r = $URI->clone;
my @path_segments = grep { length($_) } $r->path_segments;
unshift(@path_segments, '');
$r->path('');
my @r_path_segments;
while (@path_segments)
{
$repos_root_uri_path = shift @path_segments;
push(@r_path_segments, $repos_root_uri_path);
$r->path_segments(@r_path_segments);
if ( SVNCall( 'log', '-r', 'HEAD', $r ) == 0 )
{
$repos_root_uri = $r;
last;
}
}
$verbose = $old_verbose;
if ($repos_root_uri)
{
info( "Determined that the svn root URL is $repos_root_uri.\n\n" );
return $repos_root_uri;
}
else
{
error( "$0: cannot determine root svn URL for '$URI'.\n" );
return;
}
}
sub CreateSVNDirectories
{
my ( $URI, $message ) = @_;
my $r = $URI->clone;
my @path_segments = grep { length($_) } $r->path_segments;
my @r_path_segments;
unshift(@path_segments, '');
$r->path('');
my $found_root = 0;
my $found_tail = 0;
my ($handle, $messagefile) = tempfile( DIR => $temp_dir );
print $handle $message;
close($handle);
my @msgcmd = ( "--file", $messagefile );
my $old_verbose = $verbose;
$verbose = 0;
while (@path_segments)
{
my $segment = shift @path_segments;
push( @r_path_segments, $segment );
$r->path_segments( @r_path_segments );
if ( !$found_root )
{
if ( SVNCall( 'log', '-r', 'HEAD', $r ) == 0 )
{
$found_root = 1;
}
}
elsif ( !$found_tail )
{
if ( SVNCall( 'log', '-r', 'HEAD', $r ) != 0 )
{
$found_tail = 1;
}
}
if ( $found_tail )
{
$verbose = $old_verbose;
if ( 0 != SVNCall( 'mkdir', @msgcmd, $r ) )
{
error( "Couldn't create directory '$r'" );
return 0;
}
}
}
$verbose = $old_verbose;
return 1;
}
sub info
{
if ( $verbose )
{
print @_;
}
}
sub error
{
my $error;
if ( $hideerrors )
{
return;
}
foreach $error ( @_ )
{
my $text = "svncopy.pl: $error\n";
push( @errors, $text );
if ( $verbose )
{
print $text;
}
}
}
sub Usage
{
my $msg;
$msg = "\n*** $_[0] ***\n" if $_[0];
pod2usage( { -message => $msg,
-verbose => 0 } );
}
package Temp::Delete;
use File::Temp 0.12 qw(tempdir);
sub new
{
my $this = shift;
my $class = ref($this) || $this;
my $self = {};
bless $self, $class;
my $temp_dir = tempdir("svncopy_XXXXXXXXXX", TMPDIR => 1);
$self->{tempdir} = $temp_dir;
return $self;
}
sub temp_dir
{
my $self = shift;
return $self->{tempdir};
}
sub DESTROY
{
my $self = shift;
my $temp_dir = $self->{tempdir};
if ( scalar( @errors ) )
{
print "Leaving $temp_dir for inspection\n";
}
else
{
info( "Cleaning up $temp_dir\n" );
File::Path::rmtree([$temp_dir], 0, 0);
}
}
__END__
=head1 NAME
B<svncopy> - extended form of B<svn copy>
=head1 SYNOPSIS
B<svncopy.pl> [option ...] source [source ...] destination
This script copies one Subversion location or set of locations to another,
in the same way as B<svn copy>. Using the script allows more advanced operations,
in particular allowing svn:externals to be dealt with properly for branching
or tagging.
Parameters:
source Subversion item to copy from.
Multiple sources can be given.
destination Destination to copy to.
Options:
-t [--tag] : set svn:externals to current version
[--pin-externals ]
-b [--branch] : update fully contained svn:externals
[--update-externals]
-m [--message] arg : specify commit message ARG
-F [--file] arg : read data from file ARG
-r [--revision] arg : ARG (some commands also take ARG1:ARG2 range)
A revision argument can be one of:
NUMBER revision number
"{" DATE "}" revision at start of the date
"HEAD" latest in repository
"BASE" base rev of item's working copy
"COMMITTED" last commit at or before BASE
"PREV" revision just before COMMITTED
-q [--quiet] : print as little as possible
--username arg : specify a username ARG
--password arg : specify a password ARG
--no-auth-cache : do not cache authentication tokens
--force-log : force validity of log message source
--encoding arg : treat value as being in charset encoding ARG
--config-dir arg : read user config files from directory ARG
--[no]verbose : sets the script to give lots of output
=head1 PARAMETERS
=over
=item B<source>
The subversion item or items to copy from.
=item B<destination>
The destination URL to copy to.
=back
=head1 OPTIONS
=over
=item B<-t [--pin-externals or --tag]>
Update any svn:externals to ensure they have a version number,
using the current destination version if none is already specified.
Useful for tagging operations.
=item B<-b [--update-externals or --branch]>
Update any unversioned svn:externals which point to a location
within one of the sources so that they point to the corresponding
location within the destination.
Note: --pin-externals and --update-externals are mutually exclusive.
=item B<-m [--message] arg>
Specify commit message ARG
=item B<-F [--file] arg>
Read data from file ARG
=item B<-r [--revision] arg>
ARG (some commands also take ARG1:ARG2 range)
A revision argument can be one of:
NUMBER revision number
"{" DATE "}" revision at start of the date
"HEAD" latest in repository
"BASE" base rev of item's working copy
"COMMITTED" last commit at or before BASE
"PREV" revision just before COMMITTED
=item B<-q [--quiet]>
Print as little as possible
=item B<--username arg>
Specify a username ARG
=item B<--password arg>
Specify a password ARG
=item B<--no-auth-cache>
Do not cache authentication tokens
=item B<--force-log>
Force validity of log message source
=item B<--encoding arg>
Treat value as being in charset encoding ARG
=item B<--config-dir arg>
Read user configuration files from directory ARG
=item B<--[no]verbose>
Sets the script to give lots of output when it runs.
=item B<--help>
Print a brief help message and exits.
=back
=head1 DESCRIPTION
This script performs an B<svn copy> command. It allows extra processing to get
around the following limitations of B<svn copy>:
svn:externals definitions are (in Subversion 1.0 and 1.1 at least) absolute paths.
This means that an B<svn copy> used as a branch or tag operation on a tree with
embedded svn:externals will not do what is expected. The svn:externals
will still point at the original location and will not be pinned down.
B<svncopy --update-externals> (or B<svncopy --branch>) will update any
unversioned svn:externals in the destination tree which point at locations
within one of the source trees so that they point to the corresponding locations
within the destination tree instead. This effectively updates the reference to
point to the destination tree, and is the behaviour you want for branching.
B<svncopy --pin-externals> (or B<svncopy --tag>) will update any unversioned
svn:externals in the destination tree to contain the current version of the
directory listed in the svn:externals definition. This effectively pins
the reference to the current version, and is the behaviour you want for tagging.
Note: both forms of the command leave unchanged any svn:externals which
already contain a version number.
=cut