#!/usr/bin/perl -w

# $HeadURL$

# $LastChangedDate$

# $LastChangedBy$

# $LastChangedRevision$

$| = 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';

# 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;

# Do not automatically set the svn:executable property based on the

# file's exe bit.

my $opt_no_auto_exe;

# 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;

# List of filename patterns to ignore (as in .subversion/config's

# "global-ignores" option).

my $opt_glob_ignores;

# 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,

           'no_auto_exe'             => \$opt_no_auto_exe,

           '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,

           'glob_ignores=s'          => \$opt_glob_ignores)

  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)

  }

# If no glob_ignores specified, try to deduce from config file,

# or use the default below.

my $ignores_str =

    '*.o *.lo *.la #*# .*.rej *.rej .*~ *~ .#* .DS_Store';

if ( defined $opt_glob_ignores)

  {

    $ignores_str = $opt_glob_ignores;

  }

elsif ( -f "$ENV{HOME}/.subversion/config" )

  {

    open my $conf, "$ENV{HOME}/.subversion/config";

    while (<$conf>)

      {

        if ( /^global-ignores\s*=\s*(.*?)\s*$/ )

          {

	    $ignores_str = $1;

            last;

          }

      }

  }

my @glob_ignores = map

                     {

                       s/\./\\\./g; s/\*/\.\*/g; "^$_\$";

                     } split(/\s+/, $ignores_str);

unshift @glob_ignores, '\.svn$';

# 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";

          unless ($seen_dir{$d})

            {

              $seen_dir{$d} = 1;

              if (safe_read_from_pipe($svn, 'log', '-r', 'HEAD',

                                      @svn_use_repos_cmd_opts, $url) != 0)

                {

                  push(@dirs_to_create, $d);

                  push(@urls_to_create, $url);

                }

            }

        }

    }

  if (@dirs_to_create)

    {

      print "The following directories do not exist and need to exist:\n";

      foreach my $dir (@dirs_to_create)

        {

          print "  $dir\n";

        }

      exit 0 unless &get_answer("You must add them now to load the " .

                                "directories.  Continue (Y/n)? ", 'ny', 1);

      my $message = "Create directories to load project into.\n\n";

      foreach my $dir (@dirs_to_create)

        {

          if (length $repos_base_path_segment)

            {

              $message .= "* $repos_base_path_segment/$dir: New directory.\n";

            }

          else

            {

              $message .= "* $dir: New directory.\n";

            }

        }

      $message = wrap('', '  ', $message);

      read_from_process($svn, 'mkdir', @svn_use_repos_cmd_opts,

                        '-m', $message, @urls_to_create);

    }

  else

    {

      print "No directories need to be created to prepare repository.\n";

    }

}

# Either checkout a new working copy from the repository or use an

# existing working copy.

if (defined $opt_existing_wc_dir)

  {

    # Update an already existing working copy.

    print "Not checking out anything; using existing working directory at\n";

    print "$opt_existing_wc_dir\n";

    chdir($opt_existing_wc_dir)

      or die "$0: cannot chdir '$opt_existing_wc_dir': $!\n";

    read_from_process($svn, 'update', @svn_use_repos_cmd_opts);

  }

else

  {

    # Check out the svn repository starting at the svn URL into a

    # fixed directory name.

    my $checkout_dir_name = 'my_import_wc';

    # Check out only the directory being imported to, otherwise the

    # checkout of the entire base URL can be very huge, if it contains

    # a large number of tags.

    my $checkout_url;

    if ($repos_load_rel_path eq '.')

      {

        $checkout_url = $repos_base_url;

      }

    else

      {

        $checkout_url = "$repos_base_url/$repos_load_rel_path";

      }

    print "Checking out $checkout_url into $temp_dir/$checkout_dir_name\n";

    chdir($temp_dir)

      or die "$0: cannot chdir '$temp_dir': $!\n";

    read_from_process($svn, 'checkout',

                      @svn_use_repos_cmd_opts,

                      $checkout_url, $checkout_dir_name);

    chdir($checkout_dir_name)

      or die "$0: cannot chdir '$checkout_dir_name': $!\n";

  }