svn_load_dirs.pl.in

subversion-1.4.3-1.tar.gz 配置svn的源码

#!/usr/bin/perl -w

# $HeadURL: https://svn.collab.net/repos/svn/branches/1.4.x/contrib/client-side/svn_load_dirs.pl.in $
# $LastChangedDate: 2006-11-10 13:07:14 -0600 (Fri, 10 Nov 2006) $
# $LastChangedBy: dlr $
# $LastChangedRevision: 22266 $

$| = 1;

use strict;
use Carp;
use Cwd;
use Digest::MD5  2.20;
use File::Copy   2.03;
use File::Find;
use File::Path   1.0404;
use File::Temp   0.12   qw(tempdir tempfile);
use Getopt::Long 2.25;
use Text::Wrap;
use URI          1.17;
use English;

$Text::Wrap::columns = 72;

# Specify the location of the svn command.
my $svn = '@SVN_BINDIR@/svn';

# Process the command line options.

# The base URL for the portion of the repository to work in.  Note
# that this does not have to be the root of the subversion repository,
# it can point to a subdirectory in the repository.
my $repos_base_url;

# The relative path from the repository base URL to work in to the
# directory to load the input directories into.
my $repos_load_rel_path;

# To specify where tags, which are simply copies of the imported
# directory, should be placed relative to the repository base URL, use
# the -t command line option.  This value must contain regular
# expressions that match portions of the input directory names to
# create an unique tag for each input directory.  The regular
# expressions are surrounded by a specified character to distinguish
# the regular expression from the normal directory path.
my $opt_import_tag_location;

# Do not ask for any user input.  Just go ahead and do everything.
my $opt_no_user_input;

# Username to use for commits.
my $opt_svn_username;

# Password to use for commits.
my $opt_svn_password;

# Verbosity level.
my $opt_verbose;

# Path to already checked-out working copy.
my $opt_existing_wc_dir;

# This is the character used to separate regular expressions occuring
# in the tag directory path from the path itself.
my $REGEX_SEP_CHAR = '@';

# This specifies a configuration file that contains a list of regular
# expressions to check against a file and the properties to set on
# matching files.
my $property_config_filename;

GetOptions('no_user_input'           => \$opt_no_user_input,
           'property_cfg_filename=s' => \$property_config_filename,
           'svn_password=s'          => \$opt_svn_password,
           'svn_username=s'          => \$opt_svn_username,
           'tag_location=s'          => \$opt_import_tag_location,
           'verbose+'                => \$opt_verbose,
           'wc=s'                    => \$opt_existing_wc_dir)
  or &usage;
&usage("$0: too few arguments") if @ARGV < 2;

$repos_base_url      = shift;
$repos_load_rel_path = shift;

# Check that the repository base URL and the import directories do not
# contain any ..'s.
if ($repos_base_url =~ /\.{2}/)
  {
    die "$0: repos base URL $repos_base_url cannot contain ..'s.\n";
  }
if ($repos_load_rel_path =~ /\.{2}/)
  {
    die "$0: repos import relative directory path $repos_load_rel_path ",
        "cannot contain ..'s.\n";
  }

# If there are no directories listed on the command line, then the
# directories are read from standard input.  In this case, the
# -no_user_input command line option must be specified.
if (!@ARGV and !$opt_no_user_input)
  {
    &usage("$0: must use -no_user_input if no dirs listed on command line.");
  }

# The tag option cannot be used when directories are read from
# standard input because tags may collide and no user input can be
# taken to verify that the input is ok.
if (!@ARGV and $opt_import_tag_location)
  {
    &usage("$0: cannot use -tag_location when dirs are read from stdin.");
  }

# If the tag directory is set, then the import directory cannot be '.'.
if (defined $opt_import_tag_location and $repos_load_rel_path eq '.')
  {
    &usage("$0: cannot set import_dir to '.' and use -t command line option.");
  }

# Set the svn command line options that are used anytime svn connects
# to the repository.
my @svn_use_repos_cmd_opts;
&set_svn_use_repos_cmd_opts($opt_svn_username, $opt_svn_password);

