svncopy.pl.in

subversion-1.4.3-1.tar.gz 配置svn的源码

#! /usr/bin/perl
#
#  svncopy.pl  --  Utility script for copying with branching/tagging.
#
#  This program is free software; you can redistribute  it and/or modify it
#  under  the terms of  the GNU General  Public License as published by the
#  Free Software Foundation;  either version 2 of the  License, or (at your
#  option) any later version.
#
#  THIS  SOFTWARE  IS PROVIDED   ``AS  IS'' AND   ANY  EXPRESS  OR  IMPLIED
#  WARRANTIES,   INCLUDING, BUT NOT  LIMITED  TO, THE IMPLIED WARRANTIES OF
#  MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE ARE DISCLAIMED.  IN
#  NO  EVENT  SHALL   THE AUTHOR  BE    LIABLE FOR ANY   DIRECT,  INDIRECT,
#  INCIDENTAL, SPECIAL, EXEMPLARY, OR CONSEQUENTIAL DAMAGES (INCLUDING, BUT
#  NOT LIMITED   TO, PROCUREMENT OF  SUBSTITUTE GOODS  OR SERVICES; LOSS OF
#  USE, DATA,  OR PROFITS; OR  BUSINESS INTERRUPTION) HOWEVER CAUSED AND ON
#  ANY THEORY OF LIABILITY, WHETHER IN  CONTRACT, STRICT LIABILITY, OR TORT
#  (INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE OF
#  THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE. 
#
#  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.
#
#  This product makes use of software developed by 
#  CollabNet (http://www.Collab.Net/), see http://subversion.tigris.org/.
#
#  This software consists of voluntary contributions made by many
#  individuals.  For exact contribution history, see the revision
#  history and logs, available at http://subversion.tigris.org/.
#------------------------------------------------------------------------------

#------------------------------------------------------------------------------
#
#  This script copies one Subversion location to another, in the same way as
#  svn copy.  Using the script allows proper branching and tagging of URLs
#  containing svn:externals definitions.
#
#  For more information see the pod documentation at the foot of the file,
#  or run svncopy.pl -?.
#
#------------------------------------------------------------------------------

#
# Include files
#
use Cwd;
use File::Temp   0.12   qw(tempdir tempfile);
use Getopt::Long 2.25;
use Pod::Usage;
use URI          1.17;

#
# Global definitions
#

# Specify the location of the svn command.
my $svn = '@SVN_BINDIR@/svn';

# Input parameters
my $testscript = 0;
my $verbose = 0;
my $pin_externals = 0;
my $update_externals = 0;
my @sources;
my $destination;
my $message;
my @svn_options = ();

# Internal information
my %externals_hash;
my $temp_dir;

# Error handling
my @errors = ();
my @warnings = ();

# Testing-specific variables
my $hideerrors = 0;


#------------------------------------------------------------------------------
# Main execution block
#

#
# Process arguments
#
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();

# Put in a signal handler to clean up any temporary directories.
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;

#
# Check our parameters
#
if ( @ARGV < 2 )
{
  Usage( "Please specify source and destination" );
  exit 1;
}

#
# Get source(s) and destination.
#
push ( @sources, shift( @ARGV ) );
$destination = shift( @ARGV );
while ( scalar( @ARGV ) )
  {
    push( @sources, $destination );
    $destination = shift( @ARGV );
  }

#
# Any validation errors?  If so, bomb out.
#
if ( scalar( @errors ) > 0 )
  {
    print "\n", @errors;
    Usage();
    exit scalar( @errors );
  }

#
# Now do the main processing.
# This will update @errors if anything goes wrong.
#
if ( !DoCopy( \@sources, $destination, $message ) )
  {
    print "\n*****************************************************************\n";
    print "Errors:\n";
    print @errors;
  }

exit scalar( @errors );


#------------------------------------------------------------------------------
# Function:    DoCopy
#
# Does the work of the copy.
#
# Parameters:
#       sources         Reference to array containing source URLs
#       destination     Destination URL
#       message         Commit message to use
#
# Returns:     0 on error
#
# Updates @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 );

  # Convert destination to URI
  $destination =~ s|/*$||;
  my $destination_uri = URI->new($destination);
   
  #
  # Generate a message if we don't have one.
  #
  unless ( $message )
    {
      $message = "svncopy.pl: Copied to '$destination'\n";
      foreach $src ( @sources )
        {
          $message .= "            Copied from '$src'\n";
        }
    }
    
  #
  # Create a temporary directory to work in.
  #
  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 )
    {
      # Convert source to URI
      $src =~ s|/*$||;
      my $source_uri = URI->new($src);

      #
      # Do the initial copy into our temporary.  Note this will create a
      # subdirectory with the same name as the last directory in $source.
      #
      if ( !CopyToWorkDir( $src, $dest_dir ) )
        {
          error( "Copy failed" );
          return 0;
        }
    }
        
  #
  # Do any processing.
  #
  if ( $pin_externals or $update_externals )
    {
      if ( !UpdateExternals( $sourceref, $destination, $dest_dir, \$message ) )
        {
          error( "Couldn't update svn:externals" );
          return 0;
        }
    }
    
  #
  # And check in the new.
  #
  DoCommit( $dest_dir, $message ) or die "Couldn't commit\n";
    
  # Make sure we finish in the directory we started
  chdir( $startdir );

  print "=== ... copy complete\n";
  print "=================================================================\n";
    
  # Return whether there was an error.
  return ( scalar( @errors ) == $starterrors );
}


#------------------------------------------------------------------------------
# Function:    PrepareDirectory
#
# Prepares a temporary directory to work in.
#
# Parameters:
#       destination    Destination URI
#       message        Commit message
#
# Returns:     temporary directory and subdirectory to work in
#------------------------------------------------------------------------------
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" );
  
  #
  # Our working destination directory has the same name as the last directory
  # in the destination URI.
  #
  my @path_segments = grep { length($_) } $destination->path_segments;
  my $new_dir = pop( @path_segments );
  my $dest_dir = "$temp_dir/$new_dir";
  
  # Make sure the destination directory exists in Subversion.
  info( "Creating intermediate directories (if necessary)\n" );
  if ( !CreateSVNDirectories( $destination, $message ) )
    {
      error( "Couldn't create parent directories for '$destination'" );
      return;
    }
  
  # Check out the destination.
  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 );
}


#------------------------------------------------------------------------------
# Function:    CopyToWorkDir
#
# Does the svn copy into the temporary directory.
#
# Parameters:
#       source      The URI to copy from
#       work_dir    The working directory
#
# Returns:     1 on success
#------------------------------------------------------------------------------
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 );
}


#------------------------------------------------------------------------------
# Function:    DestinationSubdir
#
# Returns the destination directory for a given source and a destination root
# directory.
#
# Parameters:
#       source      The URL to copy from
#       destination The working directory
#
# Returns:     The relevant directory
#------------------------------------------------------------------------------
sub DestinationSubdir
{
  my ( $source, $destination ) = @_;
  my $subdir;
    
  # Make sure source and destination are consistent about separator.
  # Note every function we call can handle Unix path format, so we
  # default to that.
  $source =~ s|\\|/|g;
  $destination =~ s|\\|/|g;

  # Find the last directory - that's the subdir we'll use in $destination
  if ( $source =~ m"/([^/]+)/*$" )
    {
      $subdir = $1;
    }
    else
    {
      $subdir = $source;