New URL for NEMO forge!   http://forge.nemo-ocean.eu

Since March 2022 along with NEMO 4.2 release, the code development moved to a self-hosted GitLab.
This present forge is now archived and remained online for history.
svn_load_dirs.pl in trunk/NEMOGCM/EXTERNAL/svn_tools – NEMO

source: trunk/NEMOGCM/EXTERNAL/svn_tools/svn_load_dirs.pl @ 4528

Last change on this file since 4528 was 2768, checked in by smasson, 13 years ago

minor bugfix in svn_tools

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