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 =over =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, 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 ) = @_; unless ( $spec =~ /\A\w+::/ ) { $self->parse_repo_spec( @_ ) unless $spec =~ /\A\w+::/; } else { 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 ); } my $filespec = $self->repo_filespec; $filespec =~ s(/{2,})(/)g; $filespec =~ s(\\{2,})(\\)g; $self->repo_filespec( $filespec ); debug "vcp: parsed '$spec' as", " scheme=", $self->repo_scheme, " server=", $self->repo_server, " filespec=", $self->repo_filespec if debugging $self; 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 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" if $self->revs->get ; ## 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->repo_filespec; die "Empty cvs module spec\n" unless defined $module and length $module ; ## if the server contains a username we must log in if ( ( $self->repo_server || "" ) =~ /^:[^:]+:[^:]*(?::([^:]*))?\@/ ) { my $password = defined $1 ? $1 : ""; $self->cvs( ["login"], \$password ); } 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" ) ) ; } =back =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. =cut 1 ;