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.