package VCP::Source ; =head1 NAME VCP::Source - A base class for repository sources =head1 SYNOPSIS =head1 DESCRIPTION =head1 EXTERNAL METHODS =over =cut use strict ; use Carp ; use UNIVERSAL qw( isa ) ; use VCP::Debug qw( :debug ) ; use VCP::Logger qw( lg ); use vars qw( $VERSION ) ; $VERSION = 0.1 ; use base 'VCP::Plugin' ; use fields ( 'BOOTSTRAP_REGEXPS', ## Determines what files are in bootstrap mode. 'DEST', 'CONTINUE', ## Set if we're resuming from the prior ## copy operation, if there is one. This causes ## us to determine a minimum rev by asking the ## destination what it's seen on a given filebranch ) ; =item new Creates an instance, see subclasses for options. The options passed are usually native command-line options for the underlying repository's client. These are usually parsed and, perhaps, checked for validity by calling the underlying command line. =back =cut sub new { my $class = shift ; $class = ref $class || $class ; my VCP::Source $self = $class->SUPER::new( @_ ) ; $self->{BOOTSTRAP_REGEXPS} = [] ; return $self ; } ############################################################################### =head1 SUBCLASSING This class uses the fields pragma, so you'll need to use base and possibly fields in any subclasses. See L for methods often needed in subclasses. =head2 Subclass utility API =over =item parse_options $self->parse_options( \@options, @specs ); Parses common options including whatever options VCP::Plugin parses, --bootstrap, and --rev-root. =cut sub parse_options { my VCP::Source $self = shift; $self->SUPER::parse_options( @_, "b|bootstrap=s" => sub { $self->bootstrap( $_[1] ) }, "continue" => \$self->{CONTINUE}, "rev-root" => sub { $self->rev_root( $_[1] ) }, ); } =item dest Sets/Gets a reference to the VCP::Dest object. The source uses this to call handle_header(), handle_rev(), and handle_end() methods. =cut sub dest { my VCP::Source $self = shift ; $self->{DEST} = shift if @_ ; return $self->{DEST} ; } =item continue Sets/Gets the CONTINUE field (which the user sets via the --continue flag) =cut sub continue { my VCP::Source $self = shift ; $self->{CONTINUE} = shift if @_ ; return $self->{CONTINUE} ; } =back =head1 SUBCLASS OVERLOADS These methods should be overridded in any subclasses. =over =item copy REQUIRED OVERLOAD. $source->copy_revs() ; Called by L to do the entire export process. This is passed a partially filled-in header structure. The subclass should call this to move all the revisions over to the destination: $self->SUPER::copy_revs( $revs ); If $revs, an ARRAY containing revisions, is not passed in, $self->revs->remove_all() is used. =cut sub copy_revs { my VCP::Source $self = shift ; my ( $revs ) = @_; $revs ||= $self->revs->remove_all; VCP::Revs->set_file_fetcher( $self ); for my $i ( 0..$#$revs ) { $self->dest->handle_rev( $revs->[$i] ); $revs->[$i] = undef; } } =item fetch_files Calls get_rev( $r ) for each parameter. Overload this if you can batch requests more efficiently. =cut sub fetch_files { my VCP::Source $self = shift ; map $self->get_rev( $_ ), @_; } =item handle_header REQUIRED OVERLOAD. Subclasses must add all repository-specific info to the $header, at least including rep_type and rep_desc. $header->{rep_type} => 'p4', $self->p4( ['info'], \$header->{rep_desc} ) ; The subclass must pass the $header on to the dest: $self->dest->handle_header( $header ) ; =cut sub handle_header { my VCP::Source $self = shift ; # my ( $header ) = @_ ; confess "ERROR: copy not overloaded by class '", ref $self, "'. Oops.\n"; # if $self->can( 'handle_header' ) eq \&handle_header ; # $self->dest->handle_header( $header ) ; } =item handle_footer Not a required overload, as the footer carries no useful information at this time. Overriding methods must call this method to pass the $footer on: $self->SUPER::handle_footer( $footer ) ; =cut sub handle_footer { my VCP::Source $self = shift ; my ( $footer ) = @_ ; $self->dest->handle_footer( $footer ) ; VCP::Revs->set_file_fetcher( undef ); } =item parse_time $time = $self->parse_time( $timestr ) ; Parses "[cc]YY/MM/DD[ HH[:MM[:SS]]]". Will add ability to use format strings in future. HH, MM, and SS are assumed to be 0 if not present. Returns a time suitable for feeding to localtime or gmtime. Assumes local system time, so no good for parsing times in revml, but that's not a common thing to need to do, so it's in VCP::Source::revml.pm. =cut { ## This routine is slow and gets called a *lot* with duplicate ## inputs, at least by VCP::Source::cvs, so we memoize it. my %cache; sub parse_time { my VCP::Source $self = shift ; my ( $timestr ) = @_ ; return $cache{$timestr} ||= do { ## TODO: Get parser context here & give file, line, and column. filename ## and rev, while we're scheduling more work for the future. confess "Malformed time value $timestr\n" unless $timestr =~ /^(\d\d)?\d?\d(\D\d?\d){2,5}/ ; my @f = split( /\D/, $timestr ) ; --$f[1] ; # Month of year needs to be 0..11 push @f, ( 0 ) x ( 6 - @f ) ; require Time::Local; return Time::Local::timelocal( reverse @f ) ; } } } =item bootstrap Usually called from within call to GetOptions in subclass' new(): GetOptions( 'bootstrap|b=s' => sub { my ( $name, $val ) = @_ ; $self->bootstrap( $val ) ; }, 'rev-root' => \$rev_root, ) or $self->usage_and_exit ; Can be called plain: $self->bootstrap( $bootstrap_spec ) ; See the command line documentation for the format of $bootstrap_spec. Returns nothing useful. =cut sub bootstrap { my VCP::Source $self = shift ; my ( $val ) = @_ ; require Regexp::Shellish; $self->{BOOTSTRAP_REGEXPS} = [ map Regexp::Shellish::compile_shellish( $_ ), split /,+/, $val ]; return ; } #=item bootstrap_regexps # # $self->bootstrap_regexps( $re1, $re1, ... ) ; # $self->bootstrap_regexps( undef ) ; ## clears the list # @res = $self->bootstrap_regexps ; # #Sets/gets the list of regular expressions defining what files are in bootstrap #mode. This is usually set by L, though. # #=cut # #sub bootstrap_regexps { # my VCP::Source $self = shift ; # $self->{BOOTSTRAP_REGEXPS} = [ @_ == 1 && ! defined $_[0] ? () : @_ ] # if @_ ; # return @{$self->{BOOTSTRAP_REGEXPS}} ; #} # =item is_bootstrap_mode ... if $self->is_bootstrap_mode( $file ) ; Compares the filename passed in against the list of bootstrap regular expressions set by L. The file should be in a format similar to the command line spec for whatever repository is passed in, and not relative to rev_root, so "//depot/foo/bar" for p4, or "module/foo/bar" for cvs. This is typically called in the subbase class only after looking at the revision number to see if it is a first revision (in which case the subclass should automatically put it in bootstrap mode). =cut sub is_bootstrap_mode { my VCP::Source $self = shift ; my ( $file ) = @_ ; my $result = grep $file =~ $_, @{$self->{BOOTSTRAP_REGEXPS}} ; lg( "$file ", ( $result ? "=~ " : "!~ " ), "[ ", join( ', ', map "qr/$_/", @{$self->{BOOTSTRAP_REGEXPS}} ), " ] (", ( $result ? "not in " : "in " ), "bootstrap mode)" ) if debugging; return $result ; } =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. =head1 AUTHOR Barrie Slaymaker =cut 1