cvs.pm #5

package VCP::Utils::cvs ;

=head1 NAME

VCP::Utils::cvs - utilities for dealing with the cvs command

=head1 SYNOPSIS

   use VCP::Utils::cvs ;

=head1 DESCRIPTION

A mix-in class providing methods shared by VCP::Source::cvs and VCP::Dest::cvs,
mostly wrappers for calling the cvs command.

=cut

use strict ;

use Carp ;
use VCP::Debug qw( debug debugging ) ;
use File::Spec ;
use File::Temp qw( mktemp ) ;
use POSIX ":sys_wait_h" ;

=head1 METHODS

=item cvs

Calls the cvs command with the appropriate cvsroot option.

=cut

sub cvs {
   my $self = shift ;

   my $args = shift ;

   unshift @$args, "-d" . $self->repo_server
      if defined $self->repo_server;

   return $self->run_safely( [ qw( cvs -Q -z9 ), @$args ], @_ ) ;
}

=item parse_cvs_repo_spec

This handles ":pserver:"-like type repository specs specially, defaulting to
normal processing if the scheme is not followed by something like "foo".  The
username and password are parsed out of the spec

If the first colon is followed by a colon, like

   cvs::pserver:user@server/foo:bar

, then the special processing kicks in and the spec is parsed accordingly.
Everything up to and including the first colon and starting with the last colon
are stripped, just like with L<normal specs|VCP::Plugin/parse_repo_spec>, and
the remainder becomes the CVSROOT.  This does have the side effect of
plaintexting the password in various CVS places (like the local CVS directories
and the command lines that VCP forks to launch CVS).  Let me know if you need
this changed.

=cut

sub parse_cvs_repo_spec {
   my $self = shift;

   my ( $spec ) = @_;

   return $self->parse_repo_spec( @_ ) unless $spec =~ /\A\w+::/;

   my ( $scheme, $cvs_root, $filespec ) = ( $spec =~ /\A([^:]*):(.*):([^:]*)\z/ )
       or die "Can't parse CVS remote file spec '$spec'\n";

   $self->repo_scheme( $scheme );
   $self->repo_server( $cvs_root );
   $self->repo_filespec( $filespec );
   die "parse_cvs_repo_spec does not return a result" if defined wantarray;
}

=item create_cvs_workspace

    $self->create_cvs_workspace;
    $self->create_cvs_workspace( create_in_repository => 1 );

Creates a temp dir named "co" for C<cvs> to work in, checks out the module
there, and sets the work root and cvs working dir to that directory.

=cut

sub create_cvs_workspace {
   my $self = shift ;
   my %options = @_;

   confess "Can't create_workspace twice" unless $self->none_seen ;

   ## establish_workspace in a directory named "co" for "checkout". This is
   ## so that VCP::Source::cvs can use a different directory to contain
   ## the revs, since all the revs need to be kept around until the VCP::Dest
   ## is through with them.
   $self->command_chdir( $self->tmp_dir( "co" ) ) ;
   my $module = $self->rev_root;
   die "Empty cvs module spec\n"
      unless defined $module and length $module ;

   my @expect_cannot_find_module = (
      stderr_filter => qr/cvs checkout: cannot find module .*\n/,
      ok_result_codes => [0,1],
   );

   $self->cvs(
      [ "checkout", $module ],
      $options{create_in_repository}
         ? @expect_cannot_find_module
         : (
            ok_result_codes => [0],  ## Shouldn't be needed, but Just In Case
         ),
   ) ;

   if ( $self->command_result_code == 1 ) {
      my $empty_dir = $self->tmp_dir( "empty_dir" );
      $self->mkdir( $empty_dir );
      $self->cvs(
         [
            "import",
            "-m",
            "VCP destination directory creation",
            $module,
            "vcp",
            "start"
         ]
      );

      $self->cvs( [ "checkout", $module ] ) ;
   }

   $self->work_root( $self->tmp_dir( "co" ) ) ;
   $self->command_chdir( $self->tmp_dir( "co" ) ) ;
}


=head1 COPYRIGHT

Copyright 2000, Perforce Software, Inc.  All Rights Reserved.

This module and the VCP package are licensed according to the terms given in
the file LICENSE accompanying this distribution, a copy of which is included in
L<vcp>.

=cut

1 ;