svn_load_dirs.pl.in

来自「subversion-1.4.5.tar.gz 配置svn的源码」· IN 代码 · 共 1,992 行 · 第 1/5 页

        {
          $file_digest = &digest_hash_file($_);
        }
      $files{$_} = {type   => $file_type,
                    digest => $file_digest};
    };
  find({no_chdir   => 1,
        preprocess => sub { grep { $_ !~ /^[._]svn$/ } @_ },
        wanted     => $wanted
       }, '.');

  chdir($return_cwd)
    or die "$0: cannot chdir '$return_cwd': $!\n";

  %files;
}

# Given a list of files and directories which have been renamed but
# not commtited, commit them with a proper log message.
sub commit_renames
{
  unless (@_ == 4)
    {
      croak "$0: commit_renames $INCORRECT_NUMBER_OF_ARGS";
    }

  my $load_dir          = shift;
  my $renamed_filenames = shift;
  my $rename_from_files = shift;
  my $rename_to_files   = shift;

  my $number_renames    = @$renamed_filenames/2;

  my $message = "To prepare to load $load_dir into $repos_load_abs_path, " .
                "perform $number_renames rename" .
                ($number_renames > 1 ? "s" : "") . ".\n";

  # Text::Wrap::wrap appears to replace multiple consecutive \n's with
  # one \n, so wrap the text and then append the second \n.
  $message  = wrap("", "", $message) . "\n";
  while (@$renamed_filenames)
    {
      my $from  = "$repos_load_abs_path/" . shift @$renamed_filenames;
      my $to    = "$repos_load_abs_path/" . shift @$renamed_filenames;
      $message .= wrap("", "  ", "* $to: Renamed from $from.\n");
    }

  # Change to the top of the working copy so that any
  # directories will also be updated.
  my $cwd = cwd;
  chdir($wc_import_dir_cwd)
    or die "$0: cannot chdir '$wc_import_dir_cwd': $!\n";
  read_from_process($svn, 'commit', @svn_use_repos_cmd_opts, '-m', $message);
  read_from_process($svn, 'update', @svn_use_repos_cmd_opts);
  chdir($cwd)
    or die "$0: cannot chdir '$cwd': $!\n";

  # Some versions of subversion have a bug where renamed files
  # or directories are not deleted after a commit, so do that
  # here.
  my @del_files = sort {length($b) <=> length($a) || $a cmp $b }
                  keys %$rename_from_files;
  rmtree(\@del_files, 1, 0);

  # Empty the list of old and new renamed names.
  undef %$rename_from_files;
  undef %$rename_to_files;
}

# Take a one file or directory and see if its name is equal to a
# second or is contained in the second if the second file's file type
# is a directory.
sub contained_in
{
  unless (@_ == 3)
    {
      croak "$0: contain_in $INCORRECT_NUMBER_OF_ARGS";
    }

  my $contained      = shift;
  my $container      = shift;
  my $container_type = shift;

  if ($container eq $contained)
    {
      return 1;
    }

  if ($container_type eq 'd')
    {
      my $dirname        = "$container/";
      my $dirname_length = length($dirname);

      if ($dirname_length <= length($contained) and
          $dirname eq substr($contained, 0, $dirname_length))
        {
          return 1;
        }
    }

  return 0;
}

# Take an array reference containing a list of files and directories
# and take a hash reference and remove from the array reference any
# files and directories and the files the directory contains listed in
# the hash.
sub filter_renamed_files
{
  unless (@_ == 2)
    {
      croak "$0: filter_renamed_files $INCORRECT_NUMBER_OF_ARGS";
    }

  my $array_ref = shift;
  my $hash_ref  = shift;

  foreach my $remove_filename (keys %$hash_ref)
    {
      my $remove_file_type = $hash_ref->{$remove_filename}{type};
      for (my $i=0; $i<@$array_ref;)
        {
          if (contained_in($array_ref->[$i],
                           $remove_filename,
                           $remove_file_type))
            {
              splice(@$array_ref, $i, 1);
              next;
            }
          ++$i;
        }
    }
}

# Get a digest hash of the specified filename.
sub digest_hash_file
{
  unless (@_ == 1)
    {
      croak "$0: digest_hash_file $INCORRECT_NUMBER_OF_ARGS";
    }

  my $filename = shift;

  my $ctx = Digest::MD5->new;
  if (open(READ, $filename))
    {
      binmode READ;
      $ctx->addfile(*READ);
      close(READ);
    }
  else
    {
      die "$0: cannot open '$filename' for reading: $!\n";
    }
  $ctx->digest;
}

# Read standard input until a line contains the required input or an
# empty line to signify the default answer.
sub get_answer
{
  unless (@_ == 3)
    {
      croak "$0: get_answer $INCORRECT_NUMBER_OF_ARGS";
    }

  my $message = shift;
  my $answers = shift;
  my $def_ans = shift;

  return $def_ans if $opt_no_user_input;

  my $char;
  do
    {
      print $message;
      $char = '';
      my $line = <STDIN>;
      if (defined $line and length $line)
        {
          $char = substr($line, 0, 1);
          $char = '' if $char eq "\n";
        }
    } until $char eq '' or $answers =~ /$char/ig;

  return $def_ans if $char eq '';
  return pos($answers) - 1;
}

