Source.pm #9

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 vars qw( $VERSION $debug ) ;

$VERSION = 0.1 ;

$debug = 0 ;

use base 'VCP::Plugin' ;

use fields (
   'BOOTSTRAP_REGEXPS', ## Determines what files are in bootstrap mode.
   'DEST',
) ;


=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<VCP::Plugin> 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] );
      },
      "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} ;
}

=back

=head1 SUBCLASS OVERLOADS

These methods should be overridded in any subclasses.

=over

=item copy

REQUIRED OVERLOAD.

   $source->copy_revs() ;

Called by L<VCP/copy> to do the entire export process.  This is passed a
partially filled-in header structure.

The subclass should call

   $self->dest->handle_rev( $rev_meta ) ;

The subclass needs to make sure the $rev_meta hash contains the metadata for
the file and a work_path that points to the work location of the
file:

   $rev_meta = VCP::Rev->new(
      work_path  => '/tmp/revex/4/depot/perl/perl.c',
      name       => 'depot/perl/perl.c',
      rev_id     => '4',
      change_id  => '22',
      labels     => [ 'v0_003', 'v0_004' ],
   ) ;

=cut

sub copy_revs {
   my VCP::Source $self = shift ;

   confess "ERROR: copy_revs not overloaded by class '",
      ref $self, "'.  Oops.\n" ;
}


=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 ) ;
}


=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

sub parse_time {
   my VCP::Source $self = shift ;
   my ( $timestr ) = @_ ;

   ## 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</bootstrap>, 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</bootstrap>.

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's 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}} ;

   debug (
      "vcp: $file ",
      ( $result ? "=~ " : "!~ " ),
      "[ ", join( ', ', map "qr/$_/", @{$self->{BOOTSTRAP_REGEXPS}} ), " ] (",
      ( $result ? "not in " : "in " ),
      "bootstrap mode)"
   ) if debugging $self ;

   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<vcp>.

=head1 AUTHOR

Barrie Slaymaker <barries@slaysys.com>

=cut

1