svn.pm #1

package VCP::Dest::svn ;

=head1 NAME

VCP::Dest::svn - svn destination driver (Not Supported or Ready For Production)

=head1 SYNOPSIS

   vcp <source> svn:<repo_uri>:<dest_dir>
   vcp <source> svn:file:///path/to/repo:/path/to/dir --create-repo

where <repo_uri> is any URI to a repository root that you'd pass to the svn
command and <dest_dir> is the directory or file within that location.

=head1 DESCRIPTION

STATUS: alpha.  This is just good enough to use in VCP's own test
suite.

This driver allows L<vcp|vcp> to insert revisions in to a SVN repository.

If the file:/// repository does not exist and the --create-repo option is
passed, it is created with "svnadmin create".

If <dest_dir> does not exist it is created with "svn mkdir"

See L<VCP::Filter::map|VCP::Filter::map>'s <<branch_to(...)>> action for
a tool that lets you map labels (a.k.a. tags) to svn tag branches via
svn copy.

=head1 OPTIONS

=over

=item --create-repo

Initializes a svn repository in the directory indicated in the svn URL spec
(which must be a scheme supported by svnadmin).  Refuses to init a non-empty
directory.

=item --delete-repo

If C<--create> is passed and the target directory is not empty, it
will be deleted.  THIS IS DANGEROUS AND SHOULD ONLY BE USED IN TEST
ENVIRONMENTS.

=back

=cut

$VERSION = 1 ;

@ISA = qw( VCP::Dest VCP::Utils::svn );

use strict ;

use Carp ;
use File::Basename ;
use File::Path ;
use VCP::Debug qw( :debug );
use VCP::Dest;
use VCP::Logger qw( pr lg pr_doing );
use VCP::RefCountedFile;
use VCP::Rev ;
use VCP::Utils qw( empty is_win32 );
use VCP::Utils::svn qw( RCS_underscorify_tag );

sub new {
   my $self = shift->SUPER::new( @_ ) ;

   ## Parse the options
   my ( $spec, $options ) = @_ ;

   $self->parse_svn_repo_spec( $spec )
      unless empty $spec;

   $self->parse_options( $options );

   return $self ;
}


sub options_spec {
   my $self = shift;
   return (
      $self->SUPER::options_spec,
      "create-repo"  => \$self->{SVN_CREATE_REPO},
      "delete-repo"  => \$self->{SVN_DELETE_REPO},
   );
}


sub sort_filters {
   require VCP::Filter::stringedit;
   return (
      shift->require_change_id_sort( @_ ),
      VCP::Filter::stringedit->new(
         ## A catch-all to prevent illegal file names.  This might
         ## result in filename collisions, but it's probably very much
         ## good enough for 99.9% of the cases.
         ##
         ## The pattern => replacement scheme was suggested by Marc Tooley.
         ##
         ## TODO: implement detection and correction of collisions as
         ## a separate filter.
         "",
         [
            "user_id,name", "*",   "_star_" ,
            "user_id,name", "?",   "_quest_" ,
            "user_id,name", "\@",  "_at_" ,
         ],
      ),
   );
}


sub init {
   my $self = shift;

   ## Set default repo_id.
   $self->repo_id( "svn:" . $self->repo_server )
      if empty $self->repo_id && ! empty $self->repo_server ;

   $self->repo_filespec( $self->repo_filespec . "/..." )
       if $self->repo_filespec =~ m{\A[^/\\]+\z};

   $self->deduce_rev_root( $self->repo_filespec ) ;

   if ( $self->{SVN_CREATE_REPO} ) {
      if ( $self->{SVN_DELETE_REPO} ) {
         $self->rev_map->delete_db;
         $self->head_revs->delete_db;
         $self->files->delete_db;
      }
      $self->create_repo;
   }
   else {
      pr "ignoring --delete-repo, which is only useful with --init-repo"
         if $self->{SVN_DELETE_REPO};
   }

   $self->rev_map->open_db;
   $self->head_revs->open_db;
   $self->files->open_db;

#   $self->command_stderr_filter(
#      qr{^(?:svn (?:server|add|remove): (re-adding|use 'svn commit' to).*)\n}
#   ) ;
}


sub create_repo {
   my $self = shift;

   my $root = $self->repo_server;

   die "svn URI undefined\n"
      unless defined $root;

   die "svn URI is empty string\n"
      if $root eq "";

   die "svn URI must be a \"file:\" URI: \"$root\"\n"
      unless ( my $path = $root ) =~ s{^file://}{}i;

   die "$path is not a dir\n"
      if -e $path && ! -d _;

   my @files;

   @files =  glob "$path/*" if -d $path;

   if ( @files && $self->{SVN_DELETE_REPO} ) {
      require File::Path;
      rmtree [ @files ];
      @files =  glob "$path/*";
   }

   die "cannot svnadmin create non-empty dir $path\n"
      if @files;

   $self->svnadmin( [ qw( create ), $path ] );
}


sub handle_header {
   my $self = shift ;
   my ( $h ) = @_;

   if ( empty( $self->repo_filespec )
      || $self->repo_filespec =~ m{^/*\.\.\.\z}
   ) {
      my $filespec = $h->{rev_root};
      die
      "vcp: no SVN destination module selected and source rev_root is \"\"\n"
         if empty $filespec;

      $self->repo_filespec( $filespec );
      $filespec .= "/...";
      $self->deduce_rev_root( $self->repo_filespec );
   }

   $self->create_svn_workspace(
      create_in_repository => 1,
   ) ;

   $self->{SVN_PENDING_DIRS}    = [] ;
   $self->{SVN_PENDING}         = [] ;
   $self->{SVN_PREV_CHANGE_ID}  = undef ;
   $self->{SVN_LAST_MOD_TIME}   = {} ;

   $self->SUPER::handle_header( @_ ) ;
}


sub checkout_file {
   my $self = shift ;
   my $r ;
   ( $r ) = @_ ;

   lg "$r checking out ", $r->as_string, " from svn dest repo";

   my $fn = $r->name;
   $fn =~ s{^[\\/]+}{};
   my $work_path = $self->work_path( $fn ) ;
   debug "work_path '$work_path'" if debugging;

   my ( undef, $work_dir ) = fileparse( $work_path ) ;
   $self->mkpdir( $work_path ) unless -d $work_dir ;
   my $rev_id = ($self->rev_map->get( [ $r->source_repo_id, $r->id ] ))[1];
   $self->svn(
      [ "update", -r => $rev_id, $fn ],
      \undef,
   ) ;

   die "'$work_path' not created by svn checkout" unless -e $work_path ;

   return $work_path;
}


sub handle_rev {
   my $self = shift ;
   my ( $r ) = @_;

   debug "got ", $r->as_string if debugging;
   my $change_id = $r->change_id;

   $self->commit( "end of change $self->{SVN_PREV_CHANGE_ID} reached" )
   if @{$self->{SVN_PENDING}}
      && $change_id ne $self->{SVN_PREV_CHANGE_ID};

   $self->{SVN_PREV_CHANGE_ID} = $change_id ;
   my $fn = $r->name; ## No need to denormalize; the svn workspace is mapped
                      ## to the appropriate place.
   $fn =~ s{\A[\\\/]+}{};
debug $fn if debugging;

   my $svn_path = $self->repo_filespec . "/" . $fn;

   my $work_path = $self->work_path( $fn ) ;

   if ( $r->is_base_rev ) {
      $self->compare_base_revs( $r, $work_path ) if defined $work_path ;
      pr_doing;
      return;
   }

   if ( $r->action eq 'delete' ) {
#      $self->commit( "time to do a delete" ) if @{$self->{SVN_PENDING}};
      unlink $work_path || die "$! unlinking $work_path" ;
      $self->svn( ["remove", $fn] ) ;
      ## Do this commit by hand since there are no SVN_PENDING revs, which
      ## means $self->commit will not work. It's relatively fast, too.
      push @{$self->{SVN_PENDING}}, $r;
      $self->files->set( [ $svn_path ], "deleted" );
      pr_doing;
   }
   else {
      ## TODO: Move this in to commit().
      {
	 my ( undef, $rel_work_dir, undef ) = File::Spec->splitpath( $fn ) ;
         my @dirs = File::Spec->splitdir( $rel_work_dir );
         my @cur_dirs;
         shift @dirs while @dirs && !length $dirs[0];
         while ( @dirs ) {
            push @cur_dirs, shift @dirs;
            my $cur_path = $self->work_path( @cur_dirs );
            next if -e $cur_path;
            my $rel_cur_path = join "/", @cur_dirs;
            lg "\$ mkdir $rel_cur_path";
            mkpath [ $cur_path ], 0, 0770;
            lg "\$ svn add $rel_cur_path";
            $self->svn( ["add", $rel_cur_path ] );
            push @{$self->{SVN_PENDING_DIRS}}, $rel_cur_path;
	 }
      }

      my $branch_id = $r->branch_id;
      $branch_id = "" unless defined $branch_id;
      ## See if this should be the main branch for this file.

      if ( $r->is_placeholder_rev ) {
         if ( $r->is_branch_rev ) {
            ## Note: this ignores clones of branch revs.
            my $branch_tag = RCS_underscorify_tag $branch_id;

            my $from_id = $r->from_id;
            $from_id = $r->previous_id if empty $from_id;
            my ( $psvn_name, $prev_id ) =
               $self->rev_map->get( [ $r->source_repo_id, $from_id ] );

            # create the new branch.
            my $repo_spec = $self->repo_server;
            $self->svn(
               [ "copy", "$repo_spec/$psvn_name", "-r" . $prev_id, $fn ]
            );
            $self->files->set( [ $svn_path ], "branched" );
            push @{$self->{SVN_PENDING}}, $r;
         }

         pr_doing;
         return;
      }

      ## TODO: Don't assume same filesystem or working link().
      ## TODO: Batch these.
      $self->{SVN_FILES}->{$r->id} = VCP::RefCountedFile->new( $work_path ) ;
      my $source_fn = $r->get_source_file;

      if ( $source_fn ne $work_path ) {
          debug "linking $source_fn to $work_path"
             if debugging;

          unlink $work_path if -e $work_path;

          link $source_fn, $work_path
             or die "$! linking '$source_fn' -> '$work_path'" ;
      }

      if ( defined $r->mod_time ) {
         utime $r->mod_time, $r->mod_time, $work_path
            or die "$! changing times on $work_path" ;
      }

      my ( $acc_time, $mod_time ) = (stat( $work_path ))[8,9] ;
      while (
         ( $self->{SVN_LAST_MOD_TIME}->{$work_path} || 0 ) == $mod_time
      ) {
         lg "tweaking mod_time on '$work_path' from ",
             "".localtime $mod_time,
             " to ",
             "".localtime $mod_time + 1,
             " at ",
             "".localtime;
         ++$mod_time ;
         utime $acc_time, $mod_time, $work_path
            or die "$! changing times on $work_path" ;
      }
      $self->{SVN_LAST_MOD_TIME}->{$work_path} = $mod_time ;
      my @file_state = $self->files->get( [ $svn_path ] );

      unless ( @file_state && $file_state[0] ne "deleted" ) {
         ## New file.
         $self->svn( [ "add", $fn ] ) ;
         $self->files->set( [ $svn_path ], "added" );
      }
      else {
         ## Change the existing file (no need to tell svn this)
      }

      push @{$self->{SVN_PENDING}}, $r ;
  }

}


sub handle_footer {
   my $self = shift ;

   $self->commit( "end of transfer" )
       if $self->{SVN_PENDING} && @{$self->{SVN_PENDING}} ;#|| $self->{SVN_DELETES_PENDING} ;

   delete $self->{SVN_FILES};
   $self->SUPER::handle_footer ;
}


sub comment_option {
   ## Packages the comment in an acceptable form on Win32 or Unix.
   ## returns the appropriate svn command line options.
   my $self = shift;
   my $comment = shift;

   return ( "-m", "" ) if empty $comment;

   return ( "-m", $comment ) unless is_win32;

   ## Win32 shell must be avoided at all costs.

   my $cfn = $self->work_path( "comment.txt" ) ;
   open COMMENT, ">$cfn"    or die "$!: $cfn";
   print COMMENT $comment   or die "$!: $cfn";
   close COMMENT            or die "$!: $cfn";

   return ( "-F$cfn" );
}


sub commit {
   my $self = shift ;

   lg "committing: ", @_;

   return unless @{$self->{SVN_PENDING}} ;

   ## All comments should be the same, since we alway commit when the 
   ## comment changes.
   my $comment = do {
      my %seen_comments;
      join "",
         map
            ! length $_ || substr( $_, -1 ) eq "\n" ? $_ : "$_\n",
            grep !$seen_comments{$_}++,
            map $_->comment,
            @{$self->{SVN_PENDING}};
   };


   my $commit_log;
   $self->svn(
       ["commit", $self->comment_option( $comment ) ],
       undef,
       \$commit_log
   );

   lg $commit_log if $commit_log =~ /\S/;

   my ( $svn_rev_id ) = $commit_log =~ /Committed revision (\d+)/
       or die "No \"Committed revision\" string found in:\n",
               $commit_log;

   for my $r ( @{$self->{SVN_PENDING}} ) {
      my $name = $r->name;
      $name =~ s{^[\\/]+}{};
      $self->rev_map->set(
          [ $r->source_repo_id, $r->id ],
          $self->repo_filespec . "/" . $name,
          $svn_rev_id
      );

      $self->head_revs->set(
         [ $r->source_repo_id, $r->source_filebranch_id ],
         $r->source_rev_id, $r->action
      );
   }
   
   $commit_log = undef;

   ## Allow Perl GC and $r->DESTROY to clean up the filesystem and
   ## throw away the source file.
   for my $r ( @{$self->{SVN_PENDING}} ) {
      pr_doing;
   }

   @{$self->{SVN_PENDING}} = () ;
   @{$self->{SVN_PENDING_DIRS}} = ();
}


=head1 LIMITATIONS

Does not handle "clone" revisions properly.  "clone" revisions are
generated by L<VCP::Source::svn|VCP::Source::svn> when a branch is given
two branch tags.  See L<VCP::Source::svn|VCP::Source::svn> for more
details.

Does not guarantee that the source repository's mod_time will be applied
because subversion seems to assume that, if the size and mod_time have
not changed, the file has not changed.  So this driver bumps the
mod_time if it sees an edit to a file with the same mod_time
as the last edit.

TODO: determine the valid charset for filenames and for usernames.

TODO: use the --force-log option when appropriate.

TODO: Allow use of SVN::* or other libraries if present.  The current
method of shelling out to the "svn" program is very slow and doesn't
allow for modifying date/time and user (so far as I can see--perhaps
there's a property that can be edited on the changeset, not sure).

=head1 AUTHOR

Barrie Slaymaker <barries@slaysys.com>

=head1 COPYRIGHT

Copyright (c) 2000, 2001, 2002 Perforce Software, Inc.
All rights reserved.

See L<VCP::License|VCP::License> (C<vcp help license>) for the terms of use.

=cut

1