Move third-party code that is not required to be part of trunk/app into a
trunk/thirdparty "sandbox".
Patch by: Todd Larsen
Review by: to-be-reviewed
--- a/scripts/svn_load_dirs.pl Tue Aug 26 21:24:50 2008 +0000
+++ /dev/null Thu Jan 01 00:00:00 1970 +0000
@@ -1,2043 +0,0 @@
-#!/usr/bin/perl -w
-
-# $HeadURL$
-# $LastChangedDate$
-# $LastChangedBy$
-# $LastChangedRevision$
-
-$| = 1;
-
-use strict;
-use Carp;
-use Cwd;
-use Digest::MD5 2.20;
-use File::Copy 2.03;
-use File::Find;
-use File::Path 1.0404;
-use File::Temp 0.12 qw(tempdir tempfile);
-use Getopt::Long 2.25;
-use Text::Wrap;
-use URI 1.17;
-use English;
-
-$Text::Wrap::columns = 72;
-
-# Specify the location of the svn command.
-my $svn = '/usr/bin/svn';
-
-# Process the command line options.
-
-# The base URL for the portion of the repository to work in. Note
-# that this does not have to be the root of the subversion repository,
-# it can point to a subdirectory in the repository.
-my $repos_base_url;
-
-# The relative path from the repository base URL to work in to the
-# directory to load the input directories into.
-my $repos_load_rel_path;
-
-# To specify where tags, which are simply copies of the imported
-# directory, should be placed relative to the repository base URL, use
-# the -t command line option. This value must contain regular
-# expressions that match portions of the input directory names to
-# create an unique tag for each input directory. The regular
-# expressions are surrounded by a specified character to distinguish
-# the regular expression from the normal directory path.
-my $opt_import_tag_location;
-
-# Do not ask for any user input. Just go ahead and do everything.
-my $opt_no_user_input;
-
-# Do not automatically set the svn:executable property based on the
-# file's exe bit.
-my $opt_no_auto_exe;
-
-# Username to use for commits.
-my $opt_svn_username;
-
-# Password to use for commits.
-my $opt_svn_password;
-
-# Verbosity level.
-my $opt_verbose;
-
-# Path to already checked-out working copy.
-my $opt_existing_wc_dir;
-
-# List of filename patterns to ignore (as in .subversion/config's
-# "global-ignores" option).
-my $opt_glob_ignores;
-
-# This is the character used to separate regular expressions occuring
-# in the tag directory path from the path itself.
-my $REGEX_SEP_CHAR = '@';
-
-# This specifies a configuration file that contains a list of regular
-# expressions to check against a file and the properties to set on
-# matching files.
-my $property_config_filename;
-
-GetOptions('no_user_input' => \$opt_no_user_input,
- 'no_auto_exe' => \$opt_no_auto_exe,
- 'property_cfg_filename=s' => \$property_config_filename,
- 'svn_password=s' => \$opt_svn_password,
- 'svn_username=s' => \$opt_svn_username,
- 'tag_location=s' => \$opt_import_tag_location,
- 'verbose+' => \$opt_verbose,
- 'wc=s' => \$opt_existing_wc_dir,
- 'glob_ignores=s' => \$opt_glob_ignores)
- or &usage;
-&usage("$0: too few arguments") if @ARGV < 2;
-
-$repos_base_url = shift;
-$repos_load_rel_path = shift;
-
-# Check that the repository base URL and the import directories do not
-# contain any ..'s.
-if ($repos_base_url =~ /\.{2}/)
- {
- die "$0: repos base URL $repos_base_url cannot contain ..'s.\n";
- }
-if ($repos_load_rel_path =~ /\.{2}/)
- {
- die "$0: repos import relative directory path $repos_load_rel_path ",
- "cannot contain ..'s.\n";
- }
-
-# If there are no directories listed on the command line, then the
-# directories are read from standard input. In this case, the
-# -no_user_input command line option must be specified.
-if (!@ARGV and !$opt_no_user_input)
- {
- &usage("$0: must use -no_user_input if no dirs listed on command line.");
- }
-
-# The tag option cannot be used when directories are read from
-# standard input because tags may collide and no user input can be
-# taken to verify that the input is ok.
-if (!@ARGV and $opt_import_tag_location)
- {
- &usage("$0: cannot use -tag_location when dirs are read from stdin.");
- }
-
-# If the tag directory is set, then the import directory cannot be '.'.
-if (defined $opt_import_tag_location and $repos_load_rel_path eq '.')
- {
- &usage("$0: cannot set import_dir to '.' and use -t command line option.");
- }
-
-# Set the svn command line options that are used anytime svn connects
-# to the repository.
-my @svn_use_repos_cmd_opts;
-&set_svn_use_repos_cmd_opts($opt_svn_username, $opt_svn_password);
-
-# Check that the tag directories do not contain any ..'s. Also, the
-# import and tag directories cannot be absolute.
-if (defined $opt_import_tag_location and $opt_import_tag_location =~ /\.{2}/)
- {
- die "$0: repos tag relative directory path $opt_import_tag_location ",
- "cannot contain ..'s.\n";
- }
-if ($repos_load_rel_path =~ m|^/|)
- {
- die "$0: repos import relative directory path $repos_load_rel_path ",
- "cannot start with /.\n";
- }
-if (defined $opt_import_tag_location and $opt_import_tag_location =~ m|^/|)
- {
- die "$0: repos tagrelative directory path $opt_import_tag_location ",
- "cannot start with /.\n";
- }
-
-if (defined $opt_existing_wc_dir)
- {
- unless (-e $opt_existing_wc_dir)
- {
- die "$0: working copy '$opt_existing_wc_dir' does not exist.\n";
- }
-
- unless (-d _)
- {
- die "$0: working copy '$opt_existing_wc_dir' is not a directory.\n";
- }
-
- unless (-d "$opt_existing_wc_dir/.svn")
- {
- die "$0: working copy '$opt_existing_wc_dir' does not have .svn ",
- "directory.\n";
- }
-
- $opt_existing_wc_dir = Cwd::abs_path($opt_existing_wc_dir)
- }
-
-# If no glob_ignores specified, try to deduce from config file,
-# or use the default below.
-my $ignores_str =
- '*.o *.lo *.la #*# .*.rej *.rej .*~ *~ .#* .DS_Store';
-
-if ( defined $opt_glob_ignores)
- {
- $ignores_str = $opt_glob_ignores;
- }
-elsif ( -f "$ENV{HOME}/.subversion/config" )
- {
- open my $conf, "$ENV{HOME}/.subversion/config";
- while (<$conf>)
- {
- if ( /^global-ignores\s*=\s*(.*?)\s*$/ )
- {
- $ignores_str = $1;
- last;
- }
- }
- }
-
-my @glob_ignores = map
- {
- s/\./\\\./g; s/\*/\.\*/g; "^$_\$";
- } split(/\s+/, $ignores_str);
-unshift @glob_ignores, '\.svn$';
-
-# Convert the string URL into a URI object.
-$repos_base_url =~ s|/*$||;
-my $repos_base_uri = URI->new($repos_base_url);
-
-# Check that $repos_load_rel_path is not a directory here implying
-# that a command line option was forgotten.
-if ($repos_load_rel_path ne '.' and -d $repos_load_rel_path)
- {
- die "$0: import_dir '$repos_load_rel_path' is a directory.\n";
- }
-
-# The remaining command line arguments should be directories. Check
-# that they all exist and that there are no duplicates.
-if (@ARGV)
- {
- my %dirs;
- foreach my $dir (@ARGV)
- {
- unless (-e $dir)
- {
- die "$0: directory '$dir' does not exist.\n";
- }
-
- unless (-d _)
- {
- die "$0: directory '$dir' is not a directory.\n";
- }
-
- if ($dirs{$dir})
- {
- die "$0: directory '$dir' is listed more than once on command ",
- "line.\n";
- }
- $dirs{$dir} = 1;
- }
- }
-
-# Create the tag locations and print them for the user to review.
-# Check that there are no duplicate tags.
-my %load_tags;
-if (@ARGV and defined $opt_import_tag_location)
- {
- my %seen_tags;
-
- foreach my $load_dir (@ARGV)
- {
- my $load_tag = &get_tag_dir($load_dir);
-
- print "Directory $load_dir will be tagged as $load_tag\n";
-
- if ($seen_tags{$load_tag})
- {
- die "$0: duplicate tag generated.\n";
- }
- $seen_tags{$load_tag} = 1;
-
- $load_tags{$load_dir} = $load_tag;
- }
-
- exit 0 unless &get_answer("Please examine identified tags. Are they " .
- "acceptable? (Y/n) ", 'ny', 1);
- print "\n";
- }
-
-# Load the property configuration filename, if one was specified, into
-# an array of hashes, where each hash contains a regular expression
-# and a property to apply to the file if the regular expression
-# matches.
-my @property_settings;
-if (defined $property_config_filename and length $property_config_filename)
- {
- open(CFG, $property_config_filename)
- or die "$0: cannot open '$property_config_filename' for reading: $!\n";
-
- my $ok = 1;
-
- while (my $line = <CFG>)
- {
- next if $line =~ /^\s*$/;
- next if $line =~ /^\s*#/;
-
- # Split the input line into words taking into account that
- # single or double quotes may define a single word with
- # whitespace in it. The format for the file is
- # regex control property_name property_value
- my @line = &split_line($line);
- next if @line == 0;
-
- unless (@line == 2 or @line == 4)
- {
- warn "$0: line $. of '$property_config_filename' has to have 2 ",
- "or 4 columns.\n";
- $ok = 0;
- next;
- }
- my ($regex, $control, $property_name, $property_value) = @line;
-
- unless ($control eq 'break' or $control eq 'cont')
- {
- warn "$0: line $. of '$property_config_filename' has illegal ",
- "value for column 3 '$control', must be 'break' or 'cont'.\n";
- $ok = 0;
- next;
- }
-
- # Compile the regular expression.
- my $re;
- eval { $re = qr/$regex/i };
- if ($@)
- {
- warn "$0: line $. of '$property_config_filename' regex '$regex' ",
- "does not compile:\n$@\n";
- $ok = 0;
- next;
- }
-
- push(@property_settings, {name => $property_name,
- value => $property_value,
- control => $control,
- re => $re});
- }
- close(CFG)
- or warn "$0: error in closing '$property_config_filename' for ",
- "reading: $!\n";
-
- exit 1 unless $ok;
- }
-
-# Check that the svn base URL works by running svn log on it. Only
-# get the HEAD revision log message; there's no need to waste
-# bandwidth seeing all of the log messages.
-print "Checking that the base URL is a Subversion repository.\n";
-read_from_process($svn, 'log', '-r', 'HEAD',
- @svn_use_repos_cmd_opts, $repos_base_uri);
-print "\n";
-
-my $orig_cwd = cwd;
-
-# The first step is to determine the root of the svn repository. Do
-# this with the svn log command. Take the svn_url hostname and port
-# as the initial url and append to it successive portions of the final
-# path until svn log succeeds.
-print "Finding the root URL of the Subversion repository.\n";
-my $repos_root_uri;
-my $repos_root_uri_path;
-my $repos_base_path_segment;
-{
- my $r = $repos_base_uri->clone;
- my @path_segments = grep { length($_) } $r->path_segments;
- my @repos_base_path_segments = @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 (safe_read_from_pipe($svn, 'log', '-r', 'HEAD',
- @svn_use_repos_cmd_opts, $r) == 0)
- {
- $repos_root_uri = $r;
- last;
- }
- shift @repos_base_path_segments;
- }
- $repos_base_path_segment = join('/', @repos_base_path_segments);
-}
-
-if ($repos_root_uri)
- {
- print "Determined that the svn root URL is $repos_root_uri.\n\n";
- }
-else
- {
- die "$0: cannot determine root svn URL.\n";
- }
-
-# Create a temporary directory for svn to work in.
-my $temp_dir = tempdir( "svn_load_dirs_XXXXXXXXXX", TMPDIR => 1 );
-
-# 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;
-
-# Create an object that when DESTROY'ed will delete the temporary
-# directory. The CLEANUP flag to tempdir should do this, but they
-# call rmtree with 1 as the last argument which takes extra security
-# measures that do not clean up the .svn directories.
-my $temp_dir_cleanup = Temp::Delete->new;
-
-# Determine the native end of line style for this system. Do this the
-# most portable way, by writing a file with a single \n in non-binary
-# mode and then reading the file in binary mode.
-my $native_eol = &determine_native_eol;
-
-# Check if all the directories exist to load the directories into the
-# repository. If not, ask if they should be created. For tags, do
-# not create the tag directory itself, that is done on the svn cp.
-{
- print "Finding if any directories need to be created in repository.\n";
-
- my @dirs_to_create;
- my @urls_to_create;
- my %seen_dir;
- my @load_tags_without_last_segment;
-
- # Assume that the last portion of the tag directory contains the
- # version number and remove it from the directories to create,
- # because the tag directory will be created by svn cp.
- foreach my $load_tag (sort values %load_tags)
- {
- # Skip this tag if there is only one segment in its name.
- my $index = rindex($load_tag, '/');
- next if $index == -1;
-
- # Trim off the last segment and record the result.
- push(@load_tags_without_last_segment, substr($load_tag, 0, $index));
- }
-
- foreach my $dir ($repos_load_rel_path, @load_tags_without_last_segment)
- {
- next unless length $dir;
- my $d = '';
- foreach my $segment (split('/', $dir))
- {
- $d = length $d ? "$d/$segment" : $segment;
- my $url = "$repos_base_url/$d";
- unless ($seen_dir{$d})
- {
- $seen_dir{$d} = 1;
- if (safe_read_from_pipe($svn, 'log', '-r', 'HEAD',
- @svn_use_repos_cmd_opts, $url) != 0)
- {
- push(@dirs_to_create, $d);
- push(@urls_to_create, $url);
- }
- }
- }
- }
-
- if (@dirs_to_create)
- {
- print "The following directories do not exist and need to exist:\n";
- foreach my $dir (@dirs_to_create)
- {
- print " $dir\n";
- }
- exit 0 unless &get_answer("You must add them now to load the " .
- "directories. Continue (Y/n)? ", 'ny', 1);
-
- my $message = "Create directories to load project into.\n\n";
-
- foreach my $dir (@dirs_to_create)
- {
- if (length $repos_base_path_segment)
- {
- $message .= "* $repos_base_path_segment/$dir: New directory.\n";
- }
- else
- {
- $message .= "* $dir: New directory.\n";
- }
- }
- $message = wrap('', ' ', $message);
-
- read_from_process($svn, 'mkdir', @svn_use_repos_cmd_opts,
- '-m', $message, @urls_to_create);
- }
- else
- {
- print "No directories need to be created to prepare repository.\n";
- }
-}
-
-# Either checkout a new working copy from the repository or use an
-# existing working copy.
-if (defined $opt_existing_wc_dir)
- {
- # Update an already existing working copy.
- print "Not checking out anything; using existing working directory at\n";
- print "$opt_existing_wc_dir\n";
-
- chdir($opt_existing_wc_dir)
- or die "$0: cannot chdir '$opt_existing_wc_dir': $!\n";
-
- read_from_process($svn, 'update', @svn_use_repos_cmd_opts);
- }
-else
- {
- # Check out the svn repository starting at the svn URL into a
- # fixed directory name.
- my $checkout_dir_name = 'my_import_wc';
-
- # Check out only the directory being imported to, otherwise the
- # checkout of the entire base URL can be very huge, if it contains
- # a large number of tags.
- my $checkout_url;
- if ($repos_load_rel_path eq '.')
- {
- $checkout_url = $repos_base_url;
- }
- else
- {
- $checkout_url = "$repos_base_url/$repos_load_rel_path";
- }
-
- print "Checking out $checkout_url into $temp_dir/$checkout_dir_name\n";
-
- chdir($temp_dir)
- or die "$0: cannot chdir '$temp_dir': $!\n";
-
- read_from_process($svn, 'checkout',
- @svn_use_repos_cmd_opts,
- $checkout_url, $checkout_dir_name);
-
- chdir($checkout_dir_name)
- or die "$0: cannot chdir '$checkout_dir_name': $!\n";
- }
-
-# At this point, the current working directory is the top level
-# directory of the working copy. Record the absolute path to this
-# location because the script will chdir back here later on.
-my $wc_import_dir_cwd = cwd;
-
-# Set up the names for the path to the import and tag directories.
-my $repos_load_abs_path;
-if ($repos_load_rel_path eq '.')
- {
- $repos_load_abs_path = length($repos_base_path_segment) ?
- $repos_base_path_segment : "/";
- }
-else
- {
- $repos_load_abs_path = length($repos_base_path_segment) ?
- "$repos_base_path_segment/$repos_load_rel_path" :
- $repos_load_rel_path;
- }
-
-# Now go through each source directory and copy each file from the
-# source directory to the target directory. For new target files, add
-# them to svn. For files that no longer exist, delete them.
-my $print_rename_message = 1;
-my @load_dirs = @ARGV;
-while (defined (my $load_dir = &get_next_load_dir))
- {
- my $load_tag = $load_tags{$load_dir};
-
- if (defined $load_tag)
- {
- print "\nLoading $load_dir and will save in tag $load_tag.\n";
- }
- else
- {
- print "\nLoading $load_dir.\n";
- }
-
- # The first hash is keyed by the old name in a rename and the
- # second by the new name. The last variable contains a list of
- # old and new filenames in a rename.
- my %rename_from_files;
- my %rename_to_files;
- my @renamed_filenames;
-
- unless ($opt_no_user_input)
- {
- my $repeat_loop;
- do
- {
- $repeat_loop = 0;
-
- my %add_files;
- my %del_files;
-
- # Get the list of files and directories in the repository
- # working copy. This hash is called %del_files because
- # each file or directory will be deleted from the hash
- # using the list of files and directories in the source
- # directory, leaving the files and directories that need
- # to be deleted.
- %del_files = &recursive_ls_and_hash($wc_import_dir_cwd);
-
- # This anonymous subroutine finds all the files and
- # directories in the directory to load. It notes the file
- # type and for each file found, it deletes it from
- # %del_files.
- my $wanted = sub
- {
- s#^\./##;
- return if $_ eq '.';
-
- my $source_path = $_;
- my $dest_path = "$wc_import_dir_cwd/$_";
-
- my ($source_type) = &file_info($source_path);
- my ($dest_type) = &file_info($dest_path);
-
- # Fail if the destination type exists but is of a
- # different type of file than the source type.
- if ($dest_type ne '0' and $source_type ne $dest_type)
- {
- die "$0: does not handle changing source and destination ",
- "type for '$source_path'.\n";
- }
-
- if ($source_type ne 'd' and
- $source_type ne 'f' and
- $source_type ne 'l')
- {
- warn "$0: skipping loading file '$source_path' of type ",
- "'$source_type'.\n";
- unless ($opt_no_user_input)
- {
- print STDERR "Press return to continue: ";
- <STDIN>;
- }
- return;
- }
-
- unless (defined delete $del_files{$source_path})
- {
- $add_files{$source_path}{type} = $source_type;
- }
- };
-
- # Now change into the directory containing the files to
- # load. First change to the original directory where this
- # script was run so that if the specified directory is a
- # relative directory path, then the script can change into
- # it.
- chdir($orig_cwd)
- or die "$0: cannot chdir '$orig_cwd': $!\n";
- chdir($load_dir)
- or die "$0: cannot chdir '$load_dir': $!\n";
-
- find({no_chdir => 1,
- preprocess => sub { sort { $b cmp $a }
- grep { $_ !~ /^[._]svn$/ } @_ },
- wanted => $wanted
- }, '.');
-
- # At this point %add_files contains the list of new files
- # and directories to be created in the working copy tree
- # and %del_files contains the files and directories that
- # need to be deleted. Because there may be renames that
- # have taken place, give the user the opportunity to
- # rename any deleted files and directories to ones being
- # added.
- my @add_files = sort keys %add_files;
- my @del_files = sort keys %del_files;
-
- # Because the source code management system may keep the
- # original renamed file or directory in the working copy
- # until a commit, remove them from the list of deleted
- # files or directories.
- &filter_renamed_files(\@del_files, \%rename_from_files);
-
- # Now change into the working copy directory in case any
- # renames need to be performed.
- chdir($wc_import_dir_cwd)
- or die "$0: cannot chdir '$wc_import_dir_cwd': $!\n";
-
- # Only do renames if there are both added and deleted
- # files and directories.
- if (@add_files and @del_files)
- {
- my $max = @add_files > @del_files ? @add_files : @del_files;
-
- # Print the files that have been added and deleted.
- # Find the deleted file with the longest name and use
- # that for the width of the filename column. Add one
- # to the filename width to let the directory /
- # character be appended to a directory name.
- my $line_number_width = 4;
- my $filename_width = 0;
- foreach my $f (@del_files)
- {
- my $l = length($f);
- $filename_width = $l if $l > $filename_width;
- }
- ++$filename_width;
- my $printf_format = "%${line_number_width}d";
-
- if ($print_rename_message)
- {
- $print_rename_message = 0;
- print "\n",
- "The following table lists files and directories that\n",
- "exist in either the Subversion repository or the\n",
- "directory to be imported but not both. You now have\n",
- "the opportunity to match them up as renames instead\n",
- "of deletes and adds. This is a Good Thing as it'll\n",
- "make the repository take less space.\n\n",
- "The left column lists files and directories that\n",
- "exist in the Subversion repository and do not exist\n",
- "in the directory being imported. The right column\n",
- "lists files and directories that exist in the\n",
- "directory being imported. Match up a deleted item\n",
- "from the left column with an added item from the\n",
- "right column. Note the line numbers on the left\n",
- "which you type into this script to have a rename\n",
- "performed.\n";
- }
-
- # Sort the added and deleted files and directories by
- # the lowercase versions of their basenames instead of
- # their complete path, which makes finding files that
- # were moved into different directories easier to
- # match up.
- @add_files = map { $_->[0] }
- sort { $a->[1] cmp $b->[1] }
- map { [$_->[0], lc($_->[1])] }
- map { [$_, m#([^/]+)$#] }
- @add_files;
- @del_files = map { $_->[0] }
- sort { $a->[1] cmp $b->[1] }
- map { [$_->[0], lc($_->[1])] }
- map { [$_, m#([^/]+)$#] }
- @del_files;
-
- RELIST:
-
- for (my $i=0; $i<$max; ++$i)
- {
- my $add_filename = '';
- my $del_filename = '';
- if ($i < @add_files)
- {
- $add_filename = $add_files[$i];
- if ($add_files{$add_filename}{type} eq 'd')
- {
- $add_filename .= '/';
- }
- }
- if ($i < @del_files)
- {
- $del_filename = $del_files[$i];
- if ($del_files{$del_filename}{type} eq 'd')
- {
- $del_filename .= '/';
- }
- }
-
- if ($i % 22 == 0)
- {
- print
- "\n",
- " " x $line_number_width,
- " ",
- "Deleted", " " x ($filename_width-length("Deleted")),
- " ",
- "Added\n";
- }
-
- printf $printf_format, $i;
- print " ", $del_filename,
- "_" x ($filename_width - length($del_filename)),
- " ", $add_filename, "\n";
-
- if (($i+1) % 22 == 0)
- {
- unless (&get_answer("Continue printing (Y/n)? ",
- 'ny', 1))
- {
- last;
- }
- }
- }
-
- # Get the feedback from the user.
- my $line;
- my $add_filename;
- my $add_index;
- my $del_filename;
- my $del_index;
- my $got_line = 0;
- do {
- print "Enter two indexes for each column to rename, ",
- "(R)elist, or (F)inish: ";
- $line = <STDIN>;
- $line = '' unless defined $line;
- if ($line =~ /^R$/i )
- {
- goto RELIST;
- }
-
- if ($line =~ /^F$/i)
- {
- $got_line = 1;
- }
- elsif ($line =~ /^(\d+)\s+(\d+)$/)
- {
- print "\n";
-
- $del_index = $1;
- $add_index = $2;
- if ($del_index >= @del_files)
- {
- print "Delete index $del_index is larger than ",
- "maximum index of ", scalar @del_files - 1,
- ".\n";
- $del_index = undef;
- }
- if ($add_index > @add_files)
- {
- print "Add index $add_index is larger than maximum ",
- "index of ", scalar @add_files - 1, ".\n";
- $add_index = undef;
- }
- $got_line = defined $del_index && defined $add_index;
-
- # Check that the file or directory to be renamed
- # has the same file type.
- if ($got_line)
- {
- $add_filename = $add_files[$add_index];
- $del_filename = $del_files[$del_index];
- if ($add_files{$add_filename}{type} ne
- $del_files{$del_filename}{type})
- {
- print "File types for $del_filename and ",
- "$add_filename differ.\n";
- $got_line = undef;
- }
- }
- }
- } until ($got_line);
-
- if ($line !~ /^F$/i)
- {
- print "Renaming $del_filename to $add_filename.\n";
-
- $repeat_loop = 1;
-
- # Because subversion cannot rename the same file
- # or directory twice, which includes doing a
- # rename of a file in a directory that was
- # previously renamed, a commit has to be
- # performed. Check if the file or directory being
- # renamed now would cause such a problem and
- # commit if so.
- my $do_commit_now = 0;
- foreach my $rename_to_filename (keys %rename_to_files)
- {
- if (contained_in($del_filename,
- $rename_to_filename,
- $rename_to_files{$rename_to_filename}{type}))
- {
- $do_commit_now = 1;
- last;
- }
- }
-
- if ($do_commit_now)
- {
- print "Now committing previously run renames.\n";
- &commit_renames($load_dir,
- \@renamed_filenames,
- \%rename_from_files,
- \%rename_to_files);
- }
-
- push(@renamed_filenames, $del_filename, $add_filename);
- {
- my $d = $del_files{$del_filename};
- $rename_from_files{$del_filename} = $d;
- $rename_to_files{$add_filename} = $d;
- }
-
- # Check that any required directories to do the
- # rename exist.
- my @add_segments = split('/', $add_filename);
- pop(@add_segments);
- my $add_dir = '';
- my @add_dirs;
- foreach my $segment (@add_segments)
- {
- $add_dir = length($add_dir) ? "$add_dir/$segment" :
- $segment;
- unless (-d $add_dir)
- {
- push(@add_dirs, $add_dir);
- }
- }
-
- if (@add_dirs)
- {
- read_from_process($svn, 'mkdir', @add_dirs);
- }
-
- read_from_process($svn, 'mv',
- $del_filename, $add_filename);
- }
- }
- } while ($repeat_loop);
- }
-
- # If there are any renames that have not been committed, then do
- # that now.
- if (@renamed_filenames)
- {
- &commit_renames($load_dir,
- \@renamed_filenames,
- \%rename_from_files,
- \%rename_to_files);
- }
-
- # At this point all renames have been performed. Now get the
- # final list of files and directories in the working copy
- # directory. The %add_files hash will contain the list of files
- # and directories to add to the working copy and %del_files starts
- # with all the files already in the working copy and gets files
- # removed that are in the imported directory, which results in a
- # list of files that should be deleted. %upd_files holds the list
- # of files that have been updated.
- my %add_files;
- my %del_files = &recursive_ls_and_hash($wc_import_dir_cwd);
- my %upd_files;
-
- # This anonymous subroutine copies files from the source directory
- # to the working copy directory.
- my $wanted = sub
- {
- s#^\./##;
- return if $_ eq '.';
-
- my $source_path = $_;
- my $dest_path = "$wc_import_dir_cwd/$_";
-
- my ($source_type, $source_is_exe) = &file_info($source_path);
- my ($dest_type) = &file_info($dest_path);
-
- return if ($source_type ne 'd' and
- $source_type ne 'f' and
- $source_type ne 'l');
-
- # Fail if the destination type exists but is of a different
- # type of file than the source type.
- if ($dest_type ne '0' and $source_type ne $dest_type)
- {
- die "$0: does not handle changing source and destination type ",
- "for '$source_path'.\n";
- }
-
- # Determine if the file is being added or is an update to an
- # already existing file using the file's digest.
- my $del_info = delete $del_files{$source_path};
- if (defined $del_info)
- {
- if (defined (my $del_digest = $del_info->{digest}))
- {
- my $new_digest = &digest_hash_file($source_path);
- if ($new_digest ne $del_digest)
- {
- print "U $source_path\n";
- $upd_files{$source_path} = $del_info;
- }
- }
- }
- else
- {
- print "A $source_path\n";
- $add_files{$source_path}{type} = $source_type;
-
- # Create an array reference to hold the list of properties
- # to apply to this object.
- unless (defined $add_files{$source_path}{properties})
- {
- $add_files{$source_path}{properties} = [];
- }
-
- # Go through the list of properties for a match on this
- # file or directory and if there is a match, then apply
- # the property to it.
- foreach my $property (@property_settings)
- {
- my $re = $property->{re};
- if ($source_path =~ $re)
- {
- my $property_name = $property->{name};
- my $property_value = $property->{value};
-
- # The property value may not be set in the
- # configuration file, since the user may just want
- # to set the control flag.
- if (defined $property_name and defined $property_value)
- {
- # Ignore properties that do not apply to
- # directories.
- if ($source_type eq 'd')
- {
- if ($property_name eq 'svn:eol-style' or
- $property_name eq 'svn:executable' or
- $property_name eq 'svn:keywords' or
- $property_name eq 'svn:mime-type')
- {
- next;
- }
- }
-
- # Ignore properties that do not apply to
- # files.
- if ($source_type eq 'f')
- {
- if ($property_name eq 'svn:externals' or
- $property_name eq 'svn:ignore')
- {
- next;
- }
- }
-
- print "Adding to '$source_path' property ",
- "'$property_name' with value ",
- "'$property_value'.\n";
-
- push(@{$add_files{$source_path}{properties}},
- $property);
- }
-
- last if $property->{control} eq 'break';
- }
- }
- }
-
- # Add svn:executable to files that have their executable bit
- # set.
- if ($source_is_exe and !$opt_no_auto_exe)
- {
- print "Adding to '$source_path' property 'svn:executable' with ",
- "value '*'.\n";
- my $property = {name => 'svn:executable', value => '*'};
- push (@{$add_files{$source_path}{properties}},
- $property);
- }
-
- # Now make sure the file or directory in the source directory
- # exists in the repository.
- if ($source_type eq 'd')
- {
- if ($dest_type eq '0')
- {
- mkdir($dest_path)
- or die "$0: cannot mkdir '$dest_path': $!\n";
- }
- }
- elsif
- ($source_type eq 'l') {
- my $link_target = readlink($source_path)
- or die "$0: cannot readlink '$source_path': $!\n";
- if ($dest_type eq 'l')
- {
- my $old_target = readlink($dest_path)
- or die "$0: cannot readlink '$dest_path': $!\n";
- return if ($old_target eq $link_target);
- unlink($dest_path)
- or die "$0: unlink '$dest_path' failed: $!\n";
- }
- symlink($link_target, $dest_path)
- or die "$0: cannot symlink '$dest_path' to '$link_target': $!\n";
- }
- elsif
- ($source_type eq 'f') {
- # Only copy the file if the digests do not match.
- if ($add_files{$source_path} or $upd_files{$source_path})
- {
- copy($source_path, $dest_path)
- or die "$0: copy '$source_path' to '$dest_path': $!\n";
- }
- }
- else
- {
- die "$0: does not handle copying files of type '$source_type'.\n";
- }
- };
-
- # Now change into the directory containing the files to load.
- # First change to the original directory where this script was run
- # so that if the specified directory is a relative directory path,
- # then the script can change into it.
- chdir($orig_cwd)
- or die "$0: cannot chdir '$orig_cwd': $!\n";
- chdir($load_dir)
- or die "$0: cannot chdir '$load_dir': $!\n";
-
- find({no_chdir => 1,
- preprocess => sub { sort { $b cmp $a }
- grep { $_ !~ /^[._]svn$/ } @_ },
- wanted => $wanted
- }, '.');
-
- # The files and directories that are in %del_files are the files
- # and directories that need to be deleted. Because svn will
- # return an error if a file or directory is deleted in a directory
- # that subsequently is deleted, first find all directories and
- # remove from the list any files and directories inside those
- # directories from this list. Work through the list repeatedly
- # working from short to long names so that directories containing
- # other files and directories will be deleted first.
- my $repeat_loop;
- do
- {
- $repeat_loop = 0;
- my @del_files = sort {length($a) <=> length($b) || $a cmp $b}
- keys %del_files;
- &filter_renamed_files(\@del_files, \%rename_from_files);
- foreach my $file (@del_files)
- {
- if ($del_files{$file}{type} eq 'd')
- {
- my $dir = "$file/";
- my $dir_length = length($dir);
- foreach my $f (@del_files)
- {
- next if $file eq $f;
- if (length($f) >= $dir_length and
- substr($f, 0, $dir_length) eq $dir)
- {
- print "d $f\n";
- delete $del_files{$f};
- $repeat_loop = 1;
- }
- }
-
- # If there were any deletions of files and/or
- # directories inside a directory that will be deleted,
- # then restart the entire loop again, because one or
- # more keys have been deleted from %del_files.
- # Equally important is not to stop this loop if no
- # deletions have been done, otherwise later
- # directories that may contain files and directories
- # to be deleted will not be deleted.
- last if $repeat_loop;
- }
- }
- } while ($repeat_loop);
-
- # What is left are files that are not in any directories to be
- # deleted and directories to be deleted. To delete the files,
- # deeper files and directories must be deleted first. Because we
- # have a hash keyed by remaining files and directories to be
- # deleted, instead of trying to figure out which directories and
- # files are contained in other directories, just reverse sort by
- # the path length and then alphabetically.
- my @del_files = sort {length($b) <=> length($a) || $a cmp $b }
- keys %del_files;
- &filter_renamed_files(\@del_files, \%rename_from_files);
- foreach my $file (@del_files)
- {
- print "D $file\n";
- }
-
- # Now change back to the trunk directory and run the svn commands.
- chdir($wc_import_dir_cwd)
- or die "$0: cannot chdir '$wc_import_dir_cwd': $!\n";
-
- # If any of the added files have the svn:eol-style property set,
- # then pass -b to diff, otherwise diff may fail because the end of
- # lines have changed and the source file and file in the
- # repository will not be identical.
- my @diff_ignore_space_changes;
-
- if (keys %add_files)
- {
- my @add_files = sort {length($a) <=> length($b) || $a cmp $b}
- keys %add_files;
- my $target_filename = &make_targets_file(@add_files);
- read_from_process($svn, 'add', '-N', '--targets', $target_filename);
- unlink($target_filename);
-
- # Add properties on the added files.
- foreach my $add_file (@add_files)
- {
- foreach my $property (@{$add_files{$add_file}{properties}})
- {
- my $property_name = $property->{name};
- my $property_value = $property->{value};
-
- if ($property_name eq 'svn:eol-style')
- {
- @diff_ignore_space_changes = ('-b');
- }
-
- # Write the value to a temporary file in case it's multi-line
- my ($handle, $tmpfile) = tempfile(DIR => $temp_dir);
- print $handle $property_value;
- close($handle);
-
- read_from_process($svn,
- 'propset',
- $property_name,
- '--file',
- $tmpfile,
- $add_file);
- }
- }
- }
- if (@del_files)
- {
- my $target_filename = &make_targets_file(@del_files);
- read_from_process($svn, 'rm', '--targets', $target_filename);
- unlink($target_filename);
- }
-
- # Go through the list of updated files and check the svn:eol-style
- # property. If it is set to native, then convert all CR, CRLF and
- # LF's in the file to the native end of line characters. Also,
- # modify diff's command line so that it will ignore the change in
- # end of line style.
- if (keys %upd_files)
- {
- my @upd_files = sort {length($a) <=> length($b) || $a cmp $b}
- keys %upd_files;
- foreach my $upd_file (@upd_files)
- {
- # Always append @BASE to a filename in case they contain a
- # @ character, in which case the Subversion command line
- # client will attempt to parse the characters after the @
- # as a revision and most likely fail, or if the characters
- # after the @ are a valid revision, then it'll possibly
- # get the incorrect information. So always append @BASE
- # and any preceding @'s will be treated normally and the
- # correct information will be retrieved.
- my @command = ($svn,
- 'propget',
- 'svn:eol-style',
- "$upd_file\@BASE");
- my @lines = read_from_process(@command);
- next unless @lines;
- if (@lines > 1)
- {
- warn "$0: '@command' returned more than one line of output: ",
- "'@lines'.\n";
- next;
- }
-
- my $eol_style = $lines[0];
- if ($eol_style eq 'native')
- {
- @diff_ignore_space_changes = ('-b');
- if (&convert_file_to_native_eol($upd_file))
- {
- print "Native eol-style conversion modified $upd_file.\n";
- }
- }
- }
- }
-
- my $message = wrap('', '', "Load $load_dir into $repos_load_abs_path.\n");
- read_from_process($svn, 'commit',
- @svn_use_repos_cmd_opts,
- '-m', $message);
-
- # If an update is not run now after a commit, then some file and
- # directory paths will have an older revisions associated with
- # them and any future commits will fail because they are out of
- # date.
- read_from_process($svn, 'update', @svn_use_repos_cmd_opts);
-
- # Now remove any files and directories to be deleted in the
- # repository.
- if (@del_files)
- {
- rmtree(\@del_files, 1, 0);
- }
-
- # Now make the tag by doing a copy in the svn repository itself.
- if (defined $load_tag)
- {
- my $repos_tag_abs_path = length($repos_base_path_segment) ?
- "$repos_base_path_segment/$load_tag" :
- $load_tag;
-
- my $from_url = $repos_load_rel_path eq '.' ?
- $repos_load_rel_path :
- "$repos_base_url/$repos_load_rel_path";
- my $to_url = "$repos_base_url/$load_tag";
-
- $message = wrap("",
- "",
- "Tag $repos_load_abs_path as " .
- "$repos_tag_abs_path.\n");
- read_from_process($svn, 'cp', @svn_use_repos_cmd_opts,
- '-m', $message, $from_url, $to_url);
-
- # Now check out the tag and run a recursive diff between the
- # original source directory and the tag for a consistency
- # check.
- my $checkout_dir_name = "my_tag_wc_named_$load_tag";
- print "Checking out $to_url into $temp_dir/$checkout_dir_name\n";
-
- chdir($temp_dir)
- or die "$0: cannot chdir '$temp_dir': $!\n";
-
- read_from_process($svn, 'checkout',
- @svn_use_repos_cmd_opts,
- $to_url, $checkout_dir_name);
-
- chdir($checkout_dir_name)
- or die "$0: cannot chdir '$checkout_dir_name': $!\n";
-
- chdir($orig_cwd)
- or die "$0: cannot chdir '$orig_cwd': $!\n";
- read_from_process('diff', '-u', @diff_ignore_space_changes,
- '-x', '.svn',
- '-r', $load_dir, "$temp_dir/$checkout_dir_name");
- }
- }
-
-exit 0;
-
-sub usage
-{
- warn "@_\n" if @_;
- die "usage: $0 [options] svn_url svn_import_dir [dir_v1 [dir_v2 [..]]]\n",
- " svn_url is the file:// or http:// URL of the svn repository\n",
- " svn_import_dir is the path relative to svn_url where to load dirs\n",
- " dir_v1 .. list dirs to import otherwise read from stdin\n",
- "options are\n",
- " -no_user_input don't ask yes/no questions and assume yes answer\n",
- " -no_auto_exe don't set svn:executable for executable files\n",
- " -p filename table listing properties to apply to matching files\n",
- " -svn_username username to perform commits as\n",
- " -svn_password password to supply to svn commit\n",
- " -t tag_dir create a tag copy in tag_dir, relative to svn_url\n",
- " -v increase program verbosity, multiple -v's allowed\n",
- " -wc path use the already checked-out working copy at path\n",
- " instead of checkout out a fresh working copy\n",
- " -glob_ignores List of filename patterns to ignore (as in svn's\n",
- " global-ignores config option)\n";
-}
-
-# Get the next directory to load, either from the command line or from
-# standard input.
-my $get_next_load_dir_init = 0;
-my @get_next_load_dirs;
-sub get_next_load_dir
-{
- if (@ARGV)
- {
- unless ($get_next_load_dir_init)
- {
- $get_next_load_dir_init = 1;
- @get_next_load_dirs = @ARGV;
- }
- return shift @get_next_load_dirs;
- }
-
- if ($opt_verbose)
- {
- print "Waiting for next directory to import on standard input:\n";
- }
- my $line = <STDIN>;
-
- print "\n" if $opt_verbose;
-
- chomp $line;
- if ($line =~ m|(\S+)\s+(\S+)|)
- {
- $line = $1;
- set_svn_use_repos_cmd_opts($2, $opt_svn_password);
- }
- $line;
-}
-
-# This constant stores the commonly used string to indicate that a
-# subroutine has been passed an incorrect number of arguments.
-use vars qw($INCORRECT_NUMBER_OF_ARGS);
-$INCORRECT_NUMBER_OF_ARGS = "passed incorrect number of arguments.\n";
-
-# Creates a temporary file in the temporary directory and stores the
-# arguments in it for use by the svn --targets command line option.
-# If any part of the file creation failed, exit the program, as
-# there's no workaround. Use a unique number as a counter to the
-# files.
-my $make_targets_file_counter;
-sub make_targets_file
-{
- unless (@_)
- {
- confess "$0: make_targets_file $INCORRECT_NUMBER_OF_ARGS";
- }
-
- $make_targets_file_counter = 1 unless defined $make_targets_file_counter;
-
- my $filename = sprintf "%s/targets.%05d",
- $temp_dir,
- $make_targets_file_counter;
- ++$make_targets_file_counter;
-
- open(TARGETS, ">$filename")
- or die "$0: cannot open '$filename' for writing: $!\n";
-
- foreach my $file (@_)
- {
- print TARGETS "$file\n";
- }
-
- close(TARGETS)
- or die "$0: error in closing '$filename' for writing: $!\n";
-
- $filename;
-}
-
-# Set the svn command line options that are used anytime svn connects
-# to the repository.
-sub set_svn_use_repos_cmd_opts
-{
- unless (@_ == 2)
- {
- confess "$0: set_svn_use_repos_cmd_opts $INCORRECT_NUMBER_OF_ARGS";
- }
-
- my $username = shift;
- my $password = shift;
-
- @svn_use_repos_cmd_opts = ('--non-interactive');
- if (defined $username and length $username)
- {
- push(@svn_use_repos_cmd_opts, '--username', $username);
- }
- if (defined $password)
- {
- push(@svn_use_repos_cmd_opts, '--password', $password);
- }
-}
-
-sub get_tag_dir
-{
- unless (@_ == 1)
- {
- confess "$0: get_tag_dir $INCORRECT_NUMBER_OF_ARGS";
- }
-
- my $load_dir = shift;
-
- # Take the tag relative directory, search for pairs of
- # REGEX_SEP_CHAR's and use the regular expression inside the pair to
- # put in the tag directory name.
- my $tag_location = $opt_import_tag_location;
- my $load_tag = '';
- while ((my $i = index($tag_location, $REGEX_SEP_CHAR)) >= 0)
- {
- $load_tag .= substr($tag_location, 0, $i, '');
- substr($tag_location, 0, 1, '');
- my $j = index($tag_location, $REGEX_SEP_CHAR);
- if ($j < 0)
- {
- die "$0: -t value '$opt_import_tag_location' does not have ",
- "matching $REGEX_SEP_CHAR.\n";
- }
- my $regex = substr($tag_location, 0, $j, '');
- $regex = "($regex)" unless ($regex =~ /\(.+\)/);
- substr($tag_location, 0, 1, '');
- my @results = $load_dir =~ m/$regex/;
- $load_tag .= join('', @results);
- }
- $load_tag .= $tag_location;
-
- $load_tag;
-}
-
-# Return a two element array. The first element is a single character
-# that represents the type of object the path points to. The second
-# is a boolean (1 for true, '' for false) if the path points to a file
-# and if the file is executable.
-sub file_info
-{
- lstat(shift) or return ('0', '');
- -b _ and return ('b', '');
- -c _ and return ('c', '');
- -d _ and return ('d', '');
- -f _ and return ('f', -x _);
- -l _ and return ('l', '');
- -p _ and return ('p', '');
- -S _ and return ('S', '');
- return '?';
-}
-
-# Start a child process safely without using /bin/sh.
-sub safe_read_from_pipe
-{
- unless (@_)
- {
- croak "$0: safe_read_from_pipe $INCORRECT_NUMBER_OF_ARGS";
- }
-
- my $openfork_available = "MSWin32" ne $OSNAME;
- if ($openfork_available)
- {
- print "Running @_\n";
- my $pid = open(SAFE_READ, "-|");
- unless (defined $pid)
- {
- die "$0: cannot fork: $!\n";
- }
- unless ($pid)
- {
- # child
- open(STDERR, ">&STDOUT")
- or die "$0: cannot dup STDOUT: $!\n";
- exec(@_)
- or die "$0: cannot exec '@_': $!\n";
- }
- }
- else
- {
- # Redirect the comment into a temp file and use that to work around
- # Windoze's (non-)handling of multi-line commands.
- my @commandline = ();
- my $command;
- my $comment;
-
- while ($command = shift)
- {
- if ("-m" eq $command)
- {
- my $comment = shift;
- my ($handle, $tmpfile) = tempfile(DIR => $temp_dir);
- print $handle $comment;
- close($handle);
-
- push(@commandline, "--file");
- push(@commandline, $tmpfile);
- }
- else
- {
- # Munge the command to protect it from the command line
- $command =~ s/\"/\\\"/g;
- if ($command =~ m"\s") { $command = "\"$command\""; }
- if ($command eq "") { $command = "\"\""; }
- if ($command =~ m"\n")
- {
- warn "$0: carriage return detected in command - may not work\n";
- }
- push(@commandline, $command);
- }
- }
-
- print "Running @commandline\n";
- if ( $comment ) { print $comment; }
-
- # Now do the pipe.
- open(SAFE_READ, "@commandline |")
- or die "$0: cannot pipe to command: $!\n";
- }
-
- # parent
- my @output;
- while (<SAFE_READ>)
- {
- chomp;
- push(@output, $_);
- }
- close(SAFE_READ);
- my $result = $?;
- my $exit = $result >> 8;
- my $signal = $result & 127;
- my $cd = $result & 128 ? "with core dump" : "";
- if ($signal or $cd)
- {
- warn "$0: pipe from '@_' failed $cd: exit=$exit signal=$signal\n";
- }
- if (wantarray)
- {
- return ($result, @output);
- }
- else
- {
- return $result;
- }
-}
-
-# Use safe_read_from_pipe to start a child process safely and exit the
-# script if the child failed for whatever reason.
-sub read_from_process
-{
- unless (@_)
- {
- croak "$0: read_from_process $INCORRECT_NUMBER_OF_ARGS";
- }
- my ($status, @output) = &safe_read_from_pipe(@_);
- if ($status)
- {
- print STDERR "$0: @_ failed with this output:\n", join("\n", @output),
- "\n";
- unless ($opt_no_user_input)
- {
- print STDERR
- "Press return to quit and clean up svn working directory: ";
- <STDIN>;
- }
- exit 1;
- }
- else
- {
- return @output;
- }
-}
-
-# Get a list of all the files and directories in the specified
-# directory, the type of file and a digest hash of file types.
-sub recursive_ls_and_hash
-{
- unless (@_ == 1)
- {
- croak "$0: recursive_ls_and_hash $INCORRECT_NUMBER_OF_ARGS";
- }
-
- # This is the directory to change into.
- my $dir = shift;
-
- # Get the current directory so that the script can change into the
- # current working directory after changing into the specified
- # directory.
- my $return_cwd = cwd;
-
- chdir($dir)
- or die "$0: cannot chdir '$dir': $!\n";
-
- my %files;
-
- my $wanted = sub
- {
- s#^\./##;
- return if $_ eq '.';
- my ($file_type) = &file_info($_);
- my $file_digest;
- if ($file_type eq 'f' or ($file_type eq 'l' and stat($_) and -f _))
- {
- $file_digest = &digest_hash_file($_);
- }
- $files{$_} = {type => $file_type,
- digest => $file_digest};
- };
- find({no_chdir => 1,
- preprocess => sub
- {
- grep
- {
- my $ok=1;
- foreach my $x (@glob_ignores)
- {
- if ( $_ =~ /$x/ ) {$ok=0;last;}
- }
- $ok
- } @_
- },
- wanted => $wanted
- }, '.');
-
- chdir($return_cwd)
- or die "$0: cannot chdir '$return_cwd': $!\n";
-
- %files;
-}
-
-# Given a list of files and directories which have been renamed but
-# not commtited, commit them with a proper log message.
-sub commit_renames
-{
- unless (@_ == 4)
- {
- croak "$0: commit_renames $INCORRECT_NUMBER_OF_ARGS";
- }
-
- my $load_dir = shift;
- my $renamed_filenames = shift;
- my $rename_from_files = shift;
- my $rename_to_files = shift;
-
- my $number_renames = @$renamed_filenames/2;
-
- my $message = "To prepare to load $load_dir into $repos_load_abs_path, " .
- "perform $number_renames rename" .
- ($number_renames > 1 ? "s" : "") . ".\n";
-
- # Text::Wrap::wrap appears to replace multiple consecutive \n's with
- # one \n, so wrap the text and then append the second \n.
- $message = wrap("", "", $message) . "\n";
- while (@$renamed_filenames)
- {
- my $from = "$repos_load_abs_path/" . shift @$renamed_filenames;
- my $to = "$repos_load_abs_path/" . shift @$renamed_filenames;
- $message .= wrap("", " ", "* $to: Renamed from $from.\n");
- }
-
- # Change to the top of the working copy so that any
- # directories will also be updated.
- my $cwd = cwd;
- chdir($wc_import_dir_cwd)
- or die "$0: cannot chdir '$wc_import_dir_cwd': $!\n";
- read_from_process($svn, 'commit', @svn_use_repos_cmd_opts, '-m', $message);
- read_from_process($svn, 'update', @svn_use_repos_cmd_opts);
- chdir($cwd)
- or die "$0: cannot chdir '$cwd': $!\n";
-
- # Some versions of subversion have a bug where renamed files
- # or directories are not deleted after a commit, so do that
- # here.
- my @del_files = sort {length($b) <=> length($a) || $a cmp $b }
- keys %$rename_from_files;
- rmtree(\@del_files, 1, 0);
-
- # Empty the list of old and new renamed names.
- undef %$rename_from_files;
- undef %$rename_to_files;
-}
-
-# Take a one file or directory and see if its name is equal to a
-# second or is contained in the second if the second file's file type
-# is a directory.
-sub contained_in
-{
- unless (@_ == 3)
- {
- croak "$0: contain_in $INCORRECT_NUMBER_OF_ARGS";
- }
-
- my $contained = shift;
- my $container = shift;
- my $container_type = shift;
-
- if ($container eq $contained)
- {
- return 1;
- }
-
- if ($container_type eq 'd')
- {
- my $dirname = "$container/";
- my $dirname_length = length($dirname);
-
- if ($dirname_length <= length($contained) and
- $dirname eq substr($contained, 0, $dirname_length))
- {
- return 1;
- }
- }
-
- return 0;
-}
-
-# Take an array reference containing a list of files and directories
-# and take a hash reference and remove from the array reference any
-# files and directories and the files the directory contains listed in
-# the hash.
-sub filter_renamed_files
-{
- unless (@_ == 2)
- {
- croak "$0: filter_renamed_files $INCORRECT_NUMBER_OF_ARGS";
- }
-
- my $array_ref = shift;
- my $hash_ref = shift;
-
- foreach my $remove_filename (keys %$hash_ref)
- {
- my $remove_file_type = $hash_ref->{$remove_filename}{type};
- for (my $i=0; $i<@$array_ref;)
- {
- if (contained_in($array_ref->[$i],
- $remove_filename,
- $remove_file_type))
- {
- splice(@$array_ref, $i, 1);
- next;
- }
- ++$i;
- }
- }
-}
-
-# Get a digest hash of the specified filename.
-sub digest_hash_file
-{
- unless (@_ == 1)
- {
- croak "$0: digest_hash_file $INCORRECT_NUMBER_OF_ARGS";
- }
-
- my $filename = shift;
-
- my $ctx = Digest::MD5->new;
- if (open(READ, $filename))
- {
- binmode READ;
- $ctx->addfile(*READ);
- close(READ);
- }
- else
- {
- die "$0: cannot open '$filename' for reading: $!\n";
- }
- $ctx->digest;
-}
-
-# Read standard input until a line contains the required input or an
-# empty line to signify the default answer.
-sub get_answer
-{
- unless (@_ == 3)
- {
- croak "$0: get_answer $INCORRECT_NUMBER_OF_ARGS";
- }
-
- my $message = shift;
- my $answers = shift;
- my $def_ans = shift;
-
- return $def_ans if $opt_no_user_input;
-
- my $char;
- do
- {
- print $message;
- $char = '';
- my $line = <STDIN>;
- if (defined $line and length $line)
- {
- $char = substr($line, 0, 1);
- $char = '' if $char eq "\n";
- }
- } until $char eq '' or $answers =~ /$char/ig;
-
- return $def_ans if $char eq '';
- return pos($answers) - 1;
-}
-
-# Determine the native end of line on this system by writing a \n in
-# non-binary mode to an empty file and reading the same file back in
-# binary mode.
-sub determine_native_eol
-{
- my $filename = "$temp_dir/svn_load_dirs_eol_test.$$";
- if (-e $filename)
- {
- unlink($filename)
- or die "$0: cannot unlink '$filename': $!\n";
- }
-
- # Write the \n in non-binary mode.
- open(NL_TEST, ">$filename")
- or die "$0: cannot open '$filename' for writing: $!\n";
- print NL_TEST "\n";
- close(NL_TEST)
- or die "$0: error in closing '$filename' for writing: $!\n";
-
- # Read the \n in binary mode.
- open(NL_TEST, $filename)
- or die "$0: cannot open '$filename' for reading: $!\n";
- binmode NL_TEST;
- local $/;
- undef $/;
- my $eol = <NL_TEST>;
- close(NL_TEST)
- or die "$0: cannot close '$filename' for reading: $!\n";
- unlink($filename)
- or die "$0: cannot unlink '$filename': $!\n";
-
- my $eol_length = length($eol);
- unless ($eol_length)
- {
- die "$0: native eol length on this system is 0.\n";
- }
-
- print "Native EOL on this system is ";
- for (my $i=0; $i<$eol_length; ++$i)
- {
- printf "\\%03o", ord(substr($eol, $i, 1));
- }
- print ".\n\n";
-
- $eol;
-}
-
-# Take a filename, open the file and replace all CR, CRLF and LF's
-# with the native end of line style for this system.
-sub convert_file_to_native_eol
-{
- unless (@_ == 1)
- {
- croak "$0: convert_file_to_native_eol $INCORRECT_NUMBER_OF_ARGS";
- }
-
- my $filename = shift;
- open(FILE, $filename)
- or die "$0: cannot open '$filename' for reading: $!\n";
- binmode FILE;
- local $/;
- undef $/;
- my $in = <FILE>;
- close(FILE)
- or die "$0: error in closing '$filename' for reading: $!\n";
- my $out = '';
-
- # Go through the file and transform it byte by byte.
- my $i = 0;
- while ($i < length($in))
- {
- my $cc = substr($in, $i, 2);
- if ($cc eq "\015\012")
- {
- $out .= $native_eol;
- $i += 2;
- next;
- }
-
- my $c = substr($cc, 0, 1);
- if ($c eq "\012" or $c eq "\015")
- {
- $out .= $native_eol;
- }
- else
- {
- $out .= $c;
- }
- ++$i;
- }
-
- return 0 if $in eq $out;
-
- my $tmp_filename = ".svn/tmp/svn_load_dirs.$$";
- open(FILE, ">$tmp_filename")
- or die "$0: cannot open '$tmp_filename' for writing: $!\n";
- binmode FILE;
- print FILE $out;
- close(FILE)
- or die "$0: cannot close '$tmp_filename' for writing: $!\n";
- rename($tmp_filename, $filename)
- or die "$0: cannot rename '$tmp_filename' to '$filename': $!\n";
-
- return 1;
-}
-
-# Split the input line into words taking into account that single or
-# double quotes may define a single word with whitespace in it.
-sub split_line
-{
- unless (@_ == 1)
- {
- croak "$0: split_line $INCORRECT_NUMBER_OF_ARGS";
- }
-
- my $line = shift;
-
- # Strip leading whitespace. Do not strip trailing whitespace which
- # may be part of quoted text that was never closed.
- $line =~ s/^\s+//;
-
- my $line_length = length $line;
- my @words = ();
- my $current_word = '';
- my $in_quote = '';
- my $in_protect = '';
- my $in_space = '';
- my $i = 0;
-
- while ($i < $line_length)
- {
- my $c = substr($line, $i, 1);
- ++$i;
-
- if ($in_protect)
- {
- if ($c eq $in_quote)
- {
- $current_word .= $c;
- }
- elsif ($c eq '"' or $c eq "'")
- {
- $current_word .= $c;
- }
- else
- {
- $current_word .= "$in_protect$c";
- }
- $in_protect = '';
- }
- elsif ($c eq '\\')
- {
- $in_protect = $c;
- }
- elsif ($in_quote)
- {
- if ($c eq $in_quote)
- {
- $in_quote = '';
- }
- else
- {
- $current_word .= $c;
- }
- }
- elsif ($c eq '"' or $c eq "'")
- {
- $in_quote = $c;
- }
- elsif ($c =~ m/^\s$/)
- {
- unless ($in_space)
- {
- push(@words, $current_word);
- $current_word = '';
- }
- }
- else
- {
- $current_word .= $c;
- }
-
- $in_space = $c =~ m/^\s$/;
- }
-
- # Handle any leftovers.
- $current_word .= $in_protect if $in_protect;
- push(@words, $current_word) if length $current_word;
-
- @words;
-}
-
-# This package exists just to delete the temporary directory.
-package Temp::Delete;
-
-sub new
-{
- bless {}, shift;
-}
-
-sub DESTROY
-{
- print "Cleaning up $temp_dir\n";
- File::Path::rmtree([$temp_dir], 0, 0);
-}
--- /dev/null Thu Jan 01 00:00:00 1970 +0000
+++ b/thirdparty/svn/svn_load_dirs.pl Tue Aug 26 21:26:38 2008 +0000
@@ -0,0 +1,2043 @@
+#!/usr/bin/perl -w
+
+# $HeadURL$
+# $LastChangedDate$
+# $LastChangedBy$
+# $LastChangedRevision$
+
+$| = 1;
+
+use strict;
+use Carp;
+use Cwd;
+use Digest::MD5 2.20;
+use File::Copy 2.03;
+use File::Find;
+use File::Path 1.0404;
+use File::Temp 0.12 qw(tempdir tempfile);
+use Getopt::Long 2.25;
+use Text::Wrap;
+use URI 1.17;
+use English;
+
+$Text::Wrap::columns = 72;
+
+# Specify the location of the svn command.
+my $svn = '/usr/bin/svn';
+
+# Process the command line options.
+
+# The base URL for the portion of the repository to work in. Note
+# that this does not have to be the root of the subversion repository,
+# it can point to a subdirectory in the repository.
+my $repos_base_url;
+
+# The relative path from the repository base URL to work in to the
+# directory to load the input directories into.
+my $repos_load_rel_path;
+
+# To specify where tags, which are simply copies of the imported
+# directory, should be placed relative to the repository base URL, use
+# the -t command line option. This value must contain regular
+# expressions that match portions of the input directory names to
+# create an unique tag for each input directory. The regular
+# expressions are surrounded by a specified character to distinguish
+# the regular expression from the normal directory path.
+my $opt_import_tag_location;
+
+# Do not ask for any user input. Just go ahead and do everything.
+my $opt_no_user_input;
+
+# Do not automatically set the svn:executable property based on the
+# file's exe bit.
+my $opt_no_auto_exe;
+
+# Username to use for commits.
+my $opt_svn_username;
+
+# Password to use for commits.
+my $opt_svn_password;
+
+# Verbosity level.
+my $opt_verbose;
+
+# Path to already checked-out working copy.
+my $opt_existing_wc_dir;
+
+# List of filename patterns to ignore (as in .subversion/config's
+# "global-ignores" option).
+my $opt_glob_ignores;
+
+# This is the character used to separate regular expressions occuring
+# in the tag directory path from the path itself.
+my $REGEX_SEP_CHAR = '@';
+
+# This specifies a configuration file that contains a list of regular
+# expressions to check against a file and the properties to set on
+# matching files.
+my $property_config_filename;
+
+GetOptions('no_user_input' => \$opt_no_user_input,
+ 'no_auto_exe' => \$opt_no_auto_exe,
+ 'property_cfg_filename=s' => \$property_config_filename,
+ 'svn_password=s' => \$opt_svn_password,
+ 'svn_username=s' => \$opt_svn_username,
+ 'tag_location=s' => \$opt_import_tag_location,
+ 'verbose+' => \$opt_verbose,
+ 'wc=s' => \$opt_existing_wc_dir,
+ 'glob_ignores=s' => \$opt_glob_ignores)
+ or &usage;
+&usage("$0: too few arguments") if @ARGV < 2;
+
+$repos_base_url = shift;
+$repos_load_rel_path = shift;
+
+# Check that the repository base URL and the import directories do not
+# contain any ..'s.
+if ($repos_base_url =~ /\.{2}/)
+ {
+ die "$0: repos base URL $repos_base_url cannot contain ..'s.\n";
+ }
+if ($repos_load_rel_path =~ /\.{2}/)
+ {
+ die "$0: repos import relative directory path $repos_load_rel_path ",
+ "cannot contain ..'s.\n";
+ }
+
+# If there are no directories listed on the command line, then the
+# directories are read from standard input. In this case, the
+# -no_user_input command line option must be specified.
+if (!@ARGV and !$opt_no_user_input)
+ {
+ &usage("$0: must use -no_user_input if no dirs listed on command line.");
+ }
+
+# The tag option cannot be used when directories are read from
+# standard input because tags may collide and no user input can be
+# taken to verify that the input is ok.
+if (!@ARGV and $opt_import_tag_location)
+ {
+ &usage("$0: cannot use -tag_location when dirs are read from stdin.");
+ }
+
+# If the tag directory is set, then the import directory cannot be '.'.
+if (defined $opt_import_tag_location and $repos_load_rel_path eq '.')
+ {
+ &usage("$0: cannot set import_dir to '.' and use -t command line option.");
+ }
+
+# Set the svn command line options that are used anytime svn connects
+# to the repository.
+my @svn_use_repos_cmd_opts;
+&set_svn_use_repos_cmd_opts($opt_svn_username, $opt_svn_password);
+
+# Check that the tag directories do not contain any ..'s. Also, the
+# import and tag directories cannot be absolute.
+if (defined $opt_import_tag_location and $opt_import_tag_location =~ /\.{2}/)
+ {
+ die "$0: repos tag relative directory path $opt_import_tag_location ",
+ "cannot contain ..'s.\n";
+ }
+if ($repos_load_rel_path =~ m|^/|)
+ {
+ die "$0: repos import relative directory path $repos_load_rel_path ",
+ "cannot start with /.\n";
+ }
+if (defined $opt_import_tag_location and $opt_import_tag_location =~ m|^/|)
+ {
+ die "$0: repos tagrelative directory path $opt_import_tag_location ",
+ "cannot start with /.\n";
+ }
+
+if (defined $opt_existing_wc_dir)
+ {
+ unless (-e $opt_existing_wc_dir)
+ {
+ die "$0: working copy '$opt_existing_wc_dir' does not exist.\n";
+ }
+
+ unless (-d _)
+ {
+ die "$0: working copy '$opt_existing_wc_dir' is not a directory.\n";
+ }
+
+ unless (-d "$opt_existing_wc_dir/.svn")
+ {
+ die "$0: working copy '$opt_existing_wc_dir' does not have .svn ",
+ "directory.\n";
+ }
+
+ $opt_existing_wc_dir = Cwd::abs_path($opt_existing_wc_dir)
+ }
+
+# If no glob_ignores specified, try to deduce from config file,
+# or use the default below.
+my $ignores_str =
+ '*.o *.lo *.la #*# .*.rej *.rej .*~ *~ .#* .DS_Store';
+
+if ( defined $opt_glob_ignores)
+ {
+ $ignores_str = $opt_glob_ignores;
+ }
+elsif ( -f "$ENV{HOME}/.subversion/config" )
+ {
+ open my $conf, "$ENV{HOME}/.subversion/config";
+ while (<$conf>)
+ {
+ if ( /^global-ignores\s*=\s*(.*?)\s*$/ )
+ {
+ $ignores_str = $1;
+ last;
+ }
+ }
+ }
+
+my @glob_ignores = map
+ {
+ s/\./\\\./g; s/\*/\.\*/g; "^$_\$";
+ } split(/\s+/, $ignores_str);
+unshift @glob_ignores, '\.svn$';
+
+# Convert the string URL into a URI object.
+$repos_base_url =~ s|/*$||;
+my $repos_base_uri = URI->new($repos_base_url);
+
+# Check that $repos_load_rel_path is not a directory here implying
+# that a command line option was forgotten.
+if ($repos_load_rel_path ne '.' and -d $repos_load_rel_path)
+ {
+ die "$0: import_dir '$repos_load_rel_path' is a directory.\n";
+ }
+
+# The remaining command line arguments should be directories. Check
+# that they all exist and that there are no duplicates.
+if (@ARGV)
+ {
+ my %dirs;
+ foreach my $dir (@ARGV)
+ {
+ unless (-e $dir)
+ {
+ die "$0: directory '$dir' does not exist.\n";
+ }
+
+ unless (-d _)
+ {
+ die "$0: directory '$dir' is not a directory.\n";
+ }
+
+ if ($dirs{$dir})
+ {
+ die "$0: directory '$dir' is listed more than once on command ",
+ "line.\n";
+ }
+ $dirs{$dir} = 1;
+ }
+ }
+
+# Create the tag locations and print them for the user to review.
+# Check that there are no duplicate tags.
+my %load_tags;
+if (@ARGV and defined $opt_import_tag_location)
+ {
+ my %seen_tags;
+
+ foreach my $load_dir (@ARGV)
+ {
+ my $load_tag = &get_tag_dir($load_dir);
+
+ print "Directory $load_dir will be tagged as $load_tag\n";
+
+ if ($seen_tags{$load_tag})
+ {
+ die "$0: duplicate tag generated.\n";
+ }
+ $seen_tags{$load_tag} = 1;
+
+ $load_tags{$load_dir} = $load_tag;
+ }
+
+ exit 0 unless &get_answer("Please examine identified tags. Are they " .
+ "acceptable? (Y/n) ", 'ny', 1);
+ print "\n";
+ }
+
+# Load the property configuration filename, if one was specified, into
+# an array of hashes, where each hash contains a regular expression
+# and a property to apply to the file if the regular expression
+# matches.
+my @property_settings;
+if (defined $property_config_filename and length $property_config_filename)
+ {
+ open(CFG, $property_config_filename)
+ or die "$0: cannot open '$property_config_filename' for reading: $!\n";
+
+ my $ok = 1;
+
+ while (my $line = <CFG>)
+ {
+ next if $line =~ /^\s*$/;
+ next if $line =~ /^\s*#/;
+
+ # Split the input line into words taking into account that
+ # single or double quotes may define a single word with
+ # whitespace in it. The format for the file is
+ # regex control property_name property_value
+ my @line = &split_line($line);
+ next if @line == 0;
+
+ unless (@line == 2 or @line == 4)
+ {
+ warn "$0: line $. of '$property_config_filename' has to have 2 ",
+ "or 4 columns.\n";
+ $ok = 0;
+ next;
+ }
+ my ($regex, $control, $property_name, $property_value) = @line;
+
+ unless ($control eq 'break' or $control eq 'cont')
+ {
+ warn "$0: line $. of '$property_config_filename' has illegal ",
+ "value for column 3 '$control', must be 'break' or 'cont'.\n";
+ $ok = 0;
+ next;
+ }
+
+ # Compile the regular expression.
+ my $re;
+ eval { $re = qr/$regex/i };
+ if ($@)
+ {
+ warn "$0: line $. of '$property_config_filename' regex '$regex' ",
+ "does not compile:\n$@\n";
+ $ok = 0;
+ next;
+ }
+
+ push(@property_settings, {name => $property_name,
+ value => $property_value,
+ control => $control,
+ re => $re});
+ }
+ close(CFG)
+ or warn "$0: error in closing '$property_config_filename' for ",
+ "reading: $!\n";
+
+ exit 1 unless $ok;
+ }
+
+# Check that the svn base URL works by running svn log on it. Only
+# get the HEAD revision log message; there's no need to waste
+# bandwidth seeing all of the log messages.
+print "Checking that the base URL is a Subversion repository.\n";
+read_from_process($svn, 'log', '-r', 'HEAD',
+ @svn_use_repos_cmd_opts, $repos_base_uri);
+print "\n";
+
+my $orig_cwd = cwd;
+
+# The first step is to determine the root of the svn repository. Do
+# this with the svn log command. Take the svn_url hostname and port
+# as the initial url and append to it successive portions of the final
+# path until svn log succeeds.
+print "Finding the root URL of the Subversion repository.\n";
+my $repos_root_uri;
+my $repos_root_uri_path;
+my $repos_base_path_segment;
+{
+ my $r = $repos_base_uri->clone;
+ my @path_segments = grep { length($_) } $r->path_segments;
+ my @repos_base_path_segments = @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 (safe_read_from_pipe($svn, 'log', '-r', 'HEAD',
+ @svn_use_repos_cmd_opts, $r) == 0)
+ {
+ $repos_root_uri = $r;
+ last;
+ }
+ shift @repos_base_path_segments;
+ }
+ $repos_base_path_segment = join('/', @repos_base_path_segments);
+}
+
+if ($repos_root_uri)
+ {
+ print "Determined that the svn root URL is $repos_root_uri.\n\n";
+ }
+else
+ {
+ die "$0: cannot determine root svn URL.\n";
+ }
+
+# Create a temporary directory for svn to work in.
+my $temp_dir = tempdir( "svn_load_dirs_XXXXXXXXXX", TMPDIR => 1 );
+
+# 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;
+
+# Create an object that when DESTROY'ed will delete the temporary
+# directory. The CLEANUP flag to tempdir should do this, but they
+# call rmtree with 1 as the last argument which takes extra security
+# measures that do not clean up the .svn directories.
+my $temp_dir_cleanup = Temp::Delete->new;
+
+# Determine the native end of line style for this system. Do this the
+# most portable way, by writing a file with a single \n in non-binary
+# mode and then reading the file in binary mode.
+my $native_eol = &determine_native_eol;
+
+# Check if all the directories exist to load the directories into the
+# repository. If not, ask if they should be created. For tags, do
+# not create the tag directory itself, that is done on the svn cp.
+{
+ print "Finding if any directories need to be created in repository.\n";
+
+ my @dirs_to_create;
+ my @urls_to_create;
+ my %seen_dir;
+ my @load_tags_without_last_segment;
+
+ # Assume that the last portion of the tag directory contains the
+ # version number and remove it from the directories to create,
+ # because the tag directory will be created by svn cp.
+ foreach my $load_tag (sort values %load_tags)
+ {
+ # Skip this tag if there is only one segment in its name.
+ my $index = rindex($load_tag, '/');
+ next if $index == -1;
+
+ # Trim off the last segment and record the result.
+ push(@load_tags_without_last_segment, substr($load_tag, 0, $index));
+ }
+
+ foreach my $dir ($repos_load_rel_path, @load_tags_without_last_segment)
+ {
+ next unless length $dir;
+ my $d = '';
+ foreach my $segment (split('/', $dir))
+ {
+ $d = length $d ? "$d/$segment" : $segment;
+ my $url = "$repos_base_url/$d";
+ unless ($seen_dir{$d})
+ {
+ $seen_dir{$d} = 1;
+ if (safe_read_from_pipe($svn, 'log', '-r', 'HEAD',
+ @svn_use_repos_cmd_opts, $url) != 0)
+ {
+ push(@dirs_to_create, $d);
+ push(@urls_to_create, $url);
+ }
+ }
+ }
+ }
+
+ if (@dirs_to_create)
+ {
+ print "The following directories do not exist and need to exist:\n";
+ foreach my $dir (@dirs_to_create)
+ {
+ print " $dir\n";
+ }
+ exit 0 unless &get_answer("You must add them now to load the " .
+ "directories. Continue (Y/n)? ", 'ny', 1);
+
+ my $message = "Create directories to load project into.\n\n";
+
+ foreach my $dir (@dirs_to_create)
+ {
+ if (length $repos_base_path_segment)
+ {
+ $message .= "* $repos_base_path_segment/$dir: New directory.\n";
+ }
+ else
+ {
+ $message .= "* $dir: New directory.\n";
+ }
+ }
+ $message = wrap('', ' ', $message);
+
+ read_from_process($svn, 'mkdir', @svn_use_repos_cmd_opts,
+ '-m', $message, @urls_to_create);
+ }
+ else
+ {
+ print "No directories need to be created to prepare repository.\n";
+ }
+}
+
+# Either checkout a new working copy from the repository or use an
+# existing working copy.
+if (defined $opt_existing_wc_dir)
+ {
+ # Update an already existing working copy.
+ print "Not checking out anything; using existing working directory at\n";
+ print "$opt_existing_wc_dir\n";
+
+ chdir($opt_existing_wc_dir)
+ or die "$0: cannot chdir '$opt_existing_wc_dir': $!\n";
+
+ read_from_process($svn, 'update', @svn_use_repos_cmd_opts);
+ }
+else
+ {
+ # Check out the svn repository starting at the svn URL into a
+ # fixed directory name.
+ my $checkout_dir_name = 'my_import_wc';
+
+ # Check out only the directory being imported to, otherwise the
+ # checkout of the entire base URL can be very huge, if it contains
+ # a large number of tags.
+ my $checkout_url;
+ if ($repos_load_rel_path eq '.')
+ {
+ $checkout_url = $repos_base_url;
+ }
+ else
+ {
+ $checkout_url = "$repos_base_url/$repos_load_rel_path";
+ }
+
+ print "Checking out $checkout_url into $temp_dir/$checkout_dir_name\n";
+
+ chdir($temp_dir)
+ or die "$0: cannot chdir '$temp_dir': $!\n";
+
+ read_from_process($svn, 'checkout',
+ @svn_use_repos_cmd_opts,
+ $checkout_url, $checkout_dir_name);
+
+ chdir($checkout_dir_name)
+ or die "$0: cannot chdir '$checkout_dir_name': $!\n";
+ }
+
+# At this point, the current working directory is the top level
+# directory of the working copy. Record the absolute path to this
+# location because the script will chdir back here later on.
+my $wc_import_dir_cwd = cwd;
+
+# Set up the names for the path to the import and tag directories.
+my $repos_load_abs_path;
+if ($repos_load_rel_path eq '.')
+ {
+ $repos_load_abs_path = length($repos_base_path_segment) ?
+ $repos_base_path_segment : "/";
+ }
+else
+ {
+ $repos_load_abs_path = length($repos_base_path_segment) ?
+ "$repos_base_path_segment/$repos_load_rel_path" :
+ $repos_load_rel_path;
+ }
+
+# Now go through each source directory and copy each file from the
+# source directory to the target directory. For new target files, add
+# them to svn. For files that no longer exist, delete them.
+my $print_rename_message = 1;
+my @load_dirs = @ARGV;
+while (defined (my $load_dir = &get_next_load_dir))
+ {
+ my $load_tag = $load_tags{$load_dir};
+
+ if (defined $load_tag)
+ {
+ print "\nLoading $load_dir and will save in tag $load_tag.\n";
+ }
+ else
+ {
+ print "\nLoading $load_dir.\n";
+ }
+
+ # The first hash is keyed by the old name in a rename and the
+ # second by the new name. The last variable contains a list of
+ # old and new filenames in a rename.
+ my %rename_from_files;
+ my %rename_to_files;
+ my @renamed_filenames;
+
+ unless ($opt_no_user_input)
+ {
+ my $repeat_loop;
+ do
+ {
+ $repeat_loop = 0;
+
+ my %add_files;
+ my %del_files;
+
+ # Get the list of files and directories in the repository
+ # working copy. This hash is called %del_files because
+ # each file or directory will be deleted from the hash
+ # using the list of files and directories in the source
+ # directory, leaving the files and directories that need
+ # to be deleted.
+ %del_files = &recursive_ls_and_hash($wc_import_dir_cwd);
+
+ # This anonymous subroutine finds all the files and
+ # directories in the directory to load. It notes the file
+ # type and for each file found, it deletes it from
+ # %del_files.
+ my $wanted = sub
+ {
+ s#^\./##;
+ return if $_ eq '.';
+
+ my $source_path = $_;
+ my $dest_path = "$wc_import_dir_cwd/$_";
+
+ my ($source_type) = &file_info($source_path);
+ my ($dest_type) = &file_info($dest_path);
+
+ # Fail if the destination type exists but is of a
+ # different type of file than the source type.
+ if ($dest_type ne '0' and $source_type ne $dest_type)
+ {
+ die "$0: does not handle changing source and destination ",
+ "type for '$source_path'.\n";
+ }
+
+ if ($source_type ne 'd' and
+ $source_type ne 'f' and
+ $source_type ne 'l')
+ {
+ warn "$0: skipping loading file '$source_path' of type ",
+ "'$source_type'.\n";
+ unless ($opt_no_user_input)
+ {
+ print STDERR "Press return to continue: ";
+ <STDIN>;
+ }
+ return;
+ }
+
+ unless (defined delete $del_files{$source_path})
+ {
+ $add_files{$source_path}{type} = $source_type;
+ }
+ };
+
+ # Now change into the directory containing the files to
+ # load. First change to the original directory where this
+ # script was run so that if the specified directory is a
+ # relative directory path, then the script can change into
+ # it.
+ chdir($orig_cwd)
+ or die "$0: cannot chdir '$orig_cwd': $!\n";
+ chdir($load_dir)
+ or die "$0: cannot chdir '$load_dir': $!\n";
+
+ find({no_chdir => 1,
+ preprocess => sub { sort { $b cmp $a }
+ grep { $_ !~ /^[._]svn$/ } @_ },
+ wanted => $wanted
+ }, '.');
+
+ # At this point %add_files contains the list of new files
+ # and directories to be created in the working copy tree
+ # and %del_files contains the files and directories that
+ # need to be deleted. Because there may be renames that
+ # have taken place, give the user the opportunity to
+ # rename any deleted files and directories to ones being
+ # added.
+ my @add_files = sort keys %add_files;
+ my @del_files = sort keys %del_files;
+
+ # Because the source code management system may keep the
+ # original renamed file or directory in the working copy
+ # until a commit, remove them from the list of deleted
+ # files or directories.
+ &filter_renamed_files(\@del_files, \%rename_from_files);
+
+ # Now change into the working copy directory in case any
+ # renames need to be performed.
+ chdir($wc_import_dir_cwd)
+ or die "$0: cannot chdir '$wc_import_dir_cwd': $!\n";
+
+ # Only do renames if there are both added and deleted
+ # files and directories.
+ if (@add_files and @del_files)
+ {
+ my $max = @add_files > @del_files ? @add_files : @del_files;
+
+ # Print the files that have been added and deleted.
+ # Find the deleted file with the longest name and use
+ # that for the width of the filename column. Add one
+ # to the filename width to let the directory /
+ # character be appended to a directory name.
+ my $line_number_width = 4;
+ my $filename_width = 0;
+ foreach my $f (@del_files)
+ {
+ my $l = length($f);
+ $filename_width = $l if $l > $filename_width;
+ }
+ ++$filename_width;
+ my $printf_format = "%${line_number_width}d";
+
+ if ($print_rename_message)
+ {
+ $print_rename_message = 0;
+ print "\n",
+ "The following table lists files and directories that\n",
+ "exist in either the Subversion repository or the\n",
+ "directory to be imported but not both. You now have\n",
+ "the opportunity to match them up as renames instead\n",
+ "of deletes and adds. This is a Good Thing as it'll\n",
+ "make the repository take less space.\n\n",
+ "The left column lists files and directories that\n",
+ "exist in the Subversion repository and do not exist\n",
+ "in the directory being imported. The right column\n",
+ "lists files and directories that exist in the\n",
+ "directory being imported. Match up a deleted item\n",
+ "from the left column with an added item from the\n",
+ "right column. Note the line numbers on the left\n",
+ "which you type into this script to have a rename\n",
+ "performed.\n";
+ }
+
+ # Sort the added and deleted files and directories by
+ # the lowercase versions of their basenames instead of
+ # their complete path, which makes finding files that
+ # were moved into different directories easier to
+ # match up.
+ @add_files = map { $_->[0] }
+ sort { $a->[1] cmp $b->[1] }
+ map { [$_->[0], lc($_->[1])] }
+ map { [$_, m#([^/]+)$#] }
+ @add_files;
+ @del_files = map { $_->[0] }
+ sort { $a->[1] cmp $b->[1] }
+ map { [$_->[0], lc($_->[1])] }
+ map { [$_, m#([^/]+)$#] }
+ @del_files;
+
+ RELIST:
+
+ for (my $i=0; $i<$max; ++$i)
+ {
+ my $add_filename = '';
+ my $del_filename = '';
+ if ($i < @add_files)
+ {
+ $add_filename = $add_files[$i];
+ if ($add_files{$add_filename}{type} eq 'd')
+ {
+ $add_filename .= '/';
+ }
+ }
+ if ($i < @del_files)
+ {
+ $del_filename = $del_files[$i];
+ if ($del_files{$del_filename}{type} eq 'd')
+ {
+ $del_filename .= '/';
+ }
+ }
+
+ if ($i % 22 == 0)
+ {
+ print
+ "\n",
+ " " x $line_number_width,
+ " ",
+ "Deleted", " " x ($filename_width-length("Deleted")),
+ " ",
+ "Added\n";
+ }
+
+ printf $printf_format, $i;
+ print " ", $del_filename,
+ "_" x ($filename_width - length($del_filename)),
+ " ", $add_filename, "\n";
+
+ if (($i+1) % 22 == 0)
+ {
+ unless (&get_answer("Continue printing (Y/n)? ",
+ 'ny', 1))
+ {
+ last;
+ }
+ }
+ }
+
+ # Get the feedback from the user.
+ my $line;
+ my $add_filename;
+ my $add_index;
+ my $del_filename;
+ my $del_index;
+ my $got_line = 0;
+ do {
+ print "Enter two indexes for each column to rename, ",
+ "(R)elist, or (F)inish: ";
+ $line = <STDIN>;
+ $line = '' unless defined $line;
+ if ($line =~ /^R$/i )
+ {
+ goto RELIST;
+ }
+
+ if ($line =~ /^F$/i)
+ {
+ $got_line = 1;
+ }
+ elsif ($line =~ /^(\d+)\s+(\d+)$/)
+ {
+ print "\n";
+
+ $del_index = $1;
+ $add_index = $2;
+ if ($del_index >= @del_files)
+ {
+ print "Delete index $del_index is larger than ",
+ "maximum index of ", scalar @del_files - 1,
+ ".\n";
+ $del_index = undef;
+ }
+ if ($add_index > @add_files)
+ {
+ print "Add index $add_index is larger than maximum ",
+ "index of ", scalar @add_files - 1, ".\n";
+ $add_index = undef;
+ }
+ $got_line = defined $del_index && defined $add_index;
+
+ # Check that the file or directory to be renamed
+ # has the same file type.
+ if ($got_line)
+ {
+ $add_filename = $add_files[$add_index];
+ $del_filename = $del_files[$del_index];
+ if ($add_files{$add_filename}{type} ne
+ $del_files{$del_filename}{type})
+ {
+ print "File types for $del_filename and ",
+ "$add_filename differ.\n";
+ $got_line = undef;
+ }
+ }
+ }
+ } until ($got_line);
+
+ if ($line !~ /^F$/i)
+ {
+ print "Renaming $del_filename to $add_filename.\n";
+
+ $repeat_loop = 1;
+
+ # Because subversion cannot rename the same file
+ # or directory twice, which includes doing a
+ # rename of a file in a directory that was
+ # previously renamed, a commit has to be
+ # performed. Check if the file or directory being
+ # renamed now would cause such a problem and
+ # commit if so.
+ my $do_commit_now = 0;
+ foreach my $rename_to_filename (keys %rename_to_files)
+ {
+ if (contained_in($del_filename,
+ $rename_to_filename,
+ $rename_to_files{$rename_to_filename}{type}))
+ {
+ $do_commit_now = 1;
+ last;
+ }
+ }
+
+ if ($do_commit_now)
+ {
+ print "Now committing previously run renames.\n";
+ &commit_renames($load_dir,
+ \@renamed_filenames,
+ \%rename_from_files,
+ \%rename_to_files);
+ }
+
+ push(@renamed_filenames, $del_filename, $add_filename);
+ {
+ my $d = $del_files{$del_filename};
+ $rename_from_files{$del_filename} = $d;
+ $rename_to_files{$add_filename} = $d;
+ }
+
+ # Check that any required directories to do the
+ # rename exist.
+ my @add_segments = split('/', $add_filename);
+ pop(@add_segments);
+ my $add_dir = '';
+ my @add_dirs;
+ foreach my $segment (@add_segments)
+ {
+ $add_dir = length($add_dir) ? "$add_dir/$segment" :
+ $segment;
+ unless (-d $add_dir)
+ {
+ push(@add_dirs, $add_dir);
+ }
+ }
+
+ if (@add_dirs)
+ {
+ read_from_process($svn, 'mkdir', @add_dirs);
+ }
+
+ read_from_process($svn, 'mv',
+ $del_filename, $add_filename);
+ }
+ }
+ } while ($repeat_loop);
+ }
+
+ # If there are any renames that have not been committed, then do
+ # that now.
+ if (@renamed_filenames)
+ {
+ &commit_renames($load_dir,
+ \@renamed_filenames,
+ \%rename_from_files,
+ \%rename_to_files);
+ }
+
+ # At this point all renames have been performed. Now get the
+ # final list of files and directories in the working copy
+ # directory. The %add_files hash will contain the list of files
+ # and directories to add to the working copy and %del_files starts
+ # with all the files already in the working copy and gets files
+ # removed that are in the imported directory, which results in a
+ # list of files that should be deleted. %upd_files holds the list
+ # of files that have been updated.
+ my %add_files;
+ my %del_files = &recursive_ls_and_hash($wc_import_dir_cwd);
+ my %upd_files;
+
+ # This anonymous subroutine copies files from the source directory
+ # to the working copy directory.
+ my $wanted = sub
+ {
+ s#^\./##;
+ return if $_ eq '.';
+
+ my $source_path = $_;
+ my $dest_path = "$wc_import_dir_cwd/$_";
+
+ my ($source_type, $source_is_exe) = &file_info($source_path);
+ my ($dest_type) = &file_info($dest_path);
+
+ return if ($source_type ne 'd' and
+ $source_type ne 'f' and
+ $source_type ne 'l');
+
+ # Fail if the destination type exists but is of a different
+ # type of file than the source type.
+ if ($dest_type ne '0' and $source_type ne $dest_type)
+ {
+ die "$0: does not handle changing source and destination type ",
+ "for '$source_path'.\n";
+ }
+
+ # Determine if the file is being added or is an update to an
+ # already existing file using the file's digest.
+ my $del_info = delete $del_files{$source_path};
+ if (defined $del_info)
+ {
+ if (defined (my $del_digest = $del_info->{digest}))
+ {
+ my $new_digest = &digest_hash_file($source_path);
+ if ($new_digest ne $del_digest)
+ {
+ print "U $source_path\n";
+ $upd_files{$source_path} = $del_info;
+ }
+ }
+ }
+ else
+ {
+ print "A $source_path\n";
+ $add_files{$source_path}{type} = $source_type;
+
+ # Create an array reference to hold the list of properties
+ # to apply to this object.
+ unless (defined $add_files{$source_path}{properties})
+ {
+ $add_files{$source_path}{properties} = [];
+ }
+
+ # Go through the list of properties for a match on this
+ # file or directory and if there is a match, then apply
+ # the property to it.
+ foreach my $property (@property_settings)
+ {
+ my $re = $property->{re};
+ if ($source_path =~ $re)
+ {
+ my $property_name = $property->{name};
+ my $property_value = $property->{value};
+
+ # The property value may not be set in the
+ # configuration file, since the user may just want
+ # to set the control flag.
+ if (defined $property_name and defined $property_value)
+ {
+ # Ignore properties that do not apply to
+ # directories.
+ if ($source_type eq 'd')
+ {
+ if ($property_name eq 'svn:eol-style' or
+ $property_name eq 'svn:executable' or
+ $property_name eq 'svn:keywords' or
+ $property_name eq 'svn:mime-type')
+ {
+ next;
+ }
+ }
+
+ # Ignore properties that do not apply to
+ # files.
+ if ($source_type eq 'f')
+ {
+ if ($property_name eq 'svn:externals' or
+ $property_name eq 'svn:ignore')
+ {
+ next;
+ }
+ }
+
+ print "Adding to '$source_path' property ",
+ "'$property_name' with value ",
+ "'$property_value'.\n";
+
+ push(@{$add_files{$source_path}{properties}},
+ $property);
+ }
+
+ last if $property->{control} eq 'break';
+ }
+ }
+ }
+
+ # Add svn:executable to files that have their executable bit
+ # set.
+ if ($source_is_exe and !$opt_no_auto_exe)
+ {
+ print "Adding to '$source_path' property 'svn:executable' with ",
+ "value '*'.\n";
+ my $property = {name => 'svn:executable', value => '*'};
+ push (@{$add_files{$source_path}{properties}},
+ $property);
+ }
+
+ # Now make sure the file or directory in the source directory
+ # exists in the repository.
+ if ($source_type eq 'd')
+ {
+ if ($dest_type eq '0')
+ {
+ mkdir($dest_path)
+ or die "$0: cannot mkdir '$dest_path': $!\n";
+ }
+ }
+ elsif
+ ($source_type eq 'l') {
+ my $link_target = readlink($source_path)
+ or die "$0: cannot readlink '$source_path': $!\n";
+ if ($dest_type eq 'l')
+ {
+ my $old_target = readlink($dest_path)
+ or die "$0: cannot readlink '$dest_path': $!\n";
+ return if ($old_target eq $link_target);
+ unlink($dest_path)
+ or die "$0: unlink '$dest_path' failed: $!\n";
+ }
+ symlink($link_target, $dest_path)
+ or die "$0: cannot symlink '$dest_path' to '$link_target': $!\n";
+ }
+ elsif
+ ($source_type eq 'f') {
+ # Only copy the file if the digests do not match.
+ if ($add_files{$source_path} or $upd_files{$source_path})
+ {
+ copy($source_path, $dest_path)
+ or die "$0: copy '$source_path' to '$dest_path': $!\n";
+ }
+ }
+ else
+ {
+ die "$0: does not handle copying files of type '$source_type'.\n";
+ }
+ };
+
+ # Now change into the directory containing the files to load.
+ # First change to the original directory where this script was run
+ # so that if the specified directory is a relative directory path,
+ # then the script can change into it.
+ chdir($orig_cwd)
+ or die "$0: cannot chdir '$orig_cwd': $!\n";
+ chdir($load_dir)
+ or die "$0: cannot chdir '$load_dir': $!\n";
+
+ find({no_chdir => 1,
+ preprocess => sub { sort { $b cmp $a }
+ grep { $_ !~ /^[._]svn$/ } @_ },
+ wanted => $wanted
+ }, '.');
+
+ # The files and directories that are in %del_files are the files
+ # and directories that need to be deleted. Because svn will
+ # return an error if a file or directory is deleted in a directory
+ # that subsequently is deleted, first find all directories and
+ # remove from the list any files and directories inside those
+ # directories from this list. Work through the list repeatedly
+ # working from short to long names so that directories containing
+ # other files and directories will be deleted first.
+ my $repeat_loop;
+ do
+ {
+ $repeat_loop = 0;
+ my @del_files = sort {length($a) <=> length($b) || $a cmp $b}
+ keys %del_files;
+ &filter_renamed_files(\@del_files, \%rename_from_files);
+ foreach my $file (@del_files)
+ {
+ if ($del_files{$file}{type} eq 'd')
+ {
+ my $dir = "$file/";
+ my $dir_length = length($dir);
+ foreach my $f (@del_files)
+ {
+ next if $file eq $f;
+ if (length($f) >= $dir_length and
+ substr($f, 0, $dir_length) eq $dir)
+ {
+ print "d $f\n";
+ delete $del_files{$f};
+ $repeat_loop = 1;
+ }
+ }
+
+ # If there were any deletions of files and/or
+ # directories inside a directory that will be deleted,
+ # then restart the entire loop again, because one or
+ # more keys have been deleted from %del_files.
+ # Equally important is not to stop this loop if no
+ # deletions have been done, otherwise later
+ # directories that may contain files and directories
+ # to be deleted will not be deleted.
+ last if $repeat_loop;
+ }
+ }
+ } while ($repeat_loop);
+
+ # What is left are files that are not in any directories to be
+ # deleted and directories to be deleted. To delete the files,
+ # deeper files and directories must be deleted first. Because we
+ # have a hash keyed by remaining files and directories to be
+ # deleted, instead of trying to figure out which directories and
+ # files are contained in other directories, just reverse sort by
+ # the path length and then alphabetically.
+ my @del_files = sort {length($b) <=> length($a) || $a cmp $b }
+ keys %del_files;
+ &filter_renamed_files(\@del_files, \%rename_from_files);
+ foreach my $file (@del_files)
+ {
+ print "D $file\n";
+ }
+
+ # Now change back to the trunk directory and run the svn commands.
+ chdir($wc_import_dir_cwd)
+ or die "$0: cannot chdir '$wc_import_dir_cwd': $!\n";
+
+ # If any of the added files have the svn:eol-style property set,
+ # then pass -b to diff, otherwise diff may fail because the end of
+ # lines have changed and the source file and file in the
+ # repository will not be identical.
+ my @diff_ignore_space_changes;
+
+ if (keys %add_files)
+ {
+ my @add_files = sort {length($a) <=> length($b) || $a cmp $b}
+ keys %add_files;
+ my $target_filename = &make_targets_file(@add_files);
+ read_from_process($svn, 'add', '-N', '--targets', $target_filename);
+ unlink($target_filename);
+
+ # Add properties on the added files.
+ foreach my $add_file (@add_files)
+ {
+ foreach my $property (@{$add_files{$add_file}{properties}})
+ {
+ my $property_name = $property->{name};
+ my $property_value = $property->{value};
+
+ if ($property_name eq 'svn:eol-style')
+ {
+ @diff_ignore_space_changes = ('-b');
+ }
+
+ # Write the value to a temporary file in case it's multi-line
+ my ($handle, $tmpfile) = tempfile(DIR => $temp_dir);
+ print $handle $property_value;
+ close($handle);
+
+ read_from_process($svn,
+ 'propset',
+ $property_name,
+ '--file',
+ $tmpfile,
+ $add_file);
+ }
+ }
+ }
+ if (@del_files)
+ {
+ my $target_filename = &make_targets_file(@del_files);
+ read_from_process($svn, 'rm', '--targets', $target_filename);
+ unlink($target_filename);
+ }
+
+ # Go through the list of updated files and check the svn:eol-style
+ # property. If it is set to native, then convert all CR, CRLF and
+ # LF's in the file to the native end of line characters. Also,
+ # modify diff's command line so that it will ignore the change in
+ # end of line style.
+ if (keys %upd_files)
+ {
+ my @upd_files = sort {length($a) <=> length($b) || $a cmp $b}
+ keys %upd_files;
+ foreach my $upd_file (@upd_files)
+ {
+ # Always append @BASE to a filename in case they contain a
+ # @ character, in which case the Subversion command line
+ # client will attempt to parse the characters after the @
+ # as a revision and most likely fail, or if the characters
+ # after the @ are a valid revision, then it'll possibly
+ # get the incorrect information. So always append @BASE
+ # and any preceding @'s will be treated normally and the
+ # correct information will be retrieved.
+ my @command = ($svn,
+ 'propget',
+ 'svn:eol-style',
+ "$upd_file\@BASE");
+ my @lines = read_from_process(@command);
+ next unless @lines;
+ if (@lines > 1)
+ {
+ warn "$0: '@command' returned more than one line of output: ",
+ "'@lines'.\n";
+ next;
+ }
+
+ my $eol_style = $lines[0];
+ if ($eol_style eq 'native')
+ {
+ @diff_ignore_space_changes = ('-b');
+ if (&convert_file_to_native_eol($upd_file))
+ {
+ print "Native eol-style conversion modified $upd_file.\n";
+ }
+ }
+ }
+ }
+
+ my $message = wrap('', '', "Load $load_dir into $repos_load_abs_path.\n");
+ read_from_process($svn, 'commit',
+ @svn_use_repos_cmd_opts,
+ '-m', $message);
+
+ # If an update is not run now after a commit, then some file and
+ # directory paths will have an older revisions associated with
+ # them and any future commits will fail because they are out of
+ # date.
+ read_from_process($svn, 'update', @svn_use_repos_cmd_opts);
+
+ # Now remove any files and directories to be deleted in the
+ # repository.
+ if (@del_files)
+ {
+ rmtree(\@del_files, 1, 0);
+ }
+
+ # Now make the tag by doing a copy in the svn repository itself.
+ if (defined $load_tag)
+ {
+ my $repos_tag_abs_path = length($repos_base_path_segment) ?
+ "$repos_base_path_segment/$load_tag" :
+ $load_tag;
+
+ my $from_url = $repos_load_rel_path eq '.' ?
+ $repos_load_rel_path :
+ "$repos_base_url/$repos_load_rel_path";
+ my $to_url = "$repos_base_url/$load_tag";
+
+ $message = wrap("",
+ "",
+ "Tag $repos_load_abs_path as " .
+ "$repos_tag_abs_path.\n");
+ read_from_process($svn, 'cp', @svn_use_repos_cmd_opts,
+ '-m', $message, $from_url, $to_url);
+
+ # Now check out the tag and run a recursive diff between the
+ # original source directory and the tag for a consistency
+ # check.
+ my $checkout_dir_name = "my_tag_wc_named_$load_tag";
+ print "Checking out $to_url into $temp_dir/$checkout_dir_name\n";
+
+ chdir($temp_dir)
+ or die "$0: cannot chdir '$temp_dir': $!\n";
+
+ read_from_process($svn, 'checkout',
+ @svn_use_repos_cmd_opts,
+ $to_url, $checkout_dir_name);
+
+ chdir($checkout_dir_name)
+ or die "$0: cannot chdir '$checkout_dir_name': $!\n";
+
+ chdir($orig_cwd)
+ or die "$0: cannot chdir '$orig_cwd': $!\n";
+ read_from_process('diff', '-u', @diff_ignore_space_changes,
+ '-x', '.svn',
+ '-r', $load_dir, "$temp_dir/$checkout_dir_name");
+ }
+ }
+
+exit 0;
+
+sub usage
+{
+ warn "@_\n" if @_;
+ die "usage: $0 [options] svn_url svn_import_dir [dir_v1 [dir_v2 [..]]]\n",
+ " svn_url is the file:// or http:// URL of the svn repository\n",
+ " svn_import_dir is the path relative to svn_url where to load dirs\n",
+ " dir_v1 .. list dirs to import otherwise read from stdin\n",
+ "options are\n",
+ " -no_user_input don't ask yes/no questions and assume yes answer\n",
+ " -no_auto_exe don't set svn:executable for executable files\n",
+ " -p filename table listing properties to apply to matching files\n",
+ " -svn_username username to perform commits as\n",
+ " -svn_password password to supply to svn commit\n",
+ " -t tag_dir create a tag copy in tag_dir, relative to svn_url\n",
+ " -v increase program verbosity, multiple -v's allowed\n",
+ " -wc path use the already checked-out working copy at path\n",
+ " instead of checkout out a fresh working copy\n",
+ " -glob_ignores List of filename patterns to ignore (as in svn's\n",
+ " global-ignores config option)\n";
+}
+
+# Get the next directory to load, either from the command line or from
+# standard input.
+my $get_next_load_dir_init = 0;
+my @get_next_load_dirs;
+sub get_next_load_dir
+{
+ if (@ARGV)
+ {
+ unless ($get_next_load_dir_init)
+ {
+ $get_next_load_dir_init = 1;
+ @get_next_load_dirs = @ARGV;
+ }
+ return shift @get_next_load_dirs;
+ }
+
+ if ($opt_verbose)
+ {
+ print "Waiting for next directory to import on standard input:\n";
+ }
+ my $line = <STDIN>;
+
+ print "\n" if $opt_verbose;
+
+ chomp $line;
+ if ($line =~ m|(\S+)\s+(\S+)|)
+ {
+ $line = $1;
+ set_svn_use_repos_cmd_opts($2, $opt_svn_password);
+ }
+ $line;
+}
+
+# This constant stores the commonly used string to indicate that a
+# subroutine has been passed an incorrect number of arguments.
+use vars qw($INCORRECT_NUMBER_OF_ARGS);
+$INCORRECT_NUMBER_OF_ARGS = "passed incorrect number of arguments.\n";
+
+# Creates a temporary file in the temporary directory and stores the
+# arguments in it for use by the svn --targets command line option.
+# If any part of the file creation failed, exit the program, as
+# there's no workaround. Use a unique number as a counter to the
+# files.
+my $make_targets_file_counter;
+sub make_targets_file
+{
+ unless (@_)
+ {
+ confess "$0: make_targets_file $INCORRECT_NUMBER_OF_ARGS";
+ }
+
+ $make_targets_file_counter = 1 unless defined $make_targets_file_counter;
+
+ my $filename = sprintf "%s/targets.%05d",
+ $temp_dir,
+ $make_targets_file_counter;
+ ++$make_targets_file_counter;
+
+ open(TARGETS, ">$filename")
+ or die "$0: cannot open '$filename' for writing: $!\n";
+
+ foreach my $file (@_)
+ {
+ print TARGETS "$file\n";
+ }
+
+ close(TARGETS)
+ or die "$0: error in closing '$filename' for writing: $!\n";
+
+ $filename;
+}
+
+# Set the svn command line options that are used anytime svn connects
+# to the repository.
+sub set_svn_use_repos_cmd_opts
+{
+ unless (@_ == 2)
+ {
+ confess "$0: set_svn_use_repos_cmd_opts $INCORRECT_NUMBER_OF_ARGS";
+ }
+
+ my $username = shift;
+ my $password = shift;
+
+ @svn_use_repos_cmd_opts = ('--non-interactive');
+ if (defined $username and length $username)
+ {
+ push(@svn_use_repos_cmd_opts, '--username', $username);
+ }
+ if (defined $password)
+ {
+ push(@svn_use_repos_cmd_opts, '--password', $password);
+ }
+}
+
+sub get_tag_dir
+{
+ unless (@_ == 1)
+ {
+ confess "$0: get_tag_dir $INCORRECT_NUMBER_OF_ARGS";
+ }
+
+ my $load_dir = shift;
+
+ # Take the tag relative directory, search for pairs of
+ # REGEX_SEP_CHAR's and use the regular expression inside the pair to
+ # put in the tag directory name.
+ my $tag_location = $opt_import_tag_location;
+ my $load_tag = '';
+ while ((my $i = index($tag_location, $REGEX_SEP_CHAR)) >= 0)
+ {
+ $load_tag .= substr($tag_location, 0, $i, '');
+ substr($tag_location, 0, 1, '');
+ my $j = index($tag_location, $REGEX_SEP_CHAR);
+ if ($j < 0)
+ {
+ die "$0: -t value '$opt_import_tag_location' does not have ",
+ "matching $REGEX_SEP_CHAR.\n";
+ }
+ my $regex = substr($tag_location, 0, $j, '');
+ $regex = "($regex)" unless ($regex =~ /\(.+\)/);
+ substr($tag_location, 0, 1, '');
+ my @results = $load_dir =~ m/$regex/;
+ $load_tag .= join('', @results);
+ }
+ $load_tag .= $tag_location;
+
+ $load_tag;
+}
+
+# Return a two element array. The first element is a single character
+# that represents the type of object the path points to. The second
+# is a boolean (1 for true, '' for false) if the path points to a file
+# and if the file is executable.
+sub file_info
+{
+ lstat(shift) or return ('0', '');
+ -b _ and return ('b', '');
+ -c _ and return ('c', '');
+ -d _ and return ('d', '');
+ -f _ and return ('f', -x _);
+ -l _ and return ('l', '');
+ -p _ and return ('p', '');
+ -S _ and return ('S', '');
+ return '?';
+}
+
+# Start a child process safely without using /bin/sh.
+sub safe_read_from_pipe
+{
+ unless (@_)
+ {
+ croak "$0: safe_read_from_pipe $INCORRECT_NUMBER_OF_ARGS";
+ }
+
+ my $openfork_available = "MSWin32" ne $OSNAME;
+ if ($openfork_available)
+ {
+ print "Running @_\n";
+ my $pid = open(SAFE_READ, "-|");
+ unless (defined $pid)
+ {
+ die "$0: cannot fork: $!\n";
+ }
+ unless ($pid)
+ {
+ # child
+ open(STDERR, ">&STDOUT")
+ or die "$0: cannot dup STDOUT: $!\n";
+ exec(@_)
+ or die "$0: cannot exec '@_': $!\n";
+ }
+ }
+ else
+ {
+ # Redirect the comment into a temp file and use that to work around
+ # Windoze's (non-)handling of multi-line commands.
+ my @commandline = ();
+ my $command;
+ my $comment;
+
+ while ($command = shift)
+ {
+ if ("-m" eq $command)
+ {
+ my $comment = shift;
+ my ($handle, $tmpfile) = tempfile(DIR => $temp_dir);
+ print $handle $comment;
+ close($handle);
+
+ push(@commandline, "--file");
+ push(@commandline, $tmpfile);
+ }
+ else
+ {
+ # Munge the command to protect it from the command line
+ $command =~ s/\"/\\\"/g;
+ if ($command =~ m"\s") { $command = "\"$command\""; }
+ if ($command eq "") { $command = "\"\""; }
+ if ($command =~ m"\n")
+ {
+ warn "$0: carriage return detected in command - may not work\n";
+ }
+ push(@commandline, $command);
+ }
+ }
+
+ print "Running @commandline\n";
+ if ( $comment ) { print $comment; }
+
+ # Now do the pipe.
+ open(SAFE_READ, "@commandline |")
+ or die "$0: cannot pipe to command: $!\n";
+ }
+
+ # parent
+ my @output;
+ while (<SAFE_READ>)
+ {
+ chomp;
+ push(@output, $_);
+ }
+ close(SAFE_READ);
+ my $result = $?;
+ my $exit = $result >> 8;
+ my $signal = $result & 127;
+ my $cd = $result & 128 ? "with core dump" : "";
+ if ($signal or $cd)
+ {
+ warn "$0: pipe from '@_' failed $cd: exit=$exit signal=$signal\n";
+ }
+ if (wantarray)
+ {
+ return ($result, @output);
+ }
+ else
+ {
+ return $result;
+ }
+}
+
+# Use safe_read_from_pipe to start a child process safely and exit the
+# script if the child failed for whatever reason.
+sub read_from_process
+{
+ unless (@_)
+ {
+ croak "$0: read_from_process $INCORRECT_NUMBER_OF_ARGS";
+ }
+ my ($status, @output) = &safe_read_from_pipe(@_);
+ if ($status)
+ {
+ print STDERR "$0: @_ failed with this output:\n", join("\n", @output),
+ "\n";
+ unless ($opt_no_user_input)
+ {
+ print STDERR
+ "Press return to quit and clean up svn working directory: ";
+ <STDIN>;
+ }
+ exit 1;
+ }
+ else
+ {
+ return @output;
+ }
+}
+
+# Get a list of all the files and directories in the specified
+# directory, the type of file and a digest hash of file types.
+sub recursive_ls_and_hash
+{
+ unless (@_ == 1)
+ {
+ croak "$0: recursive_ls_and_hash $INCORRECT_NUMBER_OF_ARGS";
+ }
+
+ # This is the directory to change into.
+ my $dir = shift;
+
+ # Get the current directory so that the script can change into the
+ # current working directory after changing into the specified
+ # directory.
+ my $return_cwd = cwd;
+
+ chdir($dir)
+ or die "$0: cannot chdir '$dir': $!\n";
+
+ my %files;
+
+ my $wanted = sub
+ {
+ s#^\./##;
+ return if $_ eq '.';
+ my ($file_type) = &file_info($_);
+ my $file_digest;
+ if ($file_type eq 'f' or ($file_type eq 'l' and stat($_) and -f _))
+ {
+ $file_digest = &digest_hash_file($_);
+ }
+ $files{$_} = {type => $file_type,
+ digest => $file_digest};
+ };
+ find({no_chdir => 1,
+ preprocess => sub
+ {
+ grep
+ {
+ my $ok=1;
+ foreach my $x (@glob_ignores)
+ {
+ if ( $_ =~ /$x/ ) {$ok=0;last;}
+ }
+ $ok
+ } @_
+ },
+ wanted => $wanted
+ }, '.');
+
+ chdir($return_cwd)
+ or die "$0: cannot chdir '$return_cwd': $!\n";
+
+ %files;
+}
+
+# Given a list of files and directories which have been renamed but
+# not commtited, commit them with a proper log message.
+sub commit_renames
+{
+ unless (@_ == 4)
+ {
+ croak "$0: commit_renames $INCORRECT_NUMBER_OF_ARGS";
+ }
+
+ my $load_dir = shift;
+ my $renamed_filenames = shift;
+ my $rename_from_files = shift;
+ my $rename_to_files = shift;
+
+ my $number_renames = @$renamed_filenames/2;
+
+ my $message = "To prepare to load $load_dir into $repos_load_abs_path, " .
+ "perform $number_renames rename" .
+ ($number_renames > 1 ? "s" : "") . ".\n";
+
+ # Text::Wrap::wrap appears to replace multiple consecutive \n's with
+ # one \n, so wrap the text and then append the second \n.
+ $message = wrap("", "", $message) . "\n";
+ while (@$renamed_filenames)
+ {
+ my $from = "$repos_load_abs_path/" . shift @$renamed_filenames;
+ my $to = "$repos_load_abs_path/" . shift @$renamed_filenames;
+ $message .= wrap("", " ", "* $to: Renamed from $from.\n");
+ }
+
+ # Change to the top of the working copy so that any
+ # directories will also be updated.
+ my $cwd = cwd;
+ chdir($wc_import_dir_cwd)
+ or die "$0: cannot chdir '$wc_import_dir_cwd': $!\n";
+ read_from_process($svn, 'commit', @svn_use_repos_cmd_opts, '-m', $message);
+ read_from_process($svn, 'update', @svn_use_repos_cmd_opts);
+ chdir($cwd)
+ or die "$0: cannot chdir '$cwd': $!\n";
+
+ # Some versions of subversion have a bug where renamed files
+ # or directories are not deleted after a commit, so do that
+ # here.
+ my @del_files = sort {length($b) <=> length($a) || $a cmp $b }
+ keys %$rename_from_files;
+ rmtree(\@del_files, 1, 0);
+
+ # Empty the list of old and new renamed names.
+ undef %$rename_from_files;
+ undef %$rename_to_files;
+}
+
+# Take a one file or directory and see if its name is equal to a
+# second or is contained in the second if the second file's file type
+# is a directory.
+sub contained_in
+{
+ unless (@_ == 3)
+ {
+ croak "$0: contain_in $INCORRECT_NUMBER_OF_ARGS";
+ }
+
+ my $contained = shift;
+ my $container = shift;
+ my $container_type = shift;
+
+ if ($container eq $contained)
+ {
+ return 1;
+ }
+
+ if ($container_type eq 'd')
+ {
+ my $dirname = "$container/";
+ my $dirname_length = length($dirname);
+
+ if ($dirname_length <= length($contained) and
+ $dirname eq substr($contained, 0, $dirname_length))
+ {
+ return 1;
+ }
+ }
+
+ return 0;
+}
+
+# Take an array reference containing a list of files and directories
+# and take a hash reference and remove from the array reference any
+# files and directories and the files the directory contains listed in
+# the hash.
+sub filter_renamed_files
+{
+ unless (@_ == 2)
+ {
+ croak "$0: filter_renamed_files $INCORRECT_NUMBER_OF_ARGS";
+ }
+
+ my $array_ref = shift;
+ my $hash_ref = shift;
+
+ foreach my $remove_filename (keys %$hash_ref)
+ {
+ my $remove_file_type = $hash_ref->{$remove_filename}{type};
+ for (my $i=0; $i<@$array_ref;)
+ {
+ if (contained_in($array_ref->[$i],
+ $remove_filename,
+ $remove_file_type))
+ {
+ splice(@$array_ref, $i, 1);
+ next;
+ }
+ ++$i;
+ }
+ }
+}
+
+# Get a digest hash of the specified filename.
+sub digest_hash_file
+{
+ unless (@_ == 1)
+ {
+ croak "$0: digest_hash_file $INCORRECT_NUMBER_OF_ARGS";
+ }
+
+ my $filename = shift;
+
+ my $ctx = Digest::MD5->new;
+ if (open(READ, $filename))
+ {
+ binmode READ;
+ $ctx->addfile(*READ);
+ close(READ);
+ }
+ else
+ {
+ die "$0: cannot open '$filename' for reading: $!\n";
+ }
+ $ctx->digest;
+}
+
+# Read standard input until a line contains the required input or an
+# empty line to signify the default answer.
+sub get_answer
+{
+ unless (@_ == 3)
+ {
+ croak "$0: get_answer $INCORRECT_NUMBER_OF_ARGS";
+ }
+
+ my $message = shift;
+ my $answers = shift;
+ my $def_ans = shift;
+
+ return $def_ans if $opt_no_user_input;
+
+ my $char;
+ do
+ {
+ print $message;
+ $char = '';
+ my $line = <STDIN>;
+ if (defined $line and length $line)
+ {
+ $char = substr($line, 0, 1);
+ $char = '' if $char eq "\n";
+ }
+ } until $char eq '' or $answers =~ /$char/ig;
+
+ return $def_ans if $char eq '';
+ return pos($answers) - 1;
+}
+
+# Determine the native end of line on this system by writing a \n in
+# non-binary mode to an empty file and reading the same file back in
+# binary mode.
+sub determine_native_eol
+{
+ my $filename = "$temp_dir/svn_load_dirs_eol_test.$$";
+ if (-e $filename)
+ {
+ unlink($filename)
+ or die "$0: cannot unlink '$filename': $!\n";
+ }
+
+ # Write the \n in non-binary mode.
+ open(NL_TEST, ">$filename")
+ or die "$0: cannot open '$filename' for writing: $!\n";
+ print NL_TEST "\n";
+ close(NL_TEST)
+ or die "$0: error in closing '$filename' for writing: $!\n";
+
+ # Read the \n in binary mode.
+ open(NL_TEST, $filename)
+ or die "$0: cannot open '$filename' for reading: $!\n";
+ binmode NL_TEST;
+ local $/;
+ undef $/;
+ my $eol = <NL_TEST>;
+ close(NL_TEST)
+ or die "$0: cannot close '$filename' for reading: $!\n";
+ unlink($filename)
+ or die "$0: cannot unlink '$filename': $!\n";
+
+ my $eol_length = length($eol);
+ unless ($eol_length)
+ {
+ die "$0: native eol length on this system is 0.\n";
+ }
+
+ print "Native EOL on this system is ";
+ for (my $i=0; $i<$eol_length; ++$i)
+ {
+ printf "\\%03o", ord(substr($eol, $i, 1));
+ }
+ print ".\n\n";
+
+ $eol;
+}
+
+# Take a filename, open the file and replace all CR, CRLF and LF's
+# with the native end of line style for this system.
+sub convert_file_to_native_eol
+{
+ unless (@_ == 1)
+ {
+ croak "$0: convert_file_to_native_eol $INCORRECT_NUMBER_OF_ARGS";
+ }
+
+ my $filename = shift;
+ open(FILE, $filename)
+ or die "$0: cannot open '$filename' for reading: $!\n";
+ binmode FILE;
+ local $/;
+ undef $/;
+ my $in = <FILE>;
+ close(FILE)
+ or die "$0: error in closing '$filename' for reading: $!\n";
+ my $out = '';
+
+ # Go through the file and transform it byte by byte.
+ my $i = 0;
+ while ($i < length($in))
+ {
+ my $cc = substr($in, $i, 2);
+ if ($cc eq "\015\012")
+ {
+ $out .= $native_eol;
+ $i += 2;
+ next;
+ }
+
+ my $c = substr($cc, 0, 1);
+ if ($c eq "\012" or $c eq "\015")
+ {
+ $out .= $native_eol;
+ }
+ else
+ {
+ $out .= $c;
+ }
+ ++$i;
+ }
+
+ return 0 if $in eq $out;
+
+ my $tmp_filename = ".svn/tmp/svn_load_dirs.$$";
+ open(FILE, ">$tmp_filename")
+ or die "$0: cannot open '$tmp_filename' for writing: $!\n";
+ binmode FILE;
+ print FILE $out;
+ close(FILE)
+ or die "$0: cannot close '$tmp_filename' for writing: $!\n";
+ rename($tmp_filename, $filename)
+ or die "$0: cannot rename '$tmp_filename' to '$filename': $!\n";
+
+ return 1;
+}
+
+# Split the input line into words taking into account that single or
+# double quotes may define a single word with whitespace in it.
+sub split_line
+{
+ unless (@_ == 1)
+ {
+ croak "$0: split_line $INCORRECT_NUMBER_OF_ARGS";
+ }
+
+ my $line = shift;
+
+ # Strip leading whitespace. Do not strip trailing whitespace which
+ # may be part of quoted text that was never closed.
+ $line =~ s/^\s+//;
+
+ my $line_length = length $line;
+ my @words = ();
+ my $current_word = '';
+ my $in_quote = '';
+ my $in_protect = '';
+ my $in_space = '';
+ my $i = 0;
+
+ while ($i < $line_length)
+ {
+ my $c = substr($line, $i, 1);
+ ++$i;
+
+ if ($in_protect)
+ {
+ if ($c eq $in_quote)
+ {
+ $current_word .= $c;
+ }
+ elsif ($c eq '"' or $c eq "'")
+ {
+ $current_word .= $c;
+ }
+ else
+ {
+ $current_word .= "$in_protect$c";
+ }
+ $in_protect = '';
+ }
+ elsif ($c eq '\\')
+ {
+ $in_protect = $c;
+ }
+ elsif ($in_quote)
+ {
+ if ($c eq $in_quote)
+ {
+ $in_quote = '';
+ }
+ else
+ {
+ $current_word .= $c;
+ }
+ }
+ elsif ($c eq '"' or $c eq "'")
+ {
+ $in_quote = $c;
+ }
+ elsif ($c =~ m/^\s$/)
+ {
+ unless ($in_space)
+ {
+ push(@words, $current_word);
+ $current_word = '';
+ }
+ }
+ else
+ {
+ $current_word .= $c;
+ }
+
+ $in_space = $c =~ m/^\s$/;
+ }
+
+ # Handle any leftovers.
+ $current_word .= $in_protect if $in_protect;
+ push(@words, $current_word) if length $current_word;
+
+ @words;
+}
+
+# This package exists just to delete the temporary directory.
+package Temp::Delete;
+
+sub new
+{
+ bless {}, shift;
+}
+
+sub DESTROY
+{
+ print "Cleaning up $temp_dir\n";
+ File::Path::rmtree([$temp_dir], 0, 0);
+}