diff -r b7a32c7e2a99 -r 667451541623 thirdparty/svn/svn_load_dirs.pl --- /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 = ) + { + 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: "; + ; + } + 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 = ; + $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 = ; + + 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 () + { + 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: "; + ; + } + 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 = ; + 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 = ; + 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 = ; + 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); +}