# Determine the native end of line on this system by writing a \n in
# non-binary mode to an empty file and reading the same file back in
# binary mode.
sub determine_native_eol
{
  my $filename = "$temp_dir/svn_load_dirs_eol_test.$$";
  if (-e $filename)
    {
      unlink($filename)
        or die "$0: cannot unlink '$filename': $!\n";
    }

  # Write the \n in non-binary mode.
  open(NL_TEST, ">$filename")
    or die "$0: cannot open '$filename' for writing: $!\n";
  print NL_TEST "\n";
  close(NL_TEST)
    or die "$0: error in closing '$filename' for writing: $!\n";

  # Read the \n in binary mode.
  open(NL_TEST, $filename)
    or die "$0: cannot open '$filename' for reading: $!\n";
  binmode NL_TEST;
  local $/;
  undef $/;
  my $eol = <NL_TEST>;
  close(NL_TEST)
    or die "$0: cannot close '$filename' for reading: $!\n";
  unlink($filename)
    or die "$0: cannot unlink '$filename': $!\n";

  my $eol_length = length($eol);
  unless ($eol_length)
    {
      die "$0: native eol length on this system is 0.\n";
    }

  print "Native EOL on this system is ";
  for (my $i=0; $i<$eol_length; ++$i)
    {
      printf "\\%03o", ord(substr($eol, $i, 1));
    }
  print ".\n\n";

  $eol;
}

# Take a filename, open the file and replace all CR, CRLF and LF's
# with the native end of line style for this system.
sub convert_file_to_native_eol
{
  unless (@_ == 1)
    {
      croak "$0: convert_file_to_native_eol $INCORRECT_NUMBER_OF_ARGS";
    }

  my $filename = shift;
  open(FILE, $filename)
    or die "$0: cannot open '$filename' for reading: $!\n";
  binmode FILE;
  local $/;
  undef $/;
  my $in = <FILE>;
  close(FILE)
    or die "$0: error in closing '$filename' for reading: $!\n";
  my $out = '';

  # Go through the file and transform it byte by byte.
  my $i = 0;
  while ($i < length($in))
    {
      my $cc = substr($in, $i, 2);
      if ($cc eq "\015\012")
        {
          $out .= $native_eol;
          $i += 2;
          next;
        }

      my $c = substr($cc, 0, 1);
      if ($c eq "\012" or $c eq "\015")
        {
          $out .= $native_eol;
        }
      else
        {
          $out .= $c;
        }
      ++$i;
    }

  return 0 if $in eq $out;

  my $tmp_filename = ".svn/tmp/svn_load_dirs.$$";
  open(FILE, ">$tmp_filename")
    or die "$0: cannot open '$tmp_filename' for writing: $!\n";
  binmode FILE;
  print FILE $out;
  close(FILE)
    or die "$0: cannot close '$tmp_filename' for writing: $!\n";
  rename($tmp_filename, $filename)
    or die "$0: cannot rename '$tmp_filename' to '$filename': $!\n";

  return 1;
}

# Split the input line into words taking into account that single or
# double quotes may define a single word with whitespace in it.
sub split_line
{
  unless (@_ == 1)
    {
      croak "$0: split_line $INCORRECT_NUMBER_OF_ARGS";
    }

  my $line = shift;

  # Strip leading whitespace.  Do not strip trailing whitespace which
  # may be part of quoted text that was never closed.
  $line =~ s/^\s+//;

  my $line_length  = length $line;
  my @words        = ();
  my $current_word = '';
  my $in_quote     = '';
  my $in_protect   = '';
  my $in_space     = '';
  my $i            = 0;

  while ($i < $line_length)
    {
      my $c = substr($line, $i, 1);
      ++$i;

      if ($in_protect)
        {
          if ($c eq $in_quote)
            {
              $current_word .= $c;
            }
          elsif ($c eq '"' or $c eq "'")
            {
              $current_word .= $c;
            }
          else
            {
              $current_word .= "$in_protect$c";
            }
          $in_protect = '';
        }
      elsif ($c eq '\\')
        {
          $in_protect = $c;
        }
      elsif ($in_quote)
        {
          if ($c eq $in_quote)
            {
              $in_quote = '';
            }
          else
            {
              $current_word .= $c;
            }
        }
      elsif ($c eq '"' or $c eq "'")
        {
          $in_quote = $c;
        }
      elsif ($c =~ m/^\s$/)
        {
          unless ($in_space)
            {
              push(@words, $current_word);
              $current_word = '';
            }
        }
      else
        {
          $current_word .= $c;
        }

      $in_space = $c =~ m/^\s$/;
    }

  # Handle any leftovers.
  $current_word .= $in_protect if $in_protect;
  push(@words, $current_word) if length $current_word;

  @words;
}

# This package exists just to delete the temporary directory.
package Temp::Delete;

sub new
{
  bless {}, shift;
}

sub DESTROY
{
  print "Cleaning up $temp_dir\n";
  File::Path::rmtree([$temp_dir], 0, 0);
}