diff -r b7a32c7e2a99 -r 667451541623 scripts/svn_load_dirs.pl --- 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 = ) - { - 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); -}