scripts/svn_load_dirs.pl
changeset 64 b73eec62825a
equal deleted inserted replaced
63:9b1909e46633 64:b73eec62825a
       
     1 #!/usr/bin/perl -w
       
     2 
       
     3 # $HeadURL$
       
     4 # $LastChangedDate$
       
     5 # $LastChangedBy$
       
     6 # $LastChangedRevision$
       
     7 
       
     8 $| = 1;
       
     9 
       
    10 use strict;
       
    11 use Carp;
       
    12 use Cwd;
       
    13 use Digest::MD5  2.20;
       
    14 use File::Copy   2.03;
       
    15 use File::Find;
       
    16 use File::Path   1.0404;
       
    17 use File::Temp   0.12   qw(tempdir tempfile);
       
    18 use Getopt::Long 2.25;
       
    19 use Text::Wrap;
       
    20 use URI          1.17;
       
    21 use English;
       
    22 
       
    23 $Text::Wrap::columns = 72;
       
    24 
       
    25 # Specify the location of the svn command.
       
    26 my $svn = '/usr/bin/svn';
       
    27 
       
    28 # Process the command line options.
       
    29 
       
    30 # The base URL for the portion of the repository to work in.  Note
       
    31 # that this does not have to be the root of the subversion repository,
       
    32 # it can point to a subdirectory in the repository.
       
    33 my $repos_base_url;
       
    34 
       
    35 # The relative path from the repository base URL to work in to the
       
    36 # directory to load the input directories into.
       
    37 my $repos_load_rel_path;
       
    38 
       
    39 # To specify where tags, which are simply copies of the imported
       
    40 # directory, should be placed relative to the repository base URL, use
       
    41 # the -t command line option.  This value must contain regular
       
    42 # expressions that match portions of the input directory names to
       
    43 # create an unique tag for each input directory.  The regular
       
    44 # expressions are surrounded by a specified character to distinguish
       
    45 # the regular expression from the normal directory path.
       
    46 my $opt_import_tag_location;
       
    47 
       
    48 # Do not ask for any user input.  Just go ahead and do everything.
       
    49 my $opt_no_user_input;
       
    50 
       
    51 # Do not automatically set the svn:executable property based on the
       
    52 # file's exe bit.
       
    53 my $opt_no_auto_exe;
       
    54 
       
    55 # Username to use for commits.
       
    56 my $opt_svn_username;
       
    57 
       
    58 # Password to use for commits.
       
    59 my $opt_svn_password;
       
    60 
       
    61 # Verbosity level.
       
    62 my $opt_verbose;
       
    63 
       
    64 # Path to already checked-out working copy.
       
    65 my $opt_existing_wc_dir;
       
    66 
       
    67 # List of filename patterns to ignore (as in .subversion/config's
       
    68 # "global-ignores" option).
       
    69 my $opt_glob_ignores;
       
    70 
       
    71 # This is the character used to separate regular expressions occuring
       
    72 # in the tag directory path from the path itself.
       
    73 my $REGEX_SEP_CHAR = '@';
       
    74 
       
    75 # This specifies a configuration file that contains a list of regular
       
    76 # expressions to check against a file and the properties to set on
       
    77 # matching files.
       
    78 my $property_config_filename;
       
    79 
       
    80 GetOptions('no_user_input'           => \$opt_no_user_input,
       
    81            'no_auto_exe'             => \$opt_no_auto_exe,
       
    82            'property_cfg_filename=s' => \$property_config_filename,
       
    83            'svn_password=s'          => \$opt_svn_password,
       
    84            'svn_username=s'          => \$opt_svn_username,
       
    85            'tag_location=s'          => \$opt_import_tag_location,
       
    86            'verbose+'                => \$opt_verbose,
       
    87            'wc=s'                    => \$opt_existing_wc_dir,
       
    88            'glob_ignores=s'          => \$opt_glob_ignores)
       
    89   or &usage;
       
    90 &usage("$0: too few arguments") if @ARGV < 2;
       
    91 
       
    92 $repos_base_url      = shift;
       
    93 $repos_load_rel_path = shift;
       
    94 
       
    95 # Check that the repository base URL and the import directories do not
       
    96 # contain any ..'s.
       
    97 if ($repos_base_url =~ /\.{2}/)
       
    98   {
       
    99     die "$0: repos base URL $repos_base_url cannot contain ..'s.\n";
       
   100   }
       
   101 if ($repos_load_rel_path =~ /\.{2}/)
       
   102   {
       
   103     die "$0: repos import relative directory path $repos_load_rel_path ",
       
   104         "cannot contain ..'s.\n";
       
   105   }
       
   106 
       
   107 # If there are no directories listed on the command line, then the
       
   108 # directories are read from standard input.  In this case, the
       
   109 # -no_user_input command line option must be specified.
       
   110 if (!@ARGV and !$opt_no_user_input)
       
   111   {
       
   112     &usage("$0: must use -no_user_input if no dirs listed on command line.");
       
   113   }
       
   114 
       
   115 # The tag option cannot be used when directories are read from
       
   116 # standard input because tags may collide and no user input can be
       
   117 # taken to verify that the input is ok.
       
   118 if (!@ARGV and $opt_import_tag_location)
       
   119   {
       
   120     &usage("$0: cannot use -tag_location when dirs are read from stdin.");
       
   121   }
       
   122 
       
   123 # If the tag directory is set, then the import directory cannot be '.'.
       
   124 if (defined $opt_import_tag_location and $repos_load_rel_path eq '.')
       
   125   {
       
   126     &usage("$0: cannot set import_dir to '.' and use -t command line option.");
       
   127   }
       
   128 
       
   129 # Set the svn command line options that are used anytime svn connects
       
   130 # to the repository.
       
   131 my @svn_use_repos_cmd_opts;
       
   132 &set_svn_use_repos_cmd_opts($opt_svn_username, $opt_svn_password);
       
   133 
       
   134 # Check that the tag directories do not contain any ..'s.  Also, the
       
   135 # import and tag directories cannot be absolute.
       
   136 if (defined $opt_import_tag_location and $opt_import_tag_location =~ /\.{2}/)
       
   137   {
       
   138     die "$0: repos tag relative directory path $opt_import_tag_location ",
       
   139         "cannot contain ..'s.\n";
       
   140   }
       
   141 if ($repos_load_rel_path =~ m|^/|)
       
   142   {
       
   143     die "$0: repos import relative directory path $repos_load_rel_path ",
       
   144         "cannot start with /.\n";
       
   145   }
       
   146 if (defined $opt_import_tag_location and $opt_import_tag_location =~ m|^/|)
       
   147   {
       
   148     die "$0: repos tagrelative directory path $opt_import_tag_location ",
       
   149         "cannot start with /.\n";
       
   150   }
       
   151 
       
   152 if (defined $opt_existing_wc_dir)
       
   153   {
       
   154     unless (-e $opt_existing_wc_dir)
       
   155       {
       
   156         die "$0: working copy '$opt_existing_wc_dir' does not exist.\n";
       
   157       }
       
   158 
       
   159     unless (-d _)
       
   160       {
       
   161         die "$0: working copy '$opt_existing_wc_dir' is not a directory.\n";
       
   162       }
       
   163 
       
   164     unless (-d "$opt_existing_wc_dir/.svn")
       
   165       {
       
   166         die "$0: working copy '$opt_existing_wc_dir' does not have .svn ",
       
   167             "directory.\n";
       
   168       }
       
   169 
       
   170     $opt_existing_wc_dir = Cwd::abs_path($opt_existing_wc_dir)
       
   171   }
       
   172 
       
   173 # If no glob_ignores specified, try to deduce from config file,
       
   174 # or use the default below.
       
   175 my $ignores_str =
       
   176     '*.o *.lo *.la #*# .*.rej *.rej .*~ *~ .#* .DS_Store';
       
   177 
       
   178 if ( defined $opt_glob_ignores)
       
   179   {
       
   180     $ignores_str = $opt_glob_ignores;
       
   181   }
       
   182 elsif ( -f "$ENV{HOME}/.subversion/config" )
       
   183   {
       
   184     open my $conf, "$ENV{HOME}/.subversion/config";
       
   185     while (<$conf>)
       
   186       {
       
   187         if ( /^global-ignores\s*=\s*(.*?)\s*$/ )
       
   188           {
       
   189 	    $ignores_str = $1;
       
   190             last;
       
   191           }
       
   192       }
       
   193   }
       
   194 
       
   195 my @glob_ignores = map
       
   196                      {
       
   197                        s/\./\\\./g; s/\*/\.\*/g; "^$_\$";
       
   198                      } split(/\s+/, $ignores_str);
       
   199 unshift @glob_ignores, '\.svn$';
       
   200 
       
   201 # Convert the string URL into a URI object.
       
   202 $repos_base_url    =~ s|/*$||;
       
   203 my $repos_base_uri = URI->new($repos_base_url);
       
   204 
       
   205 # Check that $repos_load_rel_path is not a directory here implying
       
   206 # that a command line option was forgotten.
       
   207 if ($repos_load_rel_path ne '.' and -d $repos_load_rel_path)
       
   208   {
       
   209     die "$0: import_dir '$repos_load_rel_path' is a directory.\n";
       
   210   }
       
   211 
       
   212 # The remaining command line arguments should be directories.  Check
       
   213 # that they all exist and that there are no duplicates.
       
   214 if (@ARGV)
       
   215   {
       
   216     my %dirs;
       
   217     foreach my $dir (@ARGV)
       
   218       {
       
   219         unless (-e $dir)
       
   220           {
       
   221             die "$0: directory '$dir' does not exist.\n";
       
   222           }
       
   223 
       
   224         unless (-d _)
       
   225           {
       
   226             die "$0: directory '$dir' is not a directory.\n";
       
   227           }
       
   228 
       
   229         if ($dirs{$dir})
       
   230           {
       
   231             die "$0: directory '$dir' is listed more than once on command ",
       
   232                 "line.\n";
       
   233           }
       
   234         $dirs{$dir} = 1;
       
   235       }
       
   236   }
       
   237 
       
   238 # Create the tag locations and print them for the user to review.
       
   239 # Check that there are no duplicate tags.
       
   240 my %load_tags;
       
   241 if (@ARGV and defined $opt_import_tag_location)
       
   242   {
       
   243     my %seen_tags;
       
   244 
       
   245     foreach my $load_dir (@ARGV)
       
   246       {
       
   247         my $load_tag = &get_tag_dir($load_dir);
       
   248 
       
   249         print "Directory $load_dir will be tagged as $load_tag\n";
       
   250 
       
   251         if ($seen_tags{$load_tag})
       
   252           {
       
   253             die "$0: duplicate tag generated.\n";
       
   254           }
       
   255         $seen_tags{$load_tag} = 1;
       
   256 
       
   257         $load_tags{$load_dir} = $load_tag;
       
   258       }
       
   259 
       
   260     exit 0 unless &get_answer("Please examine identified tags.  Are they " .
       
   261                               "acceptable? (Y/n) ", 'ny', 1);
       
   262     print "\n";
       
   263   }
       
   264 
       
   265 # Load the property configuration filename, if one was specified, into
       
   266 # an array of hashes, where each hash contains a regular expression
       
   267 # and a property to apply to the file if the regular expression
       
   268 # matches.
       
   269 my @property_settings;
       
   270 if (defined $property_config_filename and length $property_config_filename)
       
   271   {
       
   272     open(CFG, $property_config_filename)
       
   273       or die "$0: cannot open '$property_config_filename' for reading: $!\n";
       
   274 
       
   275     my $ok = 1;
       
   276 
       
   277     while (my $line = <CFG>)
       
   278       {
       
   279         next if $line =~ /^\s*$/;
       
   280         next if $line =~ /^\s*#/;
       
   281 
       
   282         # Split the input line into words taking into account that
       
   283         # single or double quotes may define a single word with
       
   284         # whitespace in it.  The format for the file is
       
   285         # regex control property_name property_value
       
   286         my @line = &split_line($line);
       
   287         next if @line == 0;
       
   288 
       
   289         unless (@line == 2 or @line == 4)
       
   290           {
       
   291             warn "$0: line $. of '$property_config_filename' has to have 2 ",
       
   292                  "or 4 columns.\n";
       
   293             $ok = 0;
       
   294             next;
       
   295           }
       
   296         my ($regex, $control, $property_name, $property_value) = @line;
       
   297 
       
   298         unless ($control eq 'break' or $control eq 'cont')
       
   299           {
       
   300             warn "$0: line $. of '$property_config_filename' has illegal ",
       
   301                  "value for column 3 '$control', must be 'break' or 'cont'.\n";
       
   302             $ok = 0;
       
   303             next;
       
   304           }
       
   305 
       
   306         # Compile the regular expression.
       
   307         my $re;
       
   308         eval { $re = qr/$regex/i };
       
   309         if ($@)
       
   310           {
       
   311             warn "$0: line $. of '$property_config_filename' regex '$regex' ",
       
   312                  "does not compile:\n$@\n";
       
   313             $ok = 0;
       
   314             next;
       
   315           }
       
   316 
       
   317         push(@property_settings, {name    => $property_name,
       
   318                                   value   => $property_value,
       
   319                                   control => $control,
       
   320                                   re      => $re});
       
   321       }
       
   322     close(CFG)
       
   323       or warn "$0: error in closing '$property_config_filename' for ",
       
   324               "reading: $!\n";
       
   325 
       
   326     exit 1 unless $ok;
       
   327   }
       
   328 
       
   329 # Check that the svn base URL works by running svn log on it.  Only
       
   330 # get the HEAD revision log message; there's no need to waste
       
   331 # bandwidth seeing all of the log messages.
       
   332 print "Checking that the base URL is a Subversion repository.\n";
       
   333 read_from_process($svn, 'log', '-r', 'HEAD',
       
   334                   @svn_use_repos_cmd_opts, $repos_base_uri);
       
   335 print "\n";
       
   336 
       
   337 my $orig_cwd = cwd;
       
   338 
       
   339 # The first step is to determine the root of the svn repository.  Do
       
   340 # this with the svn log command.  Take the svn_url hostname and port
       
   341 # as the initial url and append to it successive portions of the final
       
   342 # path until svn log succeeds.
       
   343 print "Finding the root URL of the Subversion repository.\n";
       
   344 my $repos_root_uri;
       
   345 my $repos_root_uri_path;
       
   346 my $repos_base_path_segment;
       
   347 {
       
   348   my $r = $repos_base_uri->clone;
       
   349   my @path_segments            = grep { length($_) } $r->path_segments;
       
   350   my @repos_base_path_segments = @path_segments;
       
   351   unshift(@path_segments, '');
       
   352   $r->path('');
       
   353   my @r_path_segments;
       
   354 
       
   355   while (@path_segments)
       
   356     {
       
   357       $repos_root_uri_path = shift @path_segments;
       
   358       push(@r_path_segments, $repos_root_uri_path);
       
   359       $r->path_segments(@r_path_segments);
       
   360       if (safe_read_from_pipe($svn, 'log', '-r', 'HEAD',
       
   361                               @svn_use_repos_cmd_opts, $r) == 0)
       
   362         {
       
   363           $repos_root_uri = $r;
       
   364           last;
       
   365         }
       
   366       shift @repos_base_path_segments;
       
   367     }
       
   368   $repos_base_path_segment = join('/', @repos_base_path_segments);
       
   369 }
       
   370 
       
   371 if ($repos_root_uri)
       
   372   {
       
   373     print "Determined that the svn root URL is $repos_root_uri.\n\n";
       
   374   }
       
   375 else
       
   376   {
       
   377     die "$0: cannot determine root svn URL.\n";
       
   378   }
       
   379 
       
   380 # Create a temporary directory for svn to work in.
       
   381 my $temp_dir = tempdir( "svn_load_dirs_XXXXXXXXXX", TMPDIR => 1 );
       
   382 
       
   383 # Put in a signal handler to clean up any temporary directories.
       
   384 sub catch_signal {
       
   385   my $signal = shift;
       
   386   warn "$0: caught signal $signal.  Quitting now.\n";
       
   387   exit 1;
       
   388 }
       
   389 
       
   390 $SIG{HUP}  = \&catch_signal;
       
   391 $SIG{INT}  = \&catch_signal;
       
   392 $SIG{TERM} = \&catch_signal;
       
   393 $SIG{PIPE} = \&catch_signal;
       
   394 
       
   395 # Create an object that when DESTROY'ed will delete the temporary
       
   396 # directory.  The CLEANUP flag to tempdir should do this, but they
       
   397 # call rmtree with 1 as the last argument which takes extra security
       
   398 # measures that do not clean up the .svn directories.
       
   399 my $temp_dir_cleanup = Temp::Delete->new;
       
   400 
       
   401 # Determine the native end of line style for this system.  Do this the
       
   402 # most portable way, by writing a file with a single \n in non-binary
       
   403 # mode and then reading the file in binary mode.
       
   404 my $native_eol = &determine_native_eol;
       
   405 
       
   406 # Check if all the directories exist to load the directories into the
       
   407 # repository.  If not, ask if they should be created.  For tags, do
       
   408 # not create the tag directory itself, that is done on the svn cp.
       
   409 {
       
   410   print "Finding if any directories need to be created in repository.\n";
       
   411 
       
   412   my @dirs_to_create;
       
   413   my @urls_to_create;
       
   414   my %seen_dir;
       
   415   my @load_tags_without_last_segment;
       
   416 
       
   417   # Assume that the last portion of the tag directory contains the
       
   418   # version number and remove it from the directories to create,
       
   419   # because the tag directory will be created by svn cp.
       
   420   foreach my $load_tag (sort values %load_tags)
       
   421     {
       
   422       # Skip this tag if there is only one segment in its name.
       
   423       my $index = rindex($load_tag, '/');
       
   424       next if $index == -1;
       
   425 
       
   426       # Trim off the last segment and record the result.
       
   427       push(@load_tags_without_last_segment, substr($load_tag, 0, $index));
       
   428     }
       
   429   
       
   430   foreach my $dir ($repos_load_rel_path, @load_tags_without_last_segment)
       
   431     {
       
   432       next unless length $dir;
       
   433       my $d = '';
       
   434       foreach my $segment (split('/', $dir))
       
   435         {
       
   436           $d = length $d ? "$d/$segment" : $segment;
       
   437           my $url = "$repos_base_url/$d";
       
   438           unless ($seen_dir{$d})
       
   439             {
       
   440               $seen_dir{$d} = 1;
       
   441               if (safe_read_from_pipe($svn, 'log', '-r', 'HEAD',
       
   442                                       @svn_use_repos_cmd_opts, $url) != 0)
       
   443                 {
       
   444                   push(@dirs_to_create, $d);
       
   445                   push(@urls_to_create, $url);
       
   446                 }
       
   447             }
       
   448         }
       
   449     }
       
   450 
       
   451   if (@dirs_to_create)
       
   452     {
       
   453       print "The following directories do not exist and need to exist:\n";
       
   454       foreach my $dir (@dirs_to_create)
       
   455         {
       
   456           print "  $dir\n";
       
   457         }
       
   458       exit 0 unless &get_answer("You must add them now to load the " .
       
   459                                 "directories.  Continue (Y/n)? ", 'ny', 1);
       
   460 
       
   461       my $message = "Create directories to load project into.\n\n";
       
   462 
       
   463       foreach my $dir (@dirs_to_create)
       
   464         {
       
   465           if (length $repos_base_path_segment)
       
   466             {
       
   467               $message .= "* $repos_base_path_segment/$dir: New directory.\n";
       
   468             }
       
   469           else
       
   470             {
       
   471               $message .= "* $dir: New directory.\n";
       
   472             }
       
   473         }
       
   474       $message = wrap('', '  ', $message);
       
   475 
       
   476       read_from_process($svn, 'mkdir', @svn_use_repos_cmd_opts,
       
   477                         '-m', $message, @urls_to_create);
       
   478     }
       
   479   else
       
   480     {
       
   481       print "No directories need to be created to prepare repository.\n";
       
   482     }
       
   483 }
       
   484 
       
   485 # Either checkout a new working copy from the repository or use an
       
   486 # existing working copy.
       
   487 if (defined $opt_existing_wc_dir)
       
   488   {
       
   489     # Update an already existing working copy.
       
   490     print "Not checking out anything; using existing working directory at\n";
       
   491     print "$opt_existing_wc_dir\n";
       
   492 
       
   493     chdir($opt_existing_wc_dir)
       
   494       or die "$0: cannot chdir '$opt_existing_wc_dir': $!\n";
       
   495 
       
   496     read_from_process($svn, 'update', @svn_use_repos_cmd_opts);
       
   497   }
       
   498 else
       
   499   {
       
   500     # Check out the svn repository starting at the svn URL into a
       
   501     # fixed directory name.
       
   502     my $checkout_dir_name = 'my_import_wc';
       
   503 
       
   504     # Check out only the directory being imported to, otherwise the
       
   505     # checkout of the entire base URL can be very huge, if it contains
       
   506     # a large number of tags.
       
   507     my $checkout_url;
       
   508     if ($repos_load_rel_path eq '.')
       
   509       {
       
   510         $checkout_url = $repos_base_url;
       
   511       }
       
   512     else
       
   513       {
       
   514         $checkout_url = "$repos_base_url/$repos_load_rel_path";
       
   515       }
       
   516 
       
   517     print "Checking out $checkout_url into $temp_dir/$checkout_dir_name\n";
       
   518 
       
   519     chdir($temp_dir)
       
   520       or die "$0: cannot chdir '$temp_dir': $!\n";
       
   521 
       
   522     read_from_process($svn, 'checkout',
       
   523                       @svn_use_repos_cmd_opts,
       
   524                       $checkout_url, $checkout_dir_name);
       
   525 
       
   526     chdir($checkout_dir_name)
       
   527       or die "$0: cannot chdir '$checkout_dir_name': $!\n";
       
   528   }
       
   529 
       
   530 # At this point, the current working directory is the top level
       
   531 # directory of the working copy.  Record the absolute path to this
       
   532 # location because the script will chdir back here later on.
       
   533 my $wc_import_dir_cwd = cwd;
       
   534 
       
   535 # Set up the names for the path to the import and tag directories.
       
   536 my $repos_load_abs_path;
       
   537 if ($repos_load_rel_path eq '.')
       
   538   {
       
   539     $repos_load_abs_path = length($repos_base_path_segment) ?
       
   540                            $repos_base_path_segment : "/";
       
   541   }
       
   542 else
       
   543   {
       
   544     $repos_load_abs_path = length($repos_base_path_segment) ?
       
   545                            "$repos_base_path_segment/$repos_load_rel_path" :
       
   546                            $repos_load_rel_path;
       
   547   }
       
   548 
       
   549 # Now go through each source directory and copy each file from the
       
   550 # source directory to the target directory.  For new target files, add
       
   551 # them to svn.  For files that no longer exist, delete them.
       
   552 my $print_rename_message = 1;
       
   553 my @load_dirs            = @ARGV;
       
   554 while (defined (my $load_dir = &get_next_load_dir))
       
   555   {
       
   556     my $load_tag = $load_tags{$load_dir};
       
   557 
       
   558     if (defined $load_tag)
       
   559       {
       
   560         print "\nLoading $load_dir and will save in tag $load_tag.\n";
       
   561       }
       
   562     else
       
   563       {
       
   564         print "\nLoading $load_dir.\n";
       
   565       }
       
   566 
       
   567     # The first hash is keyed by the old name in a rename and the
       
   568     # second by the new name.  The last variable contains a list of
       
   569     # old and new filenames in a rename.
       
   570     my %rename_from_files;
       
   571     my %rename_to_files;
       
   572     my @renamed_filenames;
       
   573 
       
   574     unless ($opt_no_user_input)
       
   575       {
       
   576         my $repeat_loop;
       
   577         do
       
   578           {
       
   579             $repeat_loop = 0;
       
   580 
       
   581             my %add_files;
       
   582             my %del_files;
       
   583 
       
   584             # Get the list of files and directories in the repository
       
   585             # working copy.  This hash is called %del_files because
       
   586             # each file or directory will be deleted from the hash
       
   587             # using the list of files and directories in the source
       
   588             # directory, leaving the files and directories that need
       
   589             # to be deleted.
       
   590             %del_files = &recursive_ls_and_hash($wc_import_dir_cwd);
       
   591 
       
   592             # This anonymous subroutine finds all the files and
       
   593             # directories in the directory to load.  It notes the file
       
   594             # type and for each file found, it deletes it from
       
   595             # %del_files.
       
   596             my $wanted = sub
       
   597               {
       
   598                 s#^\./##;
       
   599                 return if $_ eq '.';
       
   600 
       
   601                 my $source_path = $_;
       
   602                 my $dest_path   = "$wc_import_dir_cwd/$_";
       
   603 
       
   604                 my ($source_type) = &file_info($source_path);
       
   605                 my ($dest_type)   = &file_info($dest_path);
       
   606 
       
   607                 # Fail if the destination type exists but is of a
       
   608                 # different type of file than the source type.
       
   609                 if ($dest_type ne '0' and $source_type ne $dest_type)
       
   610                   {
       
   611                     die "$0: does not handle changing source and destination ",
       
   612                         "type for '$source_path'.\n";
       
   613                   }
       
   614 
       
   615                 if ($source_type ne 'd' and
       
   616                     $source_type ne 'f' and
       
   617                     $source_type ne 'l')
       
   618                   {
       
   619                     warn "$0: skipping loading file '$source_path' of type ",
       
   620                          "'$source_type'.\n";
       
   621                     unless ($opt_no_user_input)
       
   622                       {
       
   623                         print STDERR "Press return to continue: ";
       
   624                         <STDIN>;
       
   625                       }
       
   626                     return;
       
   627                   }
       
   628 
       
   629                 unless (defined delete $del_files{$source_path})
       
   630                   {
       
   631                     $add_files{$source_path}{type} = $source_type;
       
   632                   }
       
   633               };
       
   634 
       
   635             # Now change into the directory containing the files to
       
   636             # load.  First change to the original directory where this
       
   637             # script was run so that if the specified directory is a
       
   638             # relative directory path, then the script can change into
       
   639             # it.
       
   640             chdir($orig_cwd)
       
   641               or die "$0: cannot chdir '$orig_cwd': $!\n";
       
   642             chdir($load_dir)
       
   643               or die "$0: cannot chdir '$load_dir': $!\n";
       
   644 
       
   645             find({no_chdir   => 1,
       
   646                   preprocess => sub { sort { $b cmp $a }
       
   647                                       grep { $_ !~ /^[._]svn$/ } @_ },
       
   648                   wanted     => $wanted
       
   649                  }, '.');
       
   650 
       
   651             # At this point %add_files contains the list of new files
       
   652             # and directories to be created in the working copy tree
       
   653             # and %del_files contains the files and directories that
       
   654             # need to be deleted.  Because there may be renames that
       
   655             # have taken place, give the user the opportunity to
       
   656             # rename any deleted files and directories to ones being
       
   657             # added.
       
   658             my @add_files = sort keys %add_files;
       
   659             my @del_files = sort keys %del_files;
       
   660 
       
   661             # Because the source code management system may keep the
       
   662             # original renamed file or directory in the working copy
       
   663             # until a commit, remove them from the list of deleted
       
   664             # files or directories.
       
   665             &filter_renamed_files(\@del_files, \%rename_from_files);
       
   666 
       
   667             # Now change into the working copy directory in case any
       
   668             # renames need to be performed.
       
   669             chdir($wc_import_dir_cwd)
       
   670               or die "$0: cannot chdir '$wc_import_dir_cwd': $!\n";
       
   671 
       
   672             # Only do renames if there are both added and deleted
       
   673             # files and directories.
       
   674             if (@add_files and @del_files)
       
   675               {
       
   676                 my $max = @add_files > @del_files ? @add_files : @del_files;
       
   677 
       
   678                 # Print the files that have been added and deleted.
       
   679                 # Find the deleted file with the longest name and use
       
   680                 # that for the width of the filename column.  Add one
       
   681                 # to the filename width to let the directory /
       
   682                 # character be appended to a directory name.
       
   683                 my $line_number_width = 4;
       
   684                 my $filename_width    = 0;
       
   685                 foreach my $f (@del_files)
       
   686                   {
       
   687                     my $l = length($f);
       
   688                     $filename_width = $l if $l > $filename_width;
       
   689                   }
       
   690                 ++$filename_width;
       
   691                 my $printf_format = "%${line_number_width}d";
       
   692 
       
   693                 if ($print_rename_message)
       
   694                   {
       
   695                     $print_rename_message = 0;
       
   696                     print "\n",
       
   697                       "The following table lists files and directories that\n",
       
   698                       "exist in either the Subversion repository or the\n",
       
   699                       "directory to be imported but not both.  You now have\n",
       
   700                       "the opportunity to match them up as renames instead\n",
       
   701                       "of deletes and adds.  This is a Good Thing as it'll\n",
       
   702                       "make the repository take less space.\n\n",
       
   703                       "The left column lists files and directories that\n",
       
   704                       "exist in the Subversion repository and do not exist\n",
       
   705                       "in the directory being imported.  The right column\n",
       
   706                       "lists files and directories that exist in the\n",
       
   707                       "directory being imported.  Match up a deleted item\n",
       
   708                       "from the left column with an added item from the\n",
       
   709                       "right column.  Note the line numbers on the left\n",
       
   710                       "which you type into this script to have a rename\n",
       
   711                       "performed.\n";
       
   712                   }
       
   713 
       
   714                 # Sort the added and deleted files and directories by
       
   715                 # the lowercase versions of their basenames instead of
       
   716                 # their complete path, which makes finding files that
       
   717                 # were moved into different directories easier to
       
   718                 # match up.
       
   719                 @add_files = map { $_->[0] }
       
   720                              sort { $a->[1] cmp $b->[1] }
       
   721                              map { [$_->[0], lc($_->[1])] }
       
   722                              map { [$_, m#([^/]+)$#] }
       
   723                              @add_files;
       
   724                 @del_files = map { $_->[0] }
       
   725                              sort { $a->[1] cmp $b->[1] }
       
   726                              map { [$_->[0], lc($_->[1])] }
       
   727                              map { [$_, m#([^/]+)$#] }
       
   728                              @del_files;
       
   729 
       
   730               RELIST:
       
   731 
       
   732                 for (my $i=0; $i<$max; ++$i)
       
   733                   {
       
   734                     my $add_filename = '';
       
   735                     my $del_filename = '';
       
   736                     if ($i < @add_files)
       
   737                       {
       
   738                         $add_filename = $add_files[$i];
       
   739                         if ($add_files{$add_filename}{type} eq 'd')
       
   740                           {
       
   741                             $add_filename .= '/';
       
   742                           }
       
   743                       }
       
   744                     if ($i < @del_files)
       
   745                       {
       
   746                         $del_filename = $del_files[$i];
       
   747                         if ($del_files{$del_filename}{type} eq 'd')
       
   748                           {
       
   749                             $del_filename .= '/';
       
   750                           }
       
   751                       }
       
   752 
       
   753                     if ($i % 22 == 0)
       
   754                       {
       
   755                         print
       
   756                           "\n",
       
   757                           " " x $line_number_width,
       
   758                           " ",
       
   759                           "Deleted", " " x ($filename_width-length("Deleted")),
       
   760                           " ",
       
   761                           "Added\n";
       
   762                       }
       
   763 
       
   764                     printf $printf_format, $i;
       
   765                     print  " ", $del_filename,
       
   766                            "_" x ($filename_width - length($del_filename)),
       
   767                            " ", $add_filename, "\n";
       
   768 
       
   769                     if (($i+1) % 22 == 0)
       
   770                       {
       
   771                         unless (&get_answer("Continue printing (Y/n)? ",
       
   772                                             'ny', 1))
       
   773                           {
       
   774                             last;
       
   775                           }
       
   776                       }
       
   777                   }
       
   778 
       
   779                 # Get the feedback from the user.
       
   780                 my $line;
       
   781                 my $add_filename;
       
   782                 my $add_index;
       
   783                 my $del_filename;
       
   784                 my $del_index;
       
   785                 my $got_line = 0;
       
   786                 do {
       
   787                   print "Enter two indexes for each column to rename, ",
       
   788                         "(R)elist, or (F)inish: ";
       
   789                   $line = <STDIN>;
       
   790                   $line = '' unless defined $line;
       
   791                   if ($line =~ /^R$/i )
       
   792                     {
       
   793                       goto RELIST;
       
   794                     }
       
   795                   
       
   796                   if ($line =~ /^F$/i)
       
   797                     {
       
   798                       $got_line = 1;
       
   799                     }
       
   800                   elsif ($line =~ /^(\d+)\s+(\d+)$/)
       
   801                     {
       
   802                       print "\n";
       
   803 
       
   804                       $del_index = $1;
       
   805                       $add_index = $2;
       
   806                       if ($del_index >= @del_files)
       
   807                         {
       
   808                           print "Delete index $del_index is larger than ",
       
   809                                 "maximum index of ", scalar @del_files - 1,
       
   810                                 ".\n";
       
   811                           $del_index = undef;
       
   812                         }
       
   813                       if ($add_index > @add_files)
       
   814                         {
       
   815                           print "Add index $add_index is larger than maximum ",
       
   816                                 "index of ", scalar @add_files - 1, ".\n";
       
   817                           $add_index = undef;
       
   818                         }
       
   819                       $got_line = defined $del_index && defined $add_index;
       
   820 
       
   821                       # Check that the file or directory to be renamed
       
   822                       # has the same file type.
       
   823                       if ($got_line)
       
   824                         {
       
   825                           $add_filename = $add_files[$add_index];
       
   826                           $del_filename = $del_files[$del_index];
       
   827                           if ($add_files{$add_filename}{type} ne
       
   828                               $del_files{$del_filename}{type})
       
   829                             {
       
   830                               print "File types for $del_filename and ",
       
   831                                     "$add_filename differ.\n";
       
   832                               $got_line = undef;
       
   833                             }
       
   834                         }
       
   835                     }
       
   836                 } until ($got_line);
       
   837 
       
   838                 if ($line !~ /^F$/i)
       
   839                   {
       
   840                     print "Renaming $del_filename to $add_filename.\n";
       
   841 
       
   842                     $repeat_loop = 1;
       
   843 
       
   844                     # Because subversion cannot rename the same file
       
   845                     # or directory twice, which includes doing a
       
   846                     # rename of a file in a directory that was
       
   847                     # previously renamed, a commit has to be
       
   848                     # performed.  Check if the file or directory being
       
   849                     # renamed now would cause such a problem and
       
   850                     # commit if so.
       
   851                     my $do_commit_now = 0;
       
   852                     foreach my $rename_to_filename (keys %rename_to_files)
       
   853                       {
       
   854                         if (contained_in($del_filename,
       
   855                                          $rename_to_filename,
       
   856                                          $rename_to_files{$rename_to_filename}{type}))
       
   857                           {
       
   858                             $do_commit_now = 1;
       
   859                             last;
       
   860                           }
       
   861                       }
       
   862 
       
   863                     if ($do_commit_now)
       
   864                       {
       
   865                         print "Now committing previously run renames.\n";
       
   866                         &commit_renames($load_dir,
       
   867                                         \@renamed_filenames,
       
   868                                         \%rename_from_files,
       
   869                                         \%rename_to_files);
       
   870                       }
       
   871 
       
   872                     push(@renamed_filenames, $del_filename, $add_filename);
       
   873                     {
       
   874                       my $d = $del_files{$del_filename};
       
   875                       $rename_from_files{$del_filename} = $d;
       
   876                       $rename_to_files{$add_filename}   = $d;
       
   877                     }
       
   878 
       
   879                     # Check that any required directories to do the
       
   880                     # rename exist.
       
   881                     my @add_segments = split('/', $add_filename);
       
   882                     pop(@add_segments);
       
   883                     my $add_dir = '';
       
   884                     my @add_dirs;
       
   885                     foreach my $segment (@add_segments)
       
   886                       {
       
   887                         $add_dir = length($add_dir) ? "$add_dir/$segment" :
       
   888                                                       $segment;
       
   889                         unless (-d $add_dir)
       
   890                           {
       
   891                             push(@add_dirs, $add_dir);
       
   892                           }
       
   893                       }
       
   894 
       
   895                     if (@add_dirs)
       
   896                       {
       
   897                         read_from_process($svn, 'mkdir', @add_dirs);
       
   898                       }
       
   899 
       
   900                     read_from_process($svn, 'mv',
       
   901                                       $del_filename, $add_filename);
       
   902                   }
       
   903               }
       
   904           } while ($repeat_loop);
       
   905       }
       
   906 
       
   907     # If there are any renames that have not been committed, then do
       
   908     # that now.
       
   909     if (@renamed_filenames)
       
   910       {
       
   911         &commit_renames($load_dir,
       
   912                         \@renamed_filenames,
       
   913                         \%rename_from_files,
       
   914                         \%rename_to_files);
       
   915       }
       
   916 
       
   917     # At this point all renames have been performed.  Now get the
       
   918     # final list of files and directories in the working copy
       
   919     # directory.  The %add_files hash will contain the list of files
       
   920     # and directories to add to the working copy and %del_files starts
       
   921     # with all the files already in the working copy and gets files
       
   922     # removed that are in the imported directory, which results in a
       
   923     # list of files that should be deleted.  %upd_files holds the list
       
   924     # of files that have been updated.
       
   925     my %add_files;
       
   926     my %del_files = &recursive_ls_and_hash($wc_import_dir_cwd);
       
   927     my %upd_files;
       
   928 
       
   929     # This anonymous subroutine copies files from the source directory
       
   930     # to the working copy directory.
       
   931     my $wanted = sub
       
   932       {
       
   933         s#^\./##;
       
   934         return if $_ eq '.';
       
   935 
       
   936         my $source_path = $_;
       
   937         my $dest_path   = "$wc_import_dir_cwd/$_";
       
   938 
       
   939         my ($source_type, $source_is_exe) = &file_info($source_path);
       
   940         my ($dest_type)                   = &file_info($dest_path);
       
   941 
       
   942         return if ($source_type ne 'd' and
       
   943                    $source_type ne 'f' and
       
   944                    $source_type ne 'l');
       
   945 
       
   946         # Fail if the destination type exists but is of a different
       
   947         # type of file than the source type.
       
   948         if ($dest_type ne '0' and $source_type ne $dest_type)
       
   949           {
       
   950             die "$0: does not handle changing source and destination type ",
       
   951                 "for '$source_path'.\n";
       
   952           }
       
   953 
       
   954         # Determine if the file is being added or is an update to an
       
   955         # already existing file using the file's digest.
       
   956         my $del_info = delete $del_files{$source_path};
       
   957         if (defined $del_info)
       
   958           {
       
   959             if (defined (my $del_digest = $del_info->{digest}))
       
   960               {
       
   961                 my $new_digest = &digest_hash_file($source_path);
       
   962                 if ($new_digest ne $del_digest)
       
   963                   {
       
   964                     print "U   $source_path\n";
       
   965                     $upd_files{$source_path} = $del_info;
       
   966                   }
       
   967               }
       
   968           }
       
   969         else
       
   970           {
       
   971             print "A   $source_path\n";
       
   972             $add_files{$source_path}{type} = $source_type;
       
   973 
       
   974             # Create an array reference to hold the list of properties
       
   975             # to apply to this object.
       
   976             unless (defined $add_files{$source_path}{properties})
       
   977               {
       
   978                 $add_files{$source_path}{properties} = [];
       
   979               }
       
   980 
       
   981             # Go through the list of properties for a match on this
       
   982             # file or directory and if there is a match, then apply
       
   983             # the property to it.
       
   984             foreach my $property (@property_settings)
       
   985               {
       
   986                 my $re = $property->{re};
       
   987                 if ($source_path =~ $re)
       
   988                   {
       
   989                     my $property_name  = $property->{name};
       
   990                     my $property_value = $property->{value};
       
   991 
       
   992                     # The property value may not be set in the
       
   993                     # configuration file, since the user may just want
       
   994                     # to set the control flag.
       
   995                     if (defined $property_name and defined $property_value)
       
   996                       {
       
   997                         # Ignore properties that do not apply to
       
   998                         # directories.
       
   999                         if ($source_type eq 'd')
       
  1000                           {
       
  1001                             if ($property_name eq 'svn:eol-style' or
       
  1002                                 $property_name eq 'svn:executable' or
       
  1003                                 $property_name eq 'svn:keywords' or
       
  1004                                 $property_name eq 'svn:mime-type')
       
  1005                               {
       
  1006                                 next;
       
  1007                               }
       
  1008                           }
       
  1009 
       
  1010                         # Ignore properties that do not apply to
       
  1011                         # files.
       
  1012                         if ($source_type eq 'f')
       
  1013                           {
       
  1014                             if ($property_name eq 'svn:externals' or
       
  1015                                 $property_name eq 'svn:ignore')
       
  1016                               {
       
  1017                                 next;
       
  1018                               }
       
  1019                           }
       
  1020 
       
  1021                         print "Adding to '$source_path' property ",
       
  1022                               "'$property_name' with value ",
       
  1023                               "'$property_value'.\n";
       
  1024 
       
  1025                         push(@{$add_files{$source_path}{properties}},
       
  1026                              $property);
       
  1027                       }
       
  1028 
       
  1029                     last if $property->{control} eq 'break';
       
  1030                   }
       
  1031               }
       
  1032           }
       
  1033 
       
  1034         # Add svn:executable to files that have their executable bit
       
  1035         # set.
       
  1036         if ($source_is_exe and !$opt_no_auto_exe)
       
  1037           {
       
  1038             print "Adding to '$source_path' property 'svn:executable' with ",
       
  1039                   "value '*'.\n";
       
  1040             my $property = {name => 'svn:executable', value => '*'};
       
  1041             push (@{$add_files{$source_path}{properties}},
       
  1042                   $property);
       
  1043           }
       
  1044 
       
  1045         # Now make sure the file or directory in the source directory
       
  1046         # exists in the repository.
       
  1047         if ($source_type eq 'd')
       
  1048           {
       
  1049             if ($dest_type eq '0')
       
  1050               {
       
  1051                 mkdir($dest_path)
       
  1052                   or die "$0: cannot mkdir '$dest_path': $!\n";
       
  1053               }
       
  1054           }
       
  1055         elsif
       
  1056           ($source_type eq 'l') {
       
  1057             my $link_target = readlink($source_path)
       
  1058               or die "$0: cannot readlink '$source_path': $!\n";
       
  1059             if ($dest_type eq 'l')
       
  1060               {
       
  1061                 my $old_target = readlink($dest_path)
       
  1062                   or die "$0: cannot readlink '$dest_path': $!\n";
       
  1063                 return if ($old_target eq $link_target);
       
  1064                 unlink($dest_path)
       
  1065                   or die "$0: unlink '$dest_path' failed: $!\n";
       
  1066               }
       
  1067             symlink($link_target, $dest_path)
       
  1068               or die "$0: cannot symlink '$dest_path' to '$link_target': $!\n";
       
  1069           }
       
  1070         elsif
       
  1071           ($source_type eq 'f') {
       
  1072             # Only copy the file if the digests do not match.
       
  1073             if ($add_files{$source_path} or $upd_files{$source_path})
       
  1074               {
       
  1075                 copy($source_path, $dest_path)
       
  1076                   or die "$0: copy '$source_path' to '$dest_path': $!\n";
       
  1077               }
       
  1078           }
       
  1079         else
       
  1080           {
       
  1081             die "$0: does not handle copying files of type '$source_type'.\n";
       
  1082           }
       
  1083       };
       
  1084 
       
  1085     # Now change into the directory containing the files to load.
       
  1086     # First change to the original directory where this script was run
       
  1087     # so that if the specified directory is a relative directory path,
       
  1088     # then the script can change into it.
       
  1089     chdir($orig_cwd)
       
  1090       or die "$0: cannot chdir '$orig_cwd': $!\n";
       
  1091     chdir($load_dir)
       
  1092       or die "$0: cannot chdir '$load_dir': $!\n";
       
  1093 
       
  1094     find({no_chdir   => 1,
       
  1095           preprocess => sub { sort { $b cmp $a }
       
  1096                               grep { $_ !~ /^[._]svn$/ } @_ },
       
  1097           wanted     => $wanted
       
  1098          }, '.');
       
  1099 
       
  1100     # The files and directories that are in %del_files are the files
       
  1101     # and directories that need to be deleted.  Because svn will
       
  1102     # return an error if a file or directory is deleted in a directory
       
  1103     # that subsequently is deleted, first find all directories and
       
  1104     # remove from the list any files and directories inside those
       
  1105     # directories from this list.  Work through the list repeatedly
       
  1106     # working from short to long names so that directories containing
       
  1107     # other files and directories will be deleted first.
       
  1108     my $repeat_loop;
       
  1109     do
       
  1110       {
       
  1111         $repeat_loop = 0;
       
  1112         my @del_files = sort {length($a) <=> length($b) || $a cmp $b}
       
  1113                         keys %del_files;
       
  1114         &filter_renamed_files(\@del_files, \%rename_from_files);
       
  1115         foreach my $file (@del_files)
       
  1116           {
       
  1117             if ($del_files{$file}{type} eq 'd')
       
  1118               {
       
  1119                 my $dir        = "$file/";
       
  1120                 my $dir_length = length($dir);
       
  1121                 foreach my $f (@del_files)
       
  1122                   {
       
  1123                     next if $file eq $f;
       
  1124                     if (length($f) >= $dir_length and
       
  1125                         substr($f, 0, $dir_length) eq $dir)
       
  1126                       {
       
  1127                         print "d   $f\n";
       
  1128                         delete $del_files{$f};
       
  1129                         $repeat_loop = 1;
       
  1130                       }
       
  1131                   }
       
  1132 
       
  1133                 # If there were any deletions of files and/or
       
  1134                 # directories inside a directory that will be deleted,
       
  1135                 # then restart the entire loop again, because one or
       
  1136                 # more keys have been deleted from %del_files.
       
  1137                 # Equally important is not to stop this loop if no
       
  1138                 # deletions have been done, otherwise later
       
  1139                 # directories that may contain files and directories
       
  1140                 # to be deleted will not be deleted.
       
  1141                 last if $repeat_loop;
       
  1142               }
       
  1143           }
       
  1144       } while ($repeat_loop);
       
  1145 
       
  1146     # What is left are files that are not in any directories to be
       
  1147     # deleted and directories to be deleted.  To delete the files,
       
  1148     # deeper files and directories must be deleted first.  Because we
       
  1149     # have a hash keyed by remaining files and directories to be
       
  1150     # deleted, instead of trying to figure out which directories and
       
  1151     # files are contained in other directories, just reverse sort by
       
  1152     # the path length and then alphabetically.
       
  1153     my @del_files = sort {length($b) <=> length($a) || $a cmp $b }
       
  1154                     keys %del_files;
       
  1155     &filter_renamed_files(\@del_files, \%rename_from_files);
       
  1156     foreach my $file (@del_files)
       
  1157       {
       
  1158         print "D   $file\n";
       
  1159       }
       
  1160 
       
  1161     # Now change back to the trunk directory and run the svn commands.
       
  1162     chdir($wc_import_dir_cwd)
       
  1163       or die "$0: cannot chdir '$wc_import_dir_cwd': $!\n";
       
  1164 
       
  1165     # If any of the added files have the svn:eol-style property set,
       
  1166     # then pass -b to diff, otherwise diff may fail because the end of
       
  1167     # lines have changed and the source file and file in the
       
  1168     # repository will not be identical.
       
  1169     my @diff_ignore_space_changes;
       
  1170 
       
  1171     if (keys %add_files)
       
  1172       {
       
  1173         my @add_files = sort {length($a) <=> length($b) || $a cmp $b}
       
  1174                         keys %add_files;
       
  1175         my $target_filename = &make_targets_file(@add_files);
       
  1176         read_from_process($svn, 'add', '-N', '--targets', $target_filename);
       
  1177         unlink($target_filename);
       
  1178 
       
  1179         # Add properties on the added files.
       
  1180         foreach my $add_file (@add_files)
       
  1181           {
       
  1182             foreach my $property (@{$add_files{$add_file}{properties}})
       
  1183               {
       
  1184                 my $property_name  = $property->{name};
       
  1185                 my $property_value = $property->{value};
       
  1186 
       
  1187                 if ($property_name eq 'svn:eol-style')
       
  1188                   {
       
  1189                     @diff_ignore_space_changes = ('-b');
       
  1190                   }
       
  1191                 
       
  1192                 # Write the value to a temporary file in case it's multi-line
       
  1193                 my ($handle, $tmpfile) = tempfile(DIR => $temp_dir);
       
  1194                 print $handle $property_value;
       
  1195                 close($handle);
       
  1196 
       
  1197                 read_from_process($svn,
       
  1198                                   'propset',
       
  1199                                   $property_name,
       
  1200                                   '--file',
       
  1201                                   $tmpfile,
       
  1202                                   $add_file);
       
  1203               }
       
  1204           }
       
  1205       }
       
  1206     if (@del_files)
       
  1207       {
       
  1208         my $target_filename = &make_targets_file(@del_files);
       
  1209         read_from_process($svn, 'rm', '--targets', $target_filename);
       
  1210         unlink($target_filename);
       
  1211       }
       
  1212 
       
  1213     # Go through the list of updated files and check the svn:eol-style
       
  1214     # property.  If it is set to native, then convert all CR, CRLF and
       
  1215     # LF's in the file to the native end of line characters.  Also,
       
  1216     # modify diff's command line so that it will ignore the change in
       
  1217     # end of line style.
       
  1218     if (keys %upd_files)
       
  1219       {
       
  1220         my @upd_files = sort {length($a) <=> length($b) || $a cmp $b}
       
  1221                         keys %upd_files;
       
  1222         foreach my $upd_file (@upd_files)
       
  1223           {
       
  1224             # Always append @BASE to a filename in case they contain a
       
  1225             # @ character, in which case the Subversion command line
       
  1226             # client will attempt to parse the characters after the @
       
  1227             # as a revision and most likely fail, or if the characters
       
  1228             # after the @ are a valid revision, then it'll possibly
       
  1229             # get the incorrect information.  So always append @BASE
       
  1230             # and any preceding @'s will be treated normally and the
       
  1231             # correct information will be retrieved.
       
  1232             my @command = ($svn,
       
  1233                            'propget',
       
  1234                            'svn:eol-style',
       
  1235                            "$upd_file\@BASE");
       
  1236             my @lines = read_from_process(@command);
       
  1237             next unless @lines;
       
  1238             if (@lines > 1)
       
  1239               {
       
  1240                 warn "$0: '@command' returned more than one line of output: ",
       
  1241                   "'@lines'.\n";
       
  1242                 next;
       
  1243               }
       
  1244 
       
  1245             my $eol_style = $lines[0];
       
  1246             if ($eol_style eq 'native')
       
  1247               {
       
  1248                 @diff_ignore_space_changes = ('-b');
       
  1249                 if (&convert_file_to_native_eol($upd_file))
       
  1250                   {
       
  1251                     print "Native eol-style conversion modified $upd_file.\n";
       
  1252                   }
       
  1253               }
       
  1254           }
       
  1255       }
       
  1256 
       
  1257     my $message = wrap('', '', "Load $load_dir into $repos_load_abs_path.\n");
       
  1258     read_from_process($svn, 'commit',
       
  1259                       @svn_use_repos_cmd_opts,
       
  1260                       '-m', $message);
       
  1261 
       
  1262     # If an update is not run now after a commit, then some file and
       
  1263     # directory paths will have an older revisions associated with
       
  1264     # them and any future commits will fail because they are out of
       
  1265     # date.
       
  1266     read_from_process($svn, 'update', @svn_use_repos_cmd_opts);
       
  1267 
       
  1268     # Now remove any files and directories to be deleted in the
       
  1269     # repository.
       
  1270     if (@del_files)
       
  1271       {
       
  1272         rmtree(\@del_files, 1, 0);
       
  1273       }
       
  1274 
       
  1275     # Now make the tag by doing a copy in the svn repository itself.
       
  1276     if (defined $load_tag)
       
  1277       {
       
  1278         my $repos_tag_abs_path = length($repos_base_path_segment) ?
       
  1279                                  "$repos_base_path_segment/$load_tag" :
       
  1280                                  $load_tag;
       
  1281 
       
  1282         my $from_url = $repos_load_rel_path eq '.' ?
       
  1283                        $repos_load_rel_path :
       
  1284                        "$repos_base_url/$repos_load_rel_path";
       
  1285         my $to_url   = "$repos_base_url/$load_tag";
       
  1286 
       
  1287         $message     = wrap("",
       
  1288                             "",
       
  1289                             "Tag $repos_load_abs_path as " .
       
  1290                             "$repos_tag_abs_path.\n");
       
  1291         read_from_process($svn, 'cp', @svn_use_repos_cmd_opts,
       
  1292                           '-m', $message, $from_url, $to_url);
       
  1293 
       
  1294         # Now check out the tag and run a recursive diff between the
       
  1295         # original source directory and the tag for a consistency
       
  1296         # check.
       
  1297         my $checkout_dir_name = "my_tag_wc_named_$load_tag";
       
  1298         print "Checking out $to_url into $temp_dir/$checkout_dir_name\n";
       
  1299 
       
  1300         chdir($temp_dir)
       
  1301           or die "$0: cannot chdir '$temp_dir': $!\n";
       
  1302 
       
  1303         read_from_process($svn, 'checkout',
       
  1304                           @svn_use_repos_cmd_opts,
       
  1305                           $to_url, $checkout_dir_name);
       
  1306 
       
  1307         chdir($checkout_dir_name)
       
  1308           or die "$0: cannot chdir '$checkout_dir_name': $!\n";
       
  1309 
       
  1310         chdir($orig_cwd)
       
  1311           or die "$0: cannot chdir '$orig_cwd': $!\n";
       
  1312         read_from_process('diff', '-u', @diff_ignore_space_changes,
       
  1313                           '-x', '.svn',
       
  1314                           '-r', $load_dir, "$temp_dir/$checkout_dir_name");
       
  1315       }
       
  1316   }
       
  1317 
       
  1318 exit 0;
       
  1319 
       
  1320 sub usage
       
  1321 {
       
  1322   warn "@_\n" if @_;
       
  1323   die "usage: $0 [options] svn_url svn_import_dir [dir_v1 [dir_v2 [..]]]\n",
       
  1324       "  svn_url        is the file:// or http:// URL of the svn repository\n",
       
  1325       "  svn_import_dir is the path relative to svn_url where to load dirs\n",
       
  1326       "  dir_v1 ..      list dirs to import otherwise read from stdin\n",
       
  1327       "options are\n",
       
  1328       "  -no_user_input don't ask yes/no questions and assume yes answer\n",
       
  1329       "  -no_auto_exe   don't set svn:executable for executable files\n",
       
  1330       "  -p filename    table listing properties to apply to matching files\n",
       
  1331       "  -svn_username  username to perform commits as\n",
       
  1332       "  -svn_password  password to supply to svn commit\n",
       
  1333       "  -t tag_dir     create a tag copy in tag_dir, relative to svn_url\n",
       
  1334       "  -v             increase program verbosity, multiple -v's allowed\n",
       
  1335       "  -wc path       use the already checked-out working copy at path\n",
       
  1336       "                 instead of checkout out a fresh working copy\n",
       
  1337       "  -glob_ignores  List of filename patterns to ignore (as in svn's\n",
       
  1338       "                 global-ignores config option)\n";
       
  1339 }
       
  1340 
       
  1341 # Get the next directory to load, either from the command line or from
       
  1342 # standard input.
       
  1343 my $get_next_load_dir_init = 0;
       
  1344 my @get_next_load_dirs;
       
  1345 sub get_next_load_dir
       
  1346 {
       
  1347   if (@ARGV)
       
  1348     {
       
  1349       unless ($get_next_load_dir_init)
       
  1350         {
       
  1351           $get_next_load_dir_init = 1;
       
  1352           @get_next_load_dirs     = @ARGV;
       
  1353         }
       
  1354       return shift @get_next_load_dirs;
       
  1355     }
       
  1356 
       
  1357   if ($opt_verbose)
       
  1358     {
       
  1359       print "Waiting for next directory to import on standard input:\n";
       
  1360     }
       
  1361   my $line = <STDIN>;
       
  1362 
       
  1363   print "\n" if $opt_verbose;
       
  1364 
       
  1365   chomp $line;
       
  1366   if ($line =~ m|(\S+)\s+(\S+)|)
       
  1367     {
       
  1368       $line = $1;
       
  1369       set_svn_use_repos_cmd_opts($2, $opt_svn_password);
       
  1370     }
       
  1371   $line;
       
  1372 }
       
  1373 
       
  1374 # This constant stores the commonly used string to indicate that a
       
  1375 # subroutine has been passed an incorrect number of arguments.
       
  1376 use vars qw($INCORRECT_NUMBER_OF_ARGS);
       
  1377 $INCORRECT_NUMBER_OF_ARGS = "passed incorrect number of arguments.\n";
       
  1378 
       
  1379 # Creates a temporary file in the temporary directory and stores the
       
  1380 # arguments in it for use by the svn --targets command line option.
       
  1381 # If any part of the file creation failed, exit the program, as
       
  1382 # there's no workaround.  Use a unique number as a counter to the
       
  1383 # files.
       
  1384 my $make_targets_file_counter;
       
  1385 sub make_targets_file
       
  1386 {
       
  1387   unless (@_)
       
  1388     {
       
  1389       confess "$0: make_targets_file $INCORRECT_NUMBER_OF_ARGS";
       
  1390     }
       
  1391 
       
  1392   $make_targets_file_counter = 1 unless defined $make_targets_file_counter;
       
  1393 
       
  1394   my $filename = sprintf "%s/targets.%05d",
       
  1395                  $temp_dir,
       
  1396                  $make_targets_file_counter;
       
  1397   ++$make_targets_file_counter;
       
  1398 
       
  1399   open(TARGETS, ">$filename")
       
  1400     or die "$0: cannot open '$filename' for writing: $!\n";
       
  1401 
       
  1402   foreach my $file (@_)
       
  1403     {
       
  1404       print TARGETS "$file\n";
       
  1405     }
       
  1406 
       
  1407   close(TARGETS)
       
  1408     or die "$0: error in closing '$filename' for writing: $!\n";
       
  1409 
       
  1410   $filename;
       
  1411 }
       
  1412 
       
  1413 # Set the svn command line options that are used anytime svn connects
       
  1414 # to the repository.
       
  1415 sub set_svn_use_repos_cmd_opts
       
  1416 {
       
  1417   unless (@_ == 2)
       
  1418     {
       
  1419       confess "$0: set_svn_use_repos_cmd_opts $INCORRECT_NUMBER_OF_ARGS";
       
  1420     }
       
  1421 
       
  1422   my $username = shift;
       
  1423   my $password = shift;
       
  1424 
       
  1425   @svn_use_repos_cmd_opts = ('--non-interactive');
       
  1426   if (defined $username and length $username)
       
  1427     {
       
  1428       push(@svn_use_repos_cmd_opts, '--username', $username);
       
  1429     }
       
  1430   if (defined $password)
       
  1431     {
       
  1432       push(@svn_use_repos_cmd_opts, '--password', $password);
       
  1433     }
       
  1434 }
       
  1435 
       
  1436 sub get_tag_dir
       
  1437 {
       
  1438   unless (@_ == 1)
       
  1439     {
       
  1440       confess "$0: get_tag_dir $INCORRECT_NUMBER_OF_ARGS";
       
  1441     }
       
  1442 
       
  1443   my $load_dir = shift;
       
  1444 
       
  1445   # Take the tag relative directory, search for pairs of
       
  1446   # REGEX_SEP_CHAR's and use the regular expression inside the pair to
       
  1447   # put in the tag directory name.
       
  1448   my $tag_location = $opt_import_tag_location;
       
  1449   my $load_tag     = '';
       
  1450   while ((my $i = index($tag_location, $REGEX_SEP_CHAR)) >= 0)
       
  1451     {
       
  1452       $load_tag .= substr($tag_location, 0, $i, '');
       
  1453       substr($tag_location, 0, 1, '');
       
  1454       my $j = index($tag_location, $REGEX_SEP_CHAR);
       
  1455       if ($j < 0)
       
  1456         {
       
  1457           die "$0: -t value '$opt_import_tag_location' does not have ",
       
  1458               "matching $REGEX_SEP_CHAR.\n";
       
  1459         }
       
  1460       my $regex = substr($tag_location, 0, $j, '');
       
  1461       $regex = "($regex)" unless ($regex =~ /\(.+\)/);
       
  1462       substr($tag_location, 0, 1, '');
       
  1463       my @results = $load_dir =~ m/$regex/;
       
  1464       $load_tag .= join('', @results);
       
  1465     }
       
  1466   $load_tag .= $tag_location;
       
  1467 
       
  1468   $load_tag;
       
  1469 }
       
  1470 
       
  1471 # Return a two element array.  The first element is a single character
       
  1472 # that represents the type of object the path points to.  The second
       
  1473 # is a boolean (1 for true, '' for false) if the path points to a file
       
  1474 # and if the file is executable.
       
  1475 sub file_info
       
  1476 {
       
  1477   lstat(shift) or return ('0', '');
       
  1478   -b _ and return ('b', '');
       
  1479   -c _ and return ('c', '');
       
  1480   -d _ and return ('d', '');
       
  1481   -f _ and return ('f', -x _);
       
  1482   -l _ and return ('l', '');
       
  1483   -p _ and return ('p', '');
       
  1484   -S _ and return ('S', '');
       
  1485   return '?';
       
  1486 }
       
  1487 
       
  1488 # Start a child process safely without using /bin/sh.
       
  1489 sub safe_read_from_pipe
       
  1490 {
       
  1491   unless (@_)
       
  1492     {
       
  1493       croak "$0: safe_read_from_pipe $INCORRECT_NUMBER_OF_ARGS";
       
  1494     }
       
  1495 
       
  1496   my $openfork_available = "MSWin32" ne $OSNAME;
       
  1497   if ($openfork_available)
       
  1498     {
       
  1499       print "Running @_\n";
       
  1500       my $pid = open(SAFE_READ, "-|");
       
  1501       unless (defined $pid)
       
  1502         {
       
  1503           die "$0: cannot fork: $!\n";
       
  1504         }
       
  1505       unless ($pid)
       
  1506         {
       
  1507           # child
       
  1508           open(STDERR, ">&STDOUT")
       
  1509             or die "$0: cannot dup STDOUT: $!\n";
       
  1510           exec(@_)
       
  1511             or die "$0: cannot exec '@_': $!\n";
       
  1512         }
       
  1513     }
       
  1514   else
       
  1515     {
       
  1516       # Redirect the comment into a temp file and use that to work around
       
  1517       # Windoze's (non-)handling of multi-line commands.
       
  1518       my @commandline = ();
       
  1519       my $command;
       
  1520       my $comment;
       
  1521         
       
  1522       while ($command = shift)
       
  1523         {
       
  1524           if ("-m" eq $command)
       
  1525             {
       
  1526               my $comment = shift;
       
  1527               my ($handle, $tmpfile) = tempfile(DIR => $temp_dir);
       
  1528               print $handle $comment;
       
  1529               close($handle);
       
  1530                 
       
  1531               push(@commandline, "--file");
       
  1532               push(@commandline, $tmpfile);
       
  1533             }
       
  1534           else
       
  1535             {
       
  1536               # Munge the command to protect it from the command line
       
  1537               $command =~ s/\"/\\\"/g;
       
  1538               if ($command =~ m"\s") { $command = "\"$command\""; }
       
  1539               if ($command eq "") { $command = "\"\""; }
       
  1540               if ($command =~ m"\n")
       
  1541                 {
       
  1542                   warn "$0: carriage return detected in command - may not work\n";
       
  1543                 }
       
  1544               push(@commandline, $command);
       
  1545             }
       
  1546         }
       
  1547         
       
  1548       print "Running @commandline\n";
       
  1549       if ( $comment ) { print $comment; }
       
  1550         
       
  1551       # Now do the pipe.
       
  1552       open(SAFE_READ, "@commandline |")
       
  1553         or die "$0: cannot pipe to command: $!\n";
       
  1554     }
       
  1555     
       
  1556   # parent
       
  1557   my @output;
       
  1558   while (<SAFE_READ>)
       
  1559     {
       
  1560       chomp;
       
  1561       push(@output, $_);
       
  1562     }
       
  1563   close(SAFE_READ);
       
  1564   my $result = $?;
       
  1565   my $exit   = $result >> 8;
       
  1566   my $signal = $result & 127;
       
  1567   my $cd     = $result & 128 ? "with core dump" : "";
       
  1568   if ($signal or $cd)
       
  1569     {
       
  1570       warn "$0: pipe from '@_' failed $cd: exit=$exit signal=$signal\n";
       
  1571     }
       
  1572   if (wantarray)
       
  1573     {
       
  1574       return ($result, @output);
       
  1575     }
       
  1576   else
       
  1577     {
       
  1578       return $result;
       
  1579     }
       
  1580 }
       
  1581 
       
  1582 # Use safe_read_from_pipe to start a child process safely and exit the
       
  1583 # script if the child failed for whatever reason.
       
  1584 sub read_from_process
       
  1585 {
       
  1586   unless (@_)
       
  1587     {
       
  1588       croak "$0: read_from_process $INCORRECT_NUMBER_OF_ARGS";
       
  1589     }
       
  1590   my ($status, @output) = &safe_read_from_pipe(@_);
       
  1591   if ($status)
       
  1592     {
       
  1593       print STDERR "$0: @_ failed with this output:\n", join("\n", @output),
       
  1594                    "\n";
       
  1595       unless ($opt_no_user_input)
       
  1596         {
       
  1597           print STDERR
       
  1598             "Press return to quit and clean up svn working directory: ";
       
  1599           <STDIN>;
       
  1600         }
       
  1601       exit 1;
       
  1602     }
       
  1603   else
       
  1604     {
       
  1605       return @output;
       
  1606     }
       
  1607 }
       
  1608 
       
  1609 # Get a list of all the files and directories in the specified
       
  1610 # directory, the type of file and a digest hash of file types.
       
  1611 sub recursive_ls_and_hash
       
  1612 {
       
  1613   unless (@_ == 1)
       
  1614     {
       
  1615       croak "$0: recursive_ls_and_hash $INCORRECT_NUMBER_OF_ARGS";
       
  1616     }
       
  1617 
       
  1618   # This is the directory to change into.
       
  1619   my $dir = shift;
       
  1620 
       
  1621   # Get the current directory so that the script can change into the
       
  1622   # current working directory after changing into the specified
       
  1623   # directory.
       
  1624   my $return_cwd = cwd;
       
  1625 
       
  1626   chdir($dir)
       
  1627     or die "$0: cannot chdir '$dir': $!\n";
       
  1628 
       
  1629   my %files;
       
  1630 
       
  1631   my $wanted = sub
       
  1632     {
       
  1633       s#^\./##;
       
  1634       return if $_ eq '.';
       
  1635       my ($file_type) = &file_info($_);
       
  1636       my $file_digest;
       
  1637       if ($file_type eq 'f' or ($file_type eq 'l' and stat($_) and -f _))
       
  1638         {
       
  1639           $file_digest = &digest_hash_file($_);
       
  1640         }
       
  1641       $files{$_} = {type   => $file_type,
       
  1642                     digest => $file_digest};
       
  1643     };
       
  1644   find({no_chdir   => 1,
       
  1645         preprocess => sub
       
  1646 	  {
       
  1647             grep
       
  1648               {
       
  1649                 my $ok=1;
       
  1650                 foreach my $x (@glob_ignores)
       
  1651                   {
       
  1652                     if ( $_ =~ /$x/ ) {$ok=0;last;}
       
  1653                   }
       
  1654                 $ok
       
  1655               } @_
       
  1656           },
       
  1657         wanted     => $wanted
       
  1658        }, '.');
       
  1659 
       
  1660   chdir($return_cwd)
       
  1661     or die "$0: cannot chdir '$return_cwd': $!\n";
       
  1662 
       
  1663   %files;
       
  1664 }
       
  1665 
       
  1666 # Given a list of files and directories which have been renamed but
       
  1667 # not commtited, commit them with a proper log message.
       
  1668 sub commit_renames
       
  1669 {
       
  1670   unless (@_ == 4)
       
  1671     {
       
  1672       croak "$0: commit_renames $INCORRECT_NUMBER_OF_ARGS";
       
  1673     }
       
  1674 
       
  1675   my $load_dir          = shift;
       
  1676   my $renamed_filenames = shift;
       
  1677   my $rename_from_files = shift;
       
  1678   my $rename_to_files   = shift;
       
  1679 
       
  1680   my $number_renames    = @$renamed_filenames/2;
       
  1681 
       
  1682   my $message = "To prepare to load $load_dir into $repos_load_abs_path, " .
       
  1683                 "perform $number_renames rename" .
       
  1684                 ($number_renames > 1 ? "s" : "") . ".\n";
       
  1685 
       
  1686   # Text::Wrap::wrap appears to replace multiple consecutive \n's with
       
  1687   # one \n, so wrap the text and then append the second \n.
       
  1688   $message  = wrap("", "", $message) . "\n";
       
  1689   while (@$renamed_filenames)
       
  1690     {
       
  1691       my $from  = "$repos_load_abs_path/" . shift @$renamed_filenames;
       
  1692       my $to    = "$repos_load_abs_path/" . shift @$renamed_filenames;
       
  1693       $message .= wrap("", "  ", "* $to: Renamed from $from.\n");
       
  1694     }
       
  1695 
       
  1696   # Change to the top of the working copy so that any
       
  1697   # directories will also be updated.
       
  1698   my $cwd = cwd;
       
  1699   chdir($wc_import_dir_cwd)
       
  1700     or die "$0: cannot chdir '$wc_import_dir_cwd': $!\n";
       
  1701   read_from_process($svn, 'commit', @svn_use_repos_cmd_opts, '-m', $message);
       
  1702   read_from_process($svn, 'update', @svn_use_repos_cmd_opts);
       
  1703   chdir($cwd)
       
  1704     or die "$0: cannot chdir '$cwd': $!\n";
       
  1705 
       
  1706   # Some versions of subversion have a bug where renamed files
       
  1707   # or directories are not deleted after a commit, so do that
       
  1708   # here.
       
  1709   my @del_files = sort {length($b) <=> length($a) || $a cmp $b }
       
  1710                   keys %$rename_from_files;
       
  1711   rmtree(\@del_files, 1, 0);
       
  1712 
       
  1713   # Empty the list of old and new renamed names.
       
  1714   undef %$rename_from_files;
       
  1715   undef %$rename_to_files;
       
  1716 }
       
  1717 
       
  1718 # Take a one file or directory and see if its name is equal to a
       
  1719 # second or is contained in the second if the second file's file type
       
  1720 # is a directory.
       
  1721 sub contained_in
       
  1722 {
       
  1723   unless (@_ == 3)
       
  1724     {
       
  1725       croak "$0: contain_in $INCORRECT_NUMBER_OF_ARGS";
       
  1726     }
       
  1727 
       
  1728   my $contained      = shift;
       
  1729   my $container      = shift;
       
  1730   my $container_type = shift;
       
  1731 
       
  1732   if ($container eq $contained)
       
  1733     {
       
  1734       return 1;
       
  1735     }
       
  1736 
       
  1737   if ($container_type eq 'd')
       
  1738     {
       
  1739       my $dirname        = "$container/";
       
  1740       my $dirname_length = length($dirname);
       
  1741 
       
  1742       if ($dirname_length <= length($contained) and
       
  1743           $dirname eq substr($contained, 0, $dirname_length))
       
  1744         {
       
  1745           return 1;
       
  1746         }
       
  1747     }
       
  1748 
       
  1749   return 0;
       
  1750 }
       
  1751 
       
  1752 # Take an array reference containing a list of files and directories
       
  1753 # and take a hash reference and remove from the array reference any
       
  1754 # files and directories and the files the directory contains listed in
       
  1755 # the hash.
       
  1756 sub filter_renamed_files
       
  1757 {
       
  1758   unless (@_ == 2)
       
  1759     {
       
  1760       croak "$0: filter_renamed_files $INCORRECT_NUMBER_OF_ARGS";
       
  1761     }
       
  1762 
       
  1763   my $array_ref = shift;
       
  1764   my $hash_ref  = shift;
       
  1765 
       
  1766   foreach my $remove_filename (keys %$hash_ref)
       
  1767     {
       
  1768       my $remove_file_type = $hash_ref->{$remove_filename}{type};
       
  1769       for (my $i=0; $i<@$array_ref;)
       
  1770         {
       
  1771           if (contained_in($array_ref->[$i],
       
  1772                            $remove_filename,
       
  1773                            $remove_file_type))
       
  1774             {
       
  1775               splice(@$array_ref, $i, 1);
       
  1776               next;
       
  1777             }
       
  1778           ++$i;
       
  1779         }
       
  1780     }
       
  1781 }
       
  1782 
       
  1783 # Get a digest hash of the specified filename.
       
  1784 sub digest_hash_file
       
  1785 {
       
  1786   unless (@_ == 1)
       
  1787     {
       
  1788       croak "$0: digest_hash_file $INCORRECT_NUMBER_OF_ARGS";
       
  1789     }
       
  1790 
       
  1791   my $filename = shift;
       
  1792 
       
  1793   my $ctx = Digest::MD5->new;
       
  1794   if (open(READ, $filename))
       
  1795     {
       
  1796       binmode READ;
       
  1797       $ctx->addfile(*READ);
       
  1798       close(READ);
       
  1799     }
       
  1800   else
       
  1801     {
       
  1802       die "$0: cannot open '$filename' for reading: $!\n";
       
  1803     }
       
  1804   $ctx->digest;
       
  1805 }
       
  1806 
       
  1807 # Read standard input until a line contains the required input or an
       
  1808 # empty line to signify the default answer.
       
  1809 sub get_answer
       
  1810 {
       
  1811   unless (@_ == 3)
       
  1812     {
       
  1813       croak "$0: get_answer $INCORRECT_NUMBER_OF_ARGS";
       
  1814     }
       
  1815 
       
  1816   my $message = shift;
       
  1817   my $answers = shift;
       
  1818   my $def_ans = shift;
       
  1819 
       
  1820   return $def_ans if $opt_no_user_input;
       
  1821 
       
  1822   my $char;
       
  1823   do
       
  1824     {
       
  1825       print $message;
       
  1826       $char = '';
       
  1827       my $line = <STDIN>;
       
  1828       if (defined $line and length $line)
       
  1829         {
       
  1830           $char = substr($line, 0, 1);
       
  1831           $char = '' if $char eq "\n";
       
  1832         }
       
  1833     } until $char eq '' or $answers =~ /$char/ig;
       
  1834 
       
  1835   return $def_ans if $char eq '';
       
  1836   return pos($answers) - 1;
       
  1837 }
       
  1838 
       
  1839 # Determine the native end of line on this system by writing a \n in
       
  1840 # non-binary mode to an empty file and reading the same file back in
       
  1841 # binary mode.
       
  1842 sub determine_native_eol
       
  1843 {
       
  1844   my $filename = "$temp_dir/svn_load_dirs_eol_test.$$";
       
  1845   if (-e $filename)
       
  1846     {
       
  1847       unlink($filename)
       
  1848         or die "$0: cannot unlink '$filename': $!\n";
       
  1849     }
       
  1850 
       
  1851   # Write the \n in non-binary mode.
       
  1852   open(NL_TEST, ">$filename")
       
  1853     or die "$0: cannot open '$filename' for writing: $!\n";
       
  1854   print NL_TEST "\n";
       
  1855   close(NL_TEST)
       
  1856     or die "$0: error in closing '$filename' for writing: $!\n";
       
  1857 
       
  1858   # Read the \n in binary mode.
       
  1859   open(NL_TEST, $filename)
       
  1860     or die "$0: cannot open '$filename' for reading: $!\n";
       
  1861   binmode NL_TEST;
       
  1862   local $/;
       
  1863   undef $/;
       
  1864   my $eol = <NL_TEST>;
       
  1865   close(NL_TEST)
       
  1866     or die "$0: cannot close '$filename' for reading: $!\n";
       
  1867   unlink($filename)
       
  1868     or die "$0: cannot unlink '$filename': $!\n";
       
  1869 
       
  1870   my $eol_length = length($eol);
       
  1871   unless ($eol_length)
       
  1872     {
       
  1873       die "$0: native eol length on this system is 0.\n";
       
  1874     }
       
  1875 
       
  1876   print "Native EOL on this system is ";
       
  1877   for (my $i=0; $i<$eol_length; ++$i)
       
  1878     {
       
  1879       printf "\\%03o", ord(substr($eol, $i, 1));
       
  1880     }
       
  1881   print ".\n\n";
       
  1882 
       
  1883   $eol;
       
  1884 }
       
  1885 
       
  1886 # Take a filename, open the file and replace all CR, CRLF and LF's
       
  1887 # with the native end of line style for this system.
       
  1888 sub convert_file_to_native_eol
       
  1889 {
       
  1890   unless (@_ == 1)
       
  1891     {
       
  1892       croak "$0: convert_file_to_native_eol $INCORRECT_NUMBER_OF_ARGS";
       
  1893     }
       
  1894 
       
  1895   my $filename = shift;
       
  1896   open(FILE, $filename)
       
  1897     or die "$0: cannot open '$filename' for reading: $!\n";
       
  1898   binmode FILE;
       
  1899   local $/;
       
  1900   undef $/;
       
  1901   my $in = <FILE>;
       
  1902   close(FILE)
       
  1903     or die "$0: error in closing '$filename' for reading: $!\n";
       
  1904   my $out = '';
       
  1905 
       
  1906   # Go through the file and transform it byte by byte.
       
  1907   my $i = 0;
       
  1908   while ($i < length($in))
       
  1909     {
       
  1910       my $cc = substr($in, $i, 2);
       
  1911       if ($cc eq "\015\012")
       
  1912         {
       
  1913           $out .= $native_eol;
       
  1914           $i += 2;
       
  1915           next;
       
  1916         }
       
  1917 
       
  1918       my $c = substr($cc, 0, 1);
       
  1919       if ($c eq "\012" or $c eq "\015")
       
  1920         {
       
  1921           $out .= $native_eol;
       
  1922         }
       
  1923       else
       
  1924         {
       
  1925           $out .= $c;
       
  1926         }
       
  1927       ++$i;
       
  1928     }
       
  1929 
       
  1930   return 0 if $in eq $out;
       
  1931 
       
  1932   my $tmp_filename = ".svn/tmp/svn_load_dirs.$$";
       
  1933   open(FILE, ">$tmp_filename")
       
  1934     or die "$0: cannot open '$tmp_filename' for writing: $!\n";
       
  1935   binmode FILE;
       
  1936   print FILE $out;
       
  1937   close(FILE)
       
  1938     or die "$0: cannot close '$tmp_filename' for writing: $!\n";
       
  1939   rename($tmp_filename, $filename)
       
  1940     or die "$0: cannot rename '$tmp_filename' to '$filename': $!\n";
       
  1941 
       
  1942   return 1;
       
  1943 }
       
  1944 
       
  1945 # Split the input line into words taking into account that single or
       
  1946 # double quotes may define a single word with whitespace in it.
       
  1947 sub split_line
       
  1948 {
       
  1949   unless (@_ == 1)
       
  1950     {
       
  1951       croak "$0: split_line $INCORRECT_NUMBER_OF_ARGS";
       
  1952     }
       
  1953 
       
  1954   my $line = shift;
       
  1955 
       
  1956   # Strip leading whitespace.  Do not strip trailing whitespace which
       
  1957   # may be part of quoted text that was never closed.
       
  1958   $line =~ s/^\s+//;
       
  1959 
       
  1960   my $line_length  = length $line;
       
  1961   my @words        = ();
       
  1962   my $current_word = '';
       
  1963   my $in_quote     = '';
       
  1964   my $in_protect   = '';
       
  1965   my $in_space     = '';
       
  1966   my $i            = 0;
       
  1967 
       
  1968   while ($i < $line_length)
       
  1969     {
       
  1970       my $c = substr($line, $i, 1);
       
  1971       ++$i;
       
  1972 
       
  1973       if ($in_protect)
       
  1974         {
       
  1975           if ($c eq $in_quote)
       
  1976             {
       
  1977               $current_word .= $c;
       
  1978             }
       
  1979           elsif ($c eq '"' or $c eq "'")
       
  1980             {
       
  1981               $current_word .= $c;
       
  1982             }
       
  1983           else
       
  1984             {
       
  1985               $current_word .= "$in_protect$c";
       
  1986             }
       
  1987           $in_protect = '';
       
  1988         }
       
  1989       elsif ($c eq '\\')
       
  1990         {
       
  1991           $in_protect = $c;
       
  1992         }
       
  1993       elsif ($in_quote)
       
  1994         {
       
  1995           if ($c eq $in_quote)
       
  1996             {
       
  1997               $in_quote = '';
       
  1998             }
       
  1999           else
       
  2000             {
       
  2001               $current_word .= $c;
       
  2002             }
       
  2003         }
       
  2004       elsif ($c eq '"' or $c eq "'")
       
  2005         {
       
  2006           $in_quote = $c;
       
  2007         }
       
  2008       elsif ($c =~ m/^\s$/)
       
  2009         {
       
  2010           unless ($in_space)
       
  2011             {
       
  2012               push(@words, $current_word);
       
  2013               $current_word = '';
       
  2014             }
       
  2015         }
       
  2016       else
       
  2017         {
       
  2018           $current_word .= $c;
       
  2019         }
       
  2020 
       
  2021       $in_space = $c =~ m/^\s$/;
       
  2022     }
       
  2023 
       
  2024   # Handle any leftovers.
       
  2025   $current_word .= $in_protect if $in_protect;
       
  2026   push(@words, $current_word) if length $current_word;
       
  2027 
       
  2028   @words;
       
  2029 }
       
  2030 
       
  2031 # This package exists just to delete the temporary directory.
       
  2032 package Temp::Delete;
       
  2033 
       
  2034 sub new
       
  2035 {
       
  2036   bless {}, shift;
       
  2037 }
       
  2038 
       
  2039 sub DESTROY
       
  2040 {
       
  2041   print "Cleaning up $temp_dir\n";
       
  2042   File::Path::rmtree([$temp_dir], 0, 0);
       
  2043 }