# Check that the tag directories do not contain any ..'s.  Also, the
# import and tag directories cannot be absolute.
if (defined $opt_import_tag_location and $opt_import_tag_location =~ /\.{2}/)
  {
    die "$0: repos tag relative directory path $opt_import_tag_location ",
        "cannot contain ..'s.\n";
  }
if ($repos_load_rel_path =~ m|^/|)
  {
    die "$0: repos import relative directory path $repos_load_rel_path ",
        "cannot start with /.\n";
  }
if (defined $opt_import_tag_location and $opt_import_tag_location =~ m|^/|)
  {
    die "$0: repos tagrelative directory path $opt_import_tag_location ",
        "cannot start with /.\n";
  }

if (defined $opt_existing_wc_dir)
  {
    unless (-e $opt_existing_wc_dir)
      {
        die "$0: working copy '$opt_existing_wc_dir' does not exist.\n";
      }

    unless (-d _)
      {
        die "$0: working copy '$opt_existing_wc_dir' is not a directory.\n";
      }

    unless (-d "$opt_existing_wc_dir/.svn")
      {
        die "$0: working copy '$opt_existing_wc_dir' does not have .svn ",
            "directory.\n";
      }

    $opt_existing_wc_dir = Cwd::abs_path($opt_existing_wc_dir)
  }

# Convert the string URL into a URI object.
$repos_base_url    =~ s|/*$||;
my $repos_base_uri = URI->new($repos_base_url);

# Check that $repos_load_rel_path is not a directory here implying
# that a command line option was forgotten.
if ($repos_load_rel_path ne '.' and -d $repos_load_rel_path)
  {
    die "$0: import_dir '$repos_load_rel_path' is a directory.\n";
  }

# The remaining command line arguments should be directories.  Check
# that they all exist and that there are no duplicates.
if (@ARGV)
  {
    my %dirs;
    foreach my $dir (@ARGV)
      {
        unless (-e $dir)
          {
            die "$0: directory '$dir' does not exist.\n";
          }

        unless (-d _)
          {
            die "$0: directory '$dir' is not a directory.\n";
          }

        if ($dirs{$dir})
          {
            die "$0: directory '$dir' is listed more than once on command ",
                "line.\n";
          }
        $dirs{$dir} = 1;
      }
  }

# Create the tag locations and print them for the user to review.
# Check that there are no duplicate tags.
my %load_tags;
if (@ARGV and defined $opt_import_tag_location)
  {
    my %seen_tags;

    foreach my $load_dir (@ARGV)
      {
        my $load_tag = &get_tag_dir($load_dir);

        print "Directory $load_dir will be tagged as $load_tag\n";

        if ($seen_tags{$load_tag})
          {
            die "$0: duplicate tag generated.\n";
          }
        $seen_tags{$load_tag} = 1;

        $load_tags{$load_dir} = $load_tag;
      }

    exit 0 unless &get_answer("Please examine identified tags.  Are they " .
                              "acceptable? (Y/n) ", 'ny', 1);
    print "\n";
  }

# Load the property configuration filename, if one was specified, into
# an array of hashes, where each hash contains a regular expression
# and a property to apply to the file if the regular expression
# matches.
my @property_settings;
if (defined $property_config_filename and length $property_config_filename)
  {
    open(CFG, $property_config_filename)
      or die "$0: cannot open '$property_config_filename' for reading: $!\n";

    my $ok = 1;

    while (my $line = <CFG>)
      {
        next if $line =~ /^\s*$/;
        next if $line =~ /^\s*#/;

        # Split the input line into words taking into account that
        # single or double quotes may define a single word with
        # whitespace in it.  The format for the file is
        # regex control property_name property_value
        my @line = &split_line($line);
        next if @line == 0;

        unless (@line == 2 or @line == 4)
          {
            warn "$0: line $. of '$property_config_filename' has to have 2 ",
                 "or 4 columns.\n";
            $ok = 0;
            next;
          }
        my ($regex, $control, $property_name, $property_value) = @line;

        unless ($control eq 'break' or $control eq 'cont')
          {
            warn "$0: line $. of '$property_config_filename' has illegal ",
                 "value for column 3 '$control', must be 'break' or 'cont'.\n";
            $ok = 0;
            next;
          }

        # Compile the regular expression.
        my $re;
        eval { $re = qr/$regex/i };
        if ($@)
          {
            warn "$0: line $. of '$property_config_filename' regex '$regex' ",
                 "does not compile:\n$@\n";
            $ok = 0;
            next;
          }

        push(@property_settings, {name    => $property_name,
                                  value   => $property_value,
                                  control => $control,
                                  re      => $re});
      }
    close(CFG)
      or warn "$0: error in closing '$property_config_filename' for ",
              "reading: $!\n";

    exit 1 unless $ok;
  }

# Check that the svn base URL works by running svn log on it.  Only
# get the HEAD revision log message; there's no need to waste
# bandwidth seeing all of the log messages.
print "Checking that the base URL is a Subversion repository.\n";
read_from_process($svn, 'log', '-r', 'HEAD',
                  @svn_use_repos_cmd_opts, $repos_base_uri);
print "\n";

my $orig_cwd = cwd;

# The first step is to determine the root of the svn repository.  Do
# this with the svn log command.  Take the svn_url hostname and port
# as the initial url and append to it successive portions of the final
# path until svn log succeeds.
print "Finding the root URL of the Subversion repository.\n";
my $repos_root_uri;
my $repos_root_uri_path;
my $repos_base_path_segment;
{
  my $r = $repos_base_uri->clone;
  my @path_segments            = grep { length($_) } $r->path_segments;
  my @repos_base_path_segments = @path_segments;
  unshift(@path_segments, '');
  $r->path('');
  my @r_path_segments;

  while (@path_segments)
    {
      $repos_root_uri_path = shift @path_segments;
      push(@r_path_segments, $repos_root_uri_path);
      $r->path_segments(@r_path_segments);
      if (safe_read_from_pipe($svn, 'log', '-r', 'HEAD',
                              @svn_use_repos_cmd_opts, $r) == 0)
        {
          $repos_root_uri = $r;
          last;
        }
      shift @repos_base_path_segments;
    }
  $repos_base_path_segment = join('/', @repos_base_path_segments);
}

if ($repos_root_uri)
  {
    print "Determined that the svn root URL is $repos_root_uri.\n\n";
  }
else
  {
    die "$0: cannot determine root svn URL.\n";
  }

# Create a temporary directory for svn to work in.
my $temp_dir = tempdir( "svn_load_dirs_XXXXXXXXXX", TMPDIR => 1 );

# Put in a signal handler to clean up any temporary directories.
sub catch_signal {
  my $signal = shift;
  warn "$0: caught signal $signal.  Quitting now.\n";
  exit 1;
}

$SIG{HUP}  = \&catch_signal;
$SIG{INT}  = \&catch_signal;
$SIG{TERM} = \&catch_signal;
$SIG{PIPE} = \&catch_signal;

# Create an object that when DESTROY'ed will delete the temporary
# directory.  The CLEANUP flag to tempdir should do this, but they
# call rmtree with 1 as the last argument which takes extra security
# measures that do not clean up the .svn directories.
my $temp_dir_cleanup = Temp::Delete->new;

# Determine the native end of line style for this system.  Do this the
# most portable way, by writing a file with a single \n in non-binary
# mode and then reading the file in binary mode.
my $native_eol = &determine_native_eol;

# Check if all the directories exist to load the directories into the
# repository.  If not, ask if they should be created.  For tags, do
# not create the tag directory itself, that is done on the svn cp.
{
  print "Finding if any directories need to be created in repository.\n";

  my @dirs_to_create;
  my @urls_to_create;
  my %seen_dir;
  my @load_tags_without_last_segment;

  # Assume that the last portion of the tag directory contains the
  # version number and remove it from the directories to create,
  # because the tag directory will be created by svn cp.
  foreach my $load_tag (sort values %load_tags)
    {
      # Skip this tag if there is only one segment in its name.
      my $index = rindex($load_tag, '/');
      next if $index == -1;

      # Trim off the last segment and record the result.
      push(@load_tags_without_last_segment, substr($load_tag, 0, $index));
    }
  
  foreach my $dir ($repos_load_rel_path, @load_tags_without_last_segment)
    {
      next unless length $dir;
      my $d = '';
      foreach my $segment (split('/', $dir))
        {
          $d = length $d ? "$d/$segment" : $segment;
          my $url = "$repos_base_url/$d";