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. This destination driver will check out the indicated destination in a temporary directory and use it to add, delete, and alter files. =head1 DESCRIPTION =head1 METHODS =over =cut 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::Dest ; use VCP::Rev ; use base 'VCP::Dest' ; use fields ( 'CVS_CVSROOT', ## What to pass using -d. 'CVS_CHANGE_ID', ## The current change_id in the rev_meta sequence, if any ) ; =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 ) = @_ ; my $parsed_spec = $self->parse_repo_spec( $spec ) ; my $files = $parsed_spec->{FILES} ; $self->cvsroot( $parsed_spec->{SERVER} ) ; my $rev_root ; GetOptions( 'r|rev-root' => \$rev_root, ) or $self->usage_and_exit ; if ( defined $rev_root ) { $self->rev_root( $rev_root ) ; } elsif ( defined $files && length $files ) { $self->deduce_rev_root( $files ) ; } ## Make sure the cvs command is available $self->command( 'cvs', '-Q', '-z9' ) ; $self->mkdir( $self->work_path ) ; $self->command_stderr_filter( qr{^(?:cvs (?:server|add|remove): use 'cvs commit' to.*)\n} ) ; return $self ; } sub create_workspace { my VCP::Dest::cvs $self = shift ; confess "Can't create_workspace twice" unless $self->none_seen ; ## establish_workspace $self->rev_root( $self->header->{rev_root} ) unless defined $self->rev_root ; $self->command_chdir( $self->work_path ) ; $self->cvs( [ 'checkout', $self->rev_root ] ) ; $self->work_root( $self->work_path( $self->rev_root ) ) ; $self->command_chdir( $self->work_path ) ; } sub backfill { my VCP::Dest::cvs $self = shift ; my VCP::Rev $r ; ( $r ) = @_ ; $self->create_workspace if $self->none_seen ; #my $fn = join( '', $self->rev_root, "/", $r->name ) ; my $fn = $r->name ; my $work_path = $self->work_path( $fn ) ; debug "vcp: backfilling '$fn', rev ", $r->rev_id if debugging $self ; debug "vcp: work_path '$work_path'" if debugging $self ; my VCP::Rev $saw = $self->seen( $r ) ; die "Can't backfill already seen file '", $r->name, "'" if $saw ; my ( undef, $work_dir ) = fileparse( $work_path ) ; unless ( -d $work_dir ) { $self->mkpdir( $work_path ) ; ( undef, $work_dir ) = fileparse( $fn ) ; } my $tag = "r_" . $r->rev_id ; $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). $self->cvs( [ qw( update -d -p ), -r => $tag, $fn ], '>', $work_path ) ; die "'$work_path' not created in backfill" unless -e $work_path ; $r->work_path( $work_path ) ; return 1 ; } sub cvs { my VCP::Dest::cvs $self = shift ; unshift @{$_[0]}, $self->cvsroot_cvs_option ; return $self->SUPER::cvs( @_ ) ; } sub cvsroot { my VCP::Dest::cvs $self = shift ; $self->{CVS_CVSROOT} = shift if @_ ; return $self->{CVS_CVSROOT} ; } sub cvsroot_cvs_option { my VCP::Dest::cvs $self = shift ; return defined $self->cvsroot ? "-d" . $self->cvsroot : (), } sub handle_rev { my VCP::Dest::cvs $self = shift ; my VCP::Rev $r ; ( $r ) = @_ ; $self->create_workspace if $self->none_seen ; my VCP::Rev $saw = $self->seen( $r ) ; my $fn = $r->name ; my $work_path = $self->work_path( $fn ) ; if ( $r->action eq 'delete' ) { unlink $work_path || die "$! unlinking $work_path" ; $self->cvs( ['remove', $fn] ) ; $self->cvs( ['commit', '-m', $r->comment, $fn] ) ; } else { ## TODO: Don't assume same filesystem or working link(). { my ( undef, $work_dir ) = fileparse( $work_path ) ; unless ( -d $work_dir ) { $self->mkpdir( $work_path ) ; ( undef, $work_dir ) = fileparse( $fn ) ; $self->cvs( ['add', $work_dir] ) ; } if ( -e $work_path ) { unlink $work_path or die "$! unlinking $work_path" ; } 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" ; } else { # warn "vcp: no modification time available for $fn\n" ; } } if ( ! $saw ) { ## New file. $self->cvs( ['add', '-m', $r->comment, $fn] ) ; } ## 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] ) ; ## 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. $self->tag( "r_" . $r->rev_id, $fn ) ; $self->tag( "ch_" . $r->change_id, $fn ) if defined $r->change_id ; $self->tag( $_, $fn ) for $r->labels ; ## TODO: Provide command line options for user-defined tag prefixes } } sub tag { my VCP::Dest::cvs $self = shift ; my $tag = shift ; $tag =~ s/\W+/_/g ; $self->cvs( ['tag', $tag, @_] ) ; } =head1 SUBCLASSING This class uses the fields pragma, so you'll need to use base and possibly fields in any subclasses. =head1 COPYRIGHT Copyright 2000, Perforce Software, Inc. All Rights Reserved. This will be licensed under a suitable license at a future date. Until then, you may only use this for evaluation purposes. Besides which, it's in an early alpha state, so you shouldn't depend on it anyway. =head1 AUTHOR Barrie Slaymaker =cut 1