package VCP::Dest::cvs ; =head1 NAME VCP::Dest::cvs - cvs destination driver =head1 SYNOPSIS vcp cvs:module vcp cvs:CVSROOT:module where module is a module or directory that already exists within CVS. =head1 DESCRIPTION Checks out the indicated module or directory in to a temporary directory and use it to add, delete, and alter files. If the module does not exists, uses "cvs import" to create it. This driver allows L to insert revisions in to a CVS repository. There are no options at this time. TODO: Skip all directories named "CVS", in case a CVS tree is being imported. Perhaps make it fatal, but use an option to allow it. In this case, CVS directories can be detected by scanning revs before doing anything. =cut $VERSION = 1 ; use strict ; use vars qw( $debug ) ; $debug = 0 ; use Carp ; use File::Basename ; use File::Path ; use Getopt::Long ; use VCP::Debug ':debug' ; use VCP::Rev ; use base qw( VCP::Dest VCP::Utils::cvs ) ; use fields ( 'CVS_CHANGE_ID', ## The current change_id in the rev_meta sequence, if any 'CVS_LAST_MOD_TIME', ## A HASH keyed on working files of the mod_times of ## the previous revisions of those files. This is used ## to make sure that new revision get a different mod_time ## so that CVS never thinks that a new revision hasn't ## changed just because the VCP::Source happened to create ## two files with the same mod_time. 'CVS_PENDING_COMMAND', ## "add" or "edit" 'CVS_PENDING', ## Revs to be committed ## These next fields are used to detect changes between revs that cause a ## commit. Commits are batched for efficiency's sake. 'CVS_PREV_CHANGE_ID', ## Change ID of previous rev 'CVS_PREV_COMMENT', ## Revs to be committed 'CVS_LAST_SEEN', ## HASH of last seen revisions, keyed by name ) ; ## Optimization note: The slowest thing is the call to "cvs commit" when ## something's been added or altered. After all the changed files have ## been checked in by CVS, there's a huge pause (at least with a CVSROOT ## on the local filesystem). So, we issue "cvs add" whenever we need to, ## but we queue up the files until a non-add is seem. Same for when ## a file is edited. This preserves the order of the files, without causing ## lots of commits. Note that we commit before each delete to make sure ## that the order of adds/edits and deletes is maintained. #=item new # #Creates a new instance of a VCP::Dest::cvs. Contacts the cvsd using the cvs #command and gets some initial information ('cvs info' and 'cvs labels'). # #=cut sub new { my $class = shift ; $class = ref $class || $class ; my VCP::Dest::cvs $self = $class->SUPER::new( @_ ) ; ## Parse the options my ( $spec, $options ) = @_ ; $self->parse_cvs_repo_spec( $spec ) ; $self->deduce_rev_root( $self->repo_filespec ) ; my $init_cvsroot; { local *ARGV = $options ; GetOptions( "init-cvsroot" => \$init_cvsroot, ) or $self->usage_and_exit ; } $self->command_stderr_filter( qr{^(?:cvs (?:server|add|remove): (re-adding|use 'cvs commit' to).*)\n} ) ; $self->init_cvsroot if $init_cvsroot; return $self ; } sub init_cvsroot { my VCP::Dest::cvs $self = shift; my $root = $self->cvsroot; die "vcp: cvsroot not specified\n" if substr( $root, 0, 1 ) eq ":"; die "vcp: cannot cvs init non local root $root\n" if substr( $root, 0, 1 ) eq ":"; die "vcp: cannot cvs init non-empty dir $root\n" if -d $root && glob "$root/*"; $self->cvs( [ qw( init ) ], in_dir => $root ); } sub handle_header { my VCP::Dest::cvs $self = shift ; debug "vcp: first rev" if debugging $self ; $self->rev_root( $self->header->{rev_root} ) unless defined $self->rev_root ; $self->create_cvs_workspace( create_in_repository => 1, ) ; $self->{CVS_PENDING_COMMAND} = "" ; $self->{CVS_PENDING} = [] ; $self->{CVS_PREV_COMMENT} = undef ; $self->{CVS_PREV_CHANGE_ID} = undef ; $self->SUPER::handle_header( @_ ) ; } sub checkout_file { my VCP::Dest::cvs $self = shift ; my VCP::Rev $r ; ( $r ) = @_ ; debug "vcp: $r checking out ", $r->as_string, " from cvs dest repo" if debugging $self ; my $fn = $self->denormalize_name( $r->name ); my $work_path = $self->work_path( $fn ) ; debug "vcp: work_path '$work_path'" if debugging $self ; $self->{CVS_LAST_SEEN}->{$r->name} = $r; my ( undef, $work_dir ) = fileparse( $work_path ) ; $self->mkpdir( $work_path ) unless -d $work_dir ; my $tag = "r_" . $r->rev_id ; $tag =~ s/\W+/_/g ; my $b_suffix = $r->branch_id; $b_suffix = defined $b_suffix && length $b_suffix ? "_$b_suffix" : ""; $tag .= $b_suffix; $tag =~ s/^([^a-zA-Z])/tag_$1/ ; $tag =~ s/\W/_/g ; ## Ok, the tricky part: we need to use a tag, but we don't want it ## to be sticky, or we get an error the next time we commit this ## file, since the tag is not likely to be a branch revision. ## Apparently the way to do this is to print it to stdout on update ## (or checkout, but we used update so it works with a $fn relative ## to the cwd, ie a $fn with no module name first). ## The -kb is a hack to get the tests to pass on Win32, where \n ## becomes \r\n on checkout otherwise. TODO: figure out what is ## the best thing to do. We might try it without the -kb, then ## if the digest check fails, try it again with -kb. Problem is ## that said digest check occurs in VCP/Source/revml, not here, ## so we need to add a "can retry" return result to the API and ## modify the Sources to use it if a digest check fails. $self->cvs( [ qw( update -d -kb -p ), -r => $tag, $fn ], '>', $work_path ) ; die "'$work_path' not created by cvs checkout" unless -e $work_path ; return $work_path; } sub handle_rev { my VCP::Dest::cvs $self = shift ; my VCP::Rev $r ; ( $r ) = @_ ; if ( ( @{$self->{CVS_PENDING}} )#|| $self->{CVS_DELETES_PENDING} ) && ( @{$self->{CVS_PENDING}} > 25 ## Limit command line length || ( defined $r->change_id && defined $self->{CVS_PREV_CHANGE_ID} && $r->change_id ne $self->{CVS_PREV_CHANGE_ID} && ( debugging( $self ) ? debug "vcp: change_id changed" : 1 ) ) || ( defined $r->comment && defined $self->{CVS_PREV_COMMENT} && $r->comment ne $self->{CVS_PREV_COMMENT} && ( debugging( $self ) ? debug "vcp: comment changed" : 1 ) ) || ( grep( $r->name eq $_->name, @{$self->{CVS_PENDING}} ) && ( debugging( $self ) ? debug "vcp: name repeated" : 1 ) ) ) ) { debug "vcp: committing on general principles" if debugging $self ; $self->commit ; } $self->compare_base_revs( $r ) if $r->is_base_rev && defined $r->work_path ; return if $r->is_base_rev ; my $fn = $self->denormalize_name( $r->name ) ; my $work_path = $self->work_path( $fn ) ; if ( $r->action eq 'delete' ) { $self->commit ; unlink $work_path || die "$! unlinking $work_path" ; $self->cvs( ['remove', $fn] ) ; ## Do this commit by hand since there are no CVS_PENDING revs, which ## means $self->commit will not work. It's relatively fast, too. $self->cvs( ['commit', '-m', $r->comment || '', $fn] ) ; delete $self->{CVS_LAST_SEEN}->{$r->name}; } else { ## TODO: Move this in to commit(). { my ( $vol, $work_dir, undef ) = File::Spec->splitpath( $work_path ) ; unless ( -d $work_dir ) { my @dirs = File::Spec->splitdir( $work_dir ) ; my $this_dir = shift @dirs ; my $base_dir = File::Spec->catpath( $vol, $this_dir, "" ) ; do { ## Warn: MacOS danger here: "" is like Unix's "..". Shouldn't ## ever be a problem, we hope. if ( length $base_dir && ! -d $base_dir ) { $self->mkdir( $base_dir ) ; ## We dont' queue these to a PENDING because these ## should be pretty rare after the first checkin. Could ## have a modal CVS_PENDING with modes like "add", "remove", ## etc. and commit whenever the mode's about to change, ## I guess. $self->cvs( ["add", $base_dir] ) ; } $this_dir = shift @dirs ; $base_dir = File::Spec->catdir( $base_dir, $this_dir ) ; } while @dirs ; } } my $last_seen = $self->{CVS_LAST_SEEN}->{$r->name}; $self->{CVS_LAST_SEEN}->{$r->name} = $r; my $switch_branches = $last_seen && ( ( $last_seen->branch_id || "" ) ne ( $r->branch_id || "" ) ); $self->commit if $switch_branches; unlink $work_path or die "$! unlinking $work_path" if -e $work_path; if ( $switch_branches ) { if ( substr( $r->rev_id, -2 ) eq ".1" ) { ## This rev is the first of its branch. Not sure if it's ## the same as the base revision or not, so play it safe and ## check it in. die "No base revision seen for ", $r->as_string unless $last_seen; $self->cvs( [ "rtag", "-b", "-r" . $last_seen->rev_id, $r->branch_id, $fn ] ); } if ( defined $r->branch_id && length $r->branch_id ) { $self->cvs( [ "update", "-r", $r->branch_id, $fn ] ); } else { $self->cvs( [ "update", "-A", $fn ] ); } unlink $work_path or die "$! unlinking $work_path" if -e $work_path; } debug "vcp: linking ", $r->work_path, " to $work_path" if debugging $self ; ## TODO: Don't assume same filesystem or working link(). link $r->work_path, $work_path or die "$! linking '", $r->work_path, "' -> $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] ; if ( ( $self->{CVS_LAST_MOD_TIME}->{$work_path} || 0 ) == $mod_time ) { ++$mod_time ; debug "vcp: tweaking mod_time on '$work_path'" if debugging $self ; utime $acc_time, $mod_time, $work_path or die "$! changing times on $work_path" ; } $self->{CVS_LAST_MOD_TIME}->{$work_path} = $mod_time ; $r->dest_work_path( $fn ) ; if ( ! $last_seen ) { ## New file. my @bin_opts = $r->type ne "text" ? "-kb" : () ; $self->commit if $self->{CVS_PENDING_COMMAND} ne "add" ; $self->cvs( [ "add", @bin_opts, "-m", $r->comment || '', $fn ] ) ; $self->{CVS_PENDING_COMMAND} = "add" ; } else { ## Change the existing file $self->commit if $self->{CVS_PENDING_COMMAND} ne "edit" ; $self->{CVS_PENDING_COMMAND} = "edit" ; } # ## TODO: batch the commits when the comment changes or we see a # ## new rev for a file with a pending commit.. # $self->cvs( ['commit', '-m', $r->comment || '', $fn] ) ; # debug "$r pushing ", $r->dest_work_path if debugging $self ; push @{$self->{CVS_PENDING}}, $r ; } $self->{CVS_PREV_CHANGE_ID} = $r->change_id ; $self->{CVS_PREV_COMMENT} = $r->comment ; } sub handle_footer { my VCP::Dest::cvs $self = shift ; $self->commit if $self->{CVS_PENDING} && @{$self->{CVS_PENDING}} ;#|| $self->{CVS_DELETES_PENDING} ; $self->SUPER::handle_footer ; } sub commit { my VCP::Dest::cvs $self = shift ; return unless @{$self->{CVS_PENDING}} ; ## All comments should be the same, since we alway commit when the ## comment changes. my $comment = $self->{CVS_PENDING}->[0]->comment || '' ; ## @names was originally to try to convince cvs to commit things in the ## preferred order. No go: cvs chooses some order I can't fathom without ## reading it's source code. I'm leaving this in for now to keep cvs ## from having to scan the working dirs for changes, which may or may ## not be happening now (need to check at some point). my @names = map $_->dest_work_path, @{$self->{CVS_PENDING}} ; $self->cvs( ['commit', '-m', $comment, @names ] ) ; for my $r ( @{$self->{CVS_PENDING}} ) { ## TODO: Don't rtag it with r_ if it gets the same rev number from the ## commit. ## TODO: Batch files in to the rtag command, esp. for change number tags, ## for performance's sake. ## TODO: batch tags, too. my $b_suffix = $r->branch_id; $b_suffix = defined $b_suffix && length $b_suffix ? "_$b_suffix" : ""; my @tags = map { s/^([^a-zA-Z])/tag_$1/ ; s/\W/_/g ; $_ ; }( defined $r->rev_id ? "r_" . $r->rev_id . $b_suffix : (), defined $r->change_id ? "ch_" . $r->change_id . $b_suffix : (), $r->labels, ) ; $self->tag( $_, $r->dest_work_path ) for @tags ; ## TODO: Provide command line options for user-defined tag prefixes } @{$self->{CVS_PENDING}} = () ; $self->{CVS_PENDING_COMMAND} = "" ; } sub tag { my VCP::Dest::cvs $self = shift ; my $tag = shift ; $tag =~ s/\W+/_/g ; $self->cvs( ['tag', $tag, @_] ) ; } =head1 AUTHOR Barrie Slaymaker =head1 COPYRIGHT Copyright (c) 2000, 2001, 2002 Perforce Software, Inc. All rights reserved. See L (C) for the terms of use. =cut 1