testsvncopy.pl.in

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

#       command     Subversion command
#       options     Other options to pass to Subversion
#
# Returns:     exit status, output from command
#------------------------------------------------------------------------------
sub SVNCall
{
  my ( $command, @options ) = @_;

  my @commandline = ( $svn, $command, @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;
}


#------------------------------------------------------------------------------
# Function:    CreateSVNDirectories
#
# Creates a directory in Subversion, including all intermediate directories.
#
# Parameters:
#       URI         directory path to create.
#       message     commit message (optional).
#
# Returns:     1 on success, 0 on error
#------------------------------------------------------------------------------
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;

  # Prepare a file containing the message
  my ($handle, $messagefile) = tempfile( DIR => $temp_dir );
  print $handle $message;
  close($handle);
  my @msgcmd = ( "--file", $messagefile );

  # We're going to get errors while we do this.  Don't show the user.
  my $old_verbose = $verbose;
  $verbose = 0;
  # Find the repository root
  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 )
            {
              # We've found the root of the repository.
              $found_root = 1;
            }
        }
      elsif ( !$found_tail )
        {
          if ( SVNCall( 'log', '-r', 'HEAD', $r ) != 0 )
            {
              # We've found the first directory which doesn't exist.
              $found_tail = 1;
            }
        }
        
      if ( $found_tail )
        {
          # We're creating directories
          $verbose = $old_verbose;
          if ( 0 != SVNCall( 'mkdir', @msgcmd, $r ) )
            {
              error( "Couldn't create directory '$r'" );
              return 0;
            }
        }
    }
  $verbose = $old_verbose;
  
  return 1;
}


#------------------------------------------------------------------------------
# Function:    CompareLists
#
# Compares two lists.
#
# Parameters:
#       context    Structure containing the current state of the comparison:
#           list1      [in]  first list
#           list2      [in]  second list
#           diffs      [out] The number of differences
#           added      [out] The entries in list2 not in list1
#           removed    [out] The entries in list1 not in list2
#           common     [out] The entries in both lists
#
# Returns:     The number of differences
#------------------------------------------------------------------------------
sub CompareLists
{
  my $context = $_[0];
  my %count = ();
    
  # Make sure everything's clean
  @{$context->{added}} = ();
  @{$context->{removed}} = ();
  @{$context->{common}} = ();

  # Add the elements from list 1 into the hash
  foreach $element( @{$context->{list1}} )
    {
      $count{$element}++;
    }
  # Add the elements from list 2 into the hash (negative)
  foreach $element( @{$context->{list2}} )
    {
      $count{$element}--;
    }
    
  # Now elements in list1 only have a count of 1, in list2 only have a
  # count of -1, and in both have a count of 0
  foreach $element ( keys %count )
    {
      if ( 1 == $count{$element} ) { push( @{$context->{removed}}, $element ); }
      elsif ( 0 == $count{$element} ) { push( @{$context->{common}}, $element ); }
      else { push( @{$context->{added}}, $element ); }
    }
    
  $context->{diffs} = scalar( @{$context->{added}} ) +
                      scalar( @{$context->{removed}} );
                              
  return $context->{diffs};
}


#------------------------------------------------------------------------------
# Function:    info
#
# Prints out an informational message in verbose mode
#
# Parameters:
#       @_     The message(s) to print
#
# Returns:     none
#------------------------------------------------------------------------------
sub info
{
  if ( $verbose )
    {
      print @_;
    }
}


#------------------------------------------------------------------------------
# Function:    error
#
# Prints out and logs an error message
#
# Parameters:
#       @_     The error messages
#
# Returns:     none
#------------------------------------------------------------------------------
sub error
{
  my $error;
    
  # This is used during testing
  if ( $hideerrors )
    {
      return;
    }
    
  # Now print out each error message and add it to the list.
  foreach $error ( @_ )
    {
      my $text = "svncopy.pl: $error\n";
      push( @errors, $text );
      if ( $verbose )
        {
          print $text;
        }
    }
}


#------------------------------------------------------------------------------
# Function:    Usage
#
# Prints out usage information.
#
# Parameters:
#       optional error message
#
# Returns:     none
#------------------------------------------------------------------------------
sub Usage
{
  my $msg;
  $msg = "\n*** $_[0] ***\n" if $_[0];
    
  pod2usage( { -message => $msg,
               -verbose => 0 } );
}


#------------------------------------------------------------------------------
# This package exists just to delete the temporary directory.
#------------------------------------------------------------------------------
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("testsvncopy_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);
  }
  
  # Return to the original directory
  chdir( $startDir );
}


#------------------------------------------------------------------------------
# Documentation follows, in pod format.
#------------------------------------------------------------------------------
__END__

=head1 NAME

B<testsvncopy> - tests for B<svncopy> script

=head1 SYNOPSIS

B<testsvncopy.pl> [option ...]

B<testsvncopy.pl> tests the operation of the B<svncopy.pl> script.

 Options:
  -t [--test-repository] : URL to repository for root of tests
  -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 configuration files from directory ARG
  --[no]verbose          : set the script to give lots of output

=head1 OPTIONS

=over 8

=item B<-t [--test-repository]>

Specify a URL to a scratch area of repository which the tests can use.
This can be any valid repository URL.

=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>

Set the script to give lots of output when it runs

=item B<--help>

Print a brief help message and exits

=back

=head1 DESCRIPTION

B<svncopy.pl> is a utility script which performs an B<svn copy> command.
It allows extra processing to get around some limitations of the B<svn copy>
command (in particular related to branching and tagging).

B<testsvncopy.pl> tests the operation of this script.

=cut

#------------------------------- END OF FILE ----------------------------------