testsvncopy.pl.in   [plain text]

#! /usr/bin/perl
#
#  testsvncopy.pl  --  test script for svncopy.pl.
#
#  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 tests the operation of svncopy.pl.
#
#  For more information see the pod documentation at the foot of the file,
#  or run testsvncopy.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';

# The scratch repository location for the tests
my $testroot = '@SVN_TEST_REPOSITORY@';

# Input parameters
my $verbose = 0;
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( "verbose!" => sub { $verbose = 1; push( @svn_options, "--verbose" ) },
            "quiet|q" => sub { $verbose = 0; push( @svn_options, "--quiet" ) },
            "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] ) },
            "test-repository|t=s" => \$testroot,
            "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;

# Make sure we're in the correct directory, saving current before we move
my $startDir = cwd;
if ( $0 =~ m"(.*[\\/])[^\\/]+$" )
{
    my $programDir = $1;
    chdir( $programDir );
}

# Run the tests
testUpdateExternals();

# Check whether they passed
if ( 0 != scalar( @errors ) )
{
  print "\n*****************************************************************\n";
  print "Errors:\n";
  print @errors;
}
else
{
  print "*** Script passed tests ***\n";
}

# Return to the original directory
chdir( $startDir );

exit( scalar( @errors ) );


#------------------------------------------------------------------------------
# Function:    testUpdateExternals
#
# Tests the script, pushing any errors onto @errors.
#
# Parameters:
#       none
#
# Returns:     none
#------------------------------------------------------------------------------
sub testUpdateExternals
{
  my $failed = 0;
  my $retval;
  my $testsubdir = "svncopy-update";
  my $testURL = "$testroot/$testsubdir";
  my @testdirs = (
      "source/dirA/dir1",
      "source/dirA/dir2",
      "source/dirB/dir3",
      "wibble/dirA/dir2",
  );
  my $dirWithExternals = $testdirs[0];
  my $pinnedDir = $testdirs[1];
  my $dest = "$testURL/dest";
  my $old_verbose = $verbose;
  my %revisions = {};
  my $testRev;
    
  my $test_externals = 
                  "DIR2 $testURL/source/dirA/dir2\n".     # 1 space
                  "DIR2Pin -r __PINREV__ $testURL/source/dirA/dir2\n".
                  "DIR3     $testURL/source/dirB/dir3\n". # 5 spaces
                  "DIR4		$testURL/wibble/dirA/dir2";   # 2 tabs

  my @tests = (
        # Updating with nothing to update
        { sources => [ "$testURL/source/dirA/dir1", ],
          pin => 0,
          update => 1,
          ext_dir => "dir1",
          expected_externals => [
                    "DIR2 $testURL/source/dirA/dir2",
                    "DIR2Pin -r __PINREV__ $testURL/source/dirA/dir2",
                    "DIR3     $testURL/source/dirB/dir3",
                    "DIR4		$testURL/wibble/dirA/dir2"
                    ],
          expected_tree => [
                    "dir1/",
                    ],
        },
        # Updating a tree - enclosed should change, unless pinned
        { sources => [ "$testURL/source/dirA", ],
          pin => 0,
          update => 1,
          ext_dir => "dirA/dir1",
          expected_externals => [
                    "DIR2 $testURL/dest/dirA/dir2",
                    "DIR2Pin -r __PINREV__ $testURL/source/dirA/dir2",
                    "DIR3     $testURL/source/dirB/dir3",
                    "DIR4		$testURL/wibble/dirA/dir2"
                    ],
          expected_tree => [
                    "dirA/",
                    "dirA/dir1/",
                    "dirA/dir2/",
                    ],
        },
        # Updating with no update - no change
        { sources => [ "$testURL/source/dirA", ],
          pin => 0,
          update => 0,
          ext_dir => "dirA/dir1",
          expected_externals => [ 
                    "DIR2 $testURL/source/dirA/dir2",
                    "DIR2Pin -r __PINREV__ $testURL/source/dirA/dir2",
                    "DIR3     $testURL/source/dirB/dir3",
                    "DIR4		$testURL/wibble/dirA/dir2"
                    ],
          expected_tree => [
                    "dirA/",
                    "dirA/dir1/",
                    "dirA/dir2/",
                    ],
        },
        # Updating with two sources
        { sources => [ "$testURL/source/dirA/dir1",
                       "$testURL/source/dirB/dir3" ],
          pin => 0,
          update => 1,
          ext_dir => "dir1",
          expected_externals => [
                    "DIR2 $testURL/source/dirA/dir2",
                    "DIR2Pin -r __PINREV__ $testURL/source/dirA/dir2",
                    "DIR3     $testURL/dest/dir3",
                    "DIR4		$testURL/wibble/dirA/dir2"
                    ],
          expected_tree => [
                    "dir1/",
                    "dir3/",
                    ],
        },
        # Pinning
        { sources => [ "$testURL/source/dirA/dir1", ],
          pin => 1,
          update => 0,
          ext_dir => "dir1",
          expected_externals => [
                    "DIR2 -r __REV__ $testURL/source/dirA/dir2",
                    "DIR2Pin -r __PINREV__ $testURL/source/dirA/dir2",
                    "DIR3 -r __REV__     $testURL/source/dirB/dir3",
                    "DIR4 -r __REV__		$testURL/wibble/dirA/dir2",
                    ],
          expected_tree => [
                    "dir1/",
                    ],
        },
        # Pinning a tree
        { sources => [ "$testURL/source/dirA", ],
          pin => 1,
          update => 0,
          ext_dir => "dirA/dir1",
          expected_externals => [
                    "DIR2 -r __REV__ $testURL/source/dirA/dir2",
                    "DIR2Pin -r __PINREV__ $testURL/source/dirA/dir2",
                    "DIR3 -r __REV__     $testURL/source/dirB/dir3",
                    "DIR4 -r __REV__		$testURL/wibble/dirA/dir2",
                    ],
          expected_tree => [
                    "dirA/",
                    "dirA/dir1/",
                    "dirA/dir2/",
                    ],
        },
        # Pinning with two sources
        { sources => [ "$testURL/source/dirA/dir1",
                       "$testURL/source/dirB/dir3" ],
          pin => 1,
          update => 0,
          ext_dir => "dir1",
          expected_externals => [
                    "DIR2 -r __REV__ $testURL/source/dirA/dir2",
                    "DIR2Pin -r __PINREV__ $testURL/source/dirA/dir2",
                    "DIR3 -r __REV__     $testURL/source/dirB/dir3",
                    "DIR4 -r __REV__		$testURL/wibble/dirA/dir2",
                    ],
          expected_tree => [
                    "dir1/",
                    "dir3/",
                    ],
        },
    );
    
  my $auto_temp_dir = Temp::Delete->new();
  my $test_temp_dir = $auto_temp_dir->temp_dir();
  $temp_dir = $test_temp_dir;
  print "\n################################################################\n";
  print( "Testing svncopy.pl\n" );
  info( "Using temporary directory $test_temp_dir\n" );
  print( "Preparing source directory structure...\n" );

  #
  # Set up the source directory to copy
  #
    
  # Kill the directory if it's there
  info( " - Deleting '$testURL'\n" );
  SVNCall( 'delete', '-m', '"Preparing to test svncopy --update-externals"', $testURL );
    
  # Now create the source directories
  foreach my $dir ( @testdirs )
    {
      if ( !CreateTestDirectory( "$testURL/$dir" ) )
        {
          $failed = 1;
          return;
        }
    }

  # Check out the test root
  if ( 0 != SVNCall( "co", $testURL, "$test_temp_dir/$testsubdir" ) )
    {
      error( "Preparatory checkout failed" );
      $failed = 1;
      return;
    }
    
  # Set an svn:externals on it
  # - work our what externals we need to set (get the revision for the
  #   pinned directory)
  my $pinnedRev = CurrentRevision( "$testURL/$pinnedDir" );
  $test_externals =~ s|__PINREV__|$pinnedRev|gi;
    
  # Now write the externals to a temporary file and set them on the dir.
  my ($handle, $tmpfile) = tempfile( DIR => $test_temp_dir );
  print $handle $test_externals;
  close($handle);
  if ( 0 != SVNCall( "propset", "svn:externals",
                     "--file", $tmpfile,
                     "$test_temp_dir/$testsubdir/$dirWithExternals" ) )
    {
      error( "svn propset of svn:externals failed" );
      $failed = 1;
      return;
    }
    
  # And commit them
  if ( 0 != SVNCall( "commit", "-m",
                     "\"Testing svncopy --update_externals - adding svn:externals\"",
                     "$test_temp_dir/$testsubdir/$dirWithExternals" ) )
    {
      error( "svn commit failed" );
      $failed = 1;
      return;
    }
    
  #
  # Also set a property on the pinned directory to make sure the pinned
  # revision isn't the last one.
  #
  if ( 0 != SVNCall( "propset",
                     "svncopyTest",
                     "wibble",
                     "$test_temp_dir/$testsubdir/$pinnedDir" ) )
    {
      error( "svn propset of svncopyTest failed" );
      $failed = 1;
      return;
    }
  # And commit
  if ( 0 != SVNCall( "commit", "-m",
                     "\"Testing svncopy --update_externals - adding svncopyTest property\"",
                     "$test_temp_dir/$testsubdir/$pinnedDir" ) )
    {
      error( "svn commit failed" );
      $failed = 1;
      return;
    }

  # Having done all the set-up, get our revision numbers.
  foreach my $dir ( @testdirs )
    {
      $revisions{ "$testURL/$dir" } = CurrentRevision( "$testURL/$dir" );
    }
    
  print( "...Source directory structure complete\n" );
    
  # Script parameters
  my $message = "\"Testing svncopy.pl\"";
    
  TEST: foreach my $testtype ( "HEAD", "-r" )
    {
      my @copy_options = @svn_options;
      my $testno = 1;
        
      # Do extra setup for -r
      if ( "-r" eq $testtype )
        {
          $testRev = $revisions{ "$testURL/$pinnedDir" };
          print "Updating repository to run --revision tests against revision ".
                "$testRev...\n";
                  
          #
          # Copy the same revision we did before
          # The last thing we changed was the pinned directory, so
          # take its revision as the one we want to copy.
          #
          push( @copy_options, "--revision", "$testRev" );
            
          #
          # Now add a file to each directory.
          #
          foreach my $dir ( @testdirs )
            {
              if ( !UpdateTestDirectory( "$test_temp_dir/$testsubdir/$dir" ) )
                {
                  $failed = 1;
                  return;
                }
            }
        
          # And commit
          if ( 0 != SVNCall( "commit", "-m",
                             "\"Testing svncopy --update_externals".
                             " - updating directories for '--revision' test\"",
                             "$test_temp_dir/$testsubdir" ) )
            {
              error( "svn commit of updated directories failed" );
              $failed = 1;
              return;
            }
            
          print "...update done.  Now re-running tests against new repository\n";
        }
        
      foreach my $test ( @tests )
        {
          my @cmd_options = @copy_options;
            
          print "\n################################################################\n";
          print "### test number $testno\n";
            
          # Kill the destination directory if it's there
          $verbose = 0;
          SVNCall( 'delete', '-m', '"Preparing to test svncopy --update-externals"', $dest );
          $verbose = $old_verbose;
            
          my @sources = @{$test->{sources}};
          my @expected_externals = @{$test->{expected_externals}};
          my @expected_tree = @{$test->{expected_tree}};
            
          # Update global parameters
          push( @cmd_options, "--message", "$message" );
          push( @cmd_options, "--tag" ) if ( $test->{pin} );
          push( @cmd_options, "--branch" ) if ( $test->{update} );
            
          # Now do the copy
          my @cmdline = ( "perl", "svncopy.pl", @cmd_options, @sources, $dest );
          info( "\n=> Calling ", join( " ", @cmdline ), "\n\n" );
          if ( system( @cmdline ) )
            {
              error( "Copy failed" );
              $failed = 1;
            }
            
          # Check that the generated tree is as expected.
          if ( !CheckTree( $dest, @expected_tree ) )
            {
              # CheckTree outputs an error message if it fails
              $failed = 1;
            }
            
          # And check the externals
          my $ext_dir = "$dest/$test->{ext_dir}";
          if ( !CheckExternals( $ext_dir, \%revisions, $pinnedRev, @expected_externals ) )
            {
              # CheckExternals outputs an error message if it fails
              $failed = 1;
            }
            
          # Bomb out if we had an error
          if ( $failed )
            {
              print "\n*** '$testtype' test $testno failed ***\n";
              print "****************************************************************\n";
              last TEST;
            }
                        
          print "\n### '$testtype' test $testno passed\n";
          print "################################################################\n";
          $testno++;
        }
    }

  if ( $failed ) { error( "*** svncopy tests failed\n" ); }
  else { print "... svncopy tests passed\n"; }
}


#------------------------------------------------------------------------------
# Function:    CreateTestDirectory
#
# Creates a directory in svn.
#
# Parameters:
#       svnpath    directory to create
#
# Returns:     non-zero on success
#------------------------------------------------------------------------------
sub CreateTestDirectory
{
  my $svnpath = $_[0];
    
  my $test_uri = URI->new( "$svnpath" );
  info( "Creating '$test_uri'\n" );
  if ( !CreateSVNDirectories( $test_uri, "Testing svncopy --update_externals" ) )
    {
      error( "CreateSVNDirectories on '$test_uri' failed" );
      return 0;
    }

  return 1;
}


#------------------------------------------------------------------------------
# Function:    UpdateTestDirectory
#
# Modifies the directory in the working copy so that we can check the version
# copied is correct.
#
# Parameters:
#       dir        directory to modify (on file system)
#
# Returns:     non-zero on success
#------------------------------------------------------------------------------
sub UpdateTestDirectory
{
  my $dir = $_[0];
  my $testfile = "$dir/test.txt";
    
  # Create a file in the directory
  if ( !open FILE, ">$testfile" )
    {
      error( "Couldn't create test file '$testfile'" );
      return 0;
    }
  print FILE "Test file in '$dir'\n";
  close FILE;
    
  # Now add it to Subversion
  if ( 0 != SVNCall( "add", $testfile ) )
    {
      error( "svn add '$testfile' failed" );
      return 0;
    }
    
  # We're done
  return 1;
}


#------------------------------------------------------------------------------
# Function:    CheckTree
#
# Checks that directory structure in the subversion location matches
# the given tree.
#
# Parameters:
#       svnpath    Subversion location to check.
#       expected   Expected response - list of files and dirs as returned
#                  by svn list.
#
# Returns:     non-zero on success
#------------------------------------------------------------------------------
sub CheckTree
{
  my ( $svnpath, @expected ) = @_;
    
  my ( $retval, @output ) = SVNCall( "list", "--recursive", $svnpath );
  if ( 0 != $retval )
    {
      error( "svn list on '$svnpath' failed" );
      return 0;
    }
    
  # Remove any blank lines and carriage returns
  @output = grep( { chomp($_); $_ !~ m"^\s*$"} @output );
    
  # Now compare with expected
  my $compare_ctx = { list1 => [@expected], list2 => [@output] };
    
  if ( 0 != CompareLists( $compare_ctx ) )
    {
      my $addedtext;
      my $removedtext;
        
      if ( @{$compare_ctx->{added}} )
        {
          $addedtext = "\n   +".join( "\n   +", @{$compare_ctx->{added}} );
        }
      if ( @{$compare_ctx->{removed}} )
        {
          $removedtext = "\n   -".join( "\n   -", @{$compare_ctx->{removed}} );
        }
      error( "'$svnpath' doesn't match expected$addedtext$removedtext\n" );
        
      return 0;
    }
    
  return 1;
}


#------------------------------------------------------------------------------
# Function:    CheckExternals
#
# Checks that the subversion location matches the given tree.
#
# Parameters:
#       svnpath    Subversion location to check.
#       revisions  Hash containing the revisions for externals.
#       pinnedRev  Revision of pinned directory.
#       expected   Expected response - list of externals as returned
#                  by svn propget svn:externals.
#
# Returns:     non-zero on success
#------------------------------------------------------------------------------
sub CheckExternals
{
  my ( $svnpath, $revisions, $pinnedRev, @expected ) = @_;
  my @new_externals;

  ( $retval, @new_externals ) =  SVNCall( "propget", "svn:externals", $svnpath );
  if ( 0 != $retval )
    {
      error( "svn propget on '$svnpath' failed" );
      return 0;
    }
    
  # Update @expected with revisions
  @expected = grep
    {
      $_ =~ s|__PINREV__|$pinnedRev|g;
      if ( $_ =~ m"(.*)\s+-r __REV__\s+(.*)" )
        {
          my $path = $1;
          my $svnpath = $2;
          my $rev = $revisions->{$svnpath};
          $_ =~ s|__REV__|$rev|g;
        }
      1;
    } @expected;
        
  # Remove any blank lines and carriage returns from the output
  @new_externals = grep( { chomp($_); $_ !~ m"^\s*$"} @new_externals );
    
  # Now compare with expected
  my $compare_ctx = { list1 => [@expected], list2 => [@new_externals] };
    
  if ( 0 != CompareLists( $compare_ctx ) )
    {
      error( "Externals on '$svnpath' don't match expected\n".
             " - expected:\n    ".
             join( "\n    ", @expected ) .
             "\n - actual:\n    ".
             join( "\n    ", @new_externals )
           );
        
      return 0;
    }
    
  return 1;
}


#------------------------------------------------------------------------------
# Function:    CurrentRevision
#
# Returns the repository revision of the last change to the given object.
#
# Parameters:
#       source      The URL to check
#
# Returns:     The relevant revision number
#------------------------------------------------------------------------------
sub CurrentRevision
{
  my $source = shift;
    
  my $old_verbose = $verbose;
  $verbose = 0;
  my ( $retval, @output ) = SVNCall( "log -q", $source );
  $verbose = $old_verbose;

  if ( 0 != $retval )
    {
      error( "CurrentRevision: log -q on '$source' failed" );
      return -1;
    }
    
  #
  # The second line should give us the info we need: e.g.
  #
  # >svn log -q http://subversion/svn/scratch/ianb/svncopy-update/source/dirA
  # ------------------------------------------------------------------------
  # r1429 | ib | 2004-06-14 17:39:36 +0100 (Mon, 14 Jun 2004)
  # ------------------------------------------------------------------------
  # r1423 | ib | 2004-06-14 17:39:26 +0100 (Mon, 14 Jun 2004)
  # ------------------------------------------------------------------------
  # r1422 | ib | 2004-06-14 17:39:23 +0100 (Mon, 14 Jun 2004)
  # ------------------------------------------------------------------------
  # r1421 | ib | 2004-06-14 17:39:22 +0100 (Mon, 14 Jun 2004)
  # ------------------------------------------------------------------------
  #
  # The second line starts with the latest revision number.
  #
  if ( $output[1] =~ m"^r(\d+) \|" )
    {
      return $1;
    }
    
  error( "CurrentRevision: log output not formatted as expected\n" );
    
  return -1;
}


#------------------------------------------------------------------------------
# Function:    SVNCall
#
# Makes a call to subversion.
#
# Parameters:
#       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 ----------------------------------