package VCP::Plugin ; =head1 NAME VCP::Plugin - A base class for VCP::Source and VCP::Dest =head1 SYNOPSIS use VCP::Plugin; @ISA = qw( VCP::Plugin ); ... =head1 DESCRIPTION Some functionality is common to sources and destinations, such as cache access, Pod::Usage conversion, command-line access shortcut member, etc. =head1 EXTERNAL METHODS =over =cut $VERSION = 0.1 ; use strict ; use File::Basename ; use File::Path qw( mkpath rmtree ); use File::Spec; use VCP::Logger qw( lg pr BUG ); use VCP::Revs; use VCP::Utils qw( is_win32 shell_quote xchdir ); use fields ( 'REVS', ## Any revisions we need to work with ); =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. =cut sub new { my $class = shift ; $class = ref $class || $class ; my $self ; { no strict 'refs' ; $self = bless [ \%{"$class\::FIELDS"} ], $class ; } $self->{REVS} = VCP::Revs->new; return $self ; } =back =cut ############################################################################### =head1 SUBCLASSING This class uses the fields pragma, so you'll need to use base and possibly fields in any subclasses. =head2 SUBCLASS API These methods are intended to support subclasses. =over =item init This is called after new() and before processing. No attempt to connect to or open a repository or database file should be made until init() is called (ie not in new()). =cut sub init { } =item revs Sets/gets the revs container. This is used by most sources to accumulate the set of revisions to be copied. This member should be set by the child in copy_revs(). It should then be passed to the destination =cut sub revs { my VCP::Plugin $self = shift ; $self->{REVS} = $_[0] if @_ ; return $self->{REVS} ; } =item usage_and_exit GetOptions( ... ) or $self->usage_and_exit ; Used by subclasses to die if unknown options are passed in. Requires Pod::Usage when called. =cut sub usage_and_exit { my VCP::Plugin $self = shift ; lg "options error emitted to STDERR for ", ref $self; require Pod::Usage ; my $f = ref $self ; $f =~ s{::}{/}g ; $f .= '.pm' ; for ( @INC ) { my $af = File::Spec->catfile( $_, $f ) ; if ( -f $af ) { Pod::Usage::pod2usage( -input => $af, -verbose => 0, -exitval => 2, ) ; BUG "pod2usage returned"; } } die "can't locate '$f' to print usage.\n" ; } =item tmp_dir Returns the temporary directory this plugin should use, usually something like "/tmp/vcp123/dest-p4". =cut my %tmp_dirs ; END { return unless keys %tmp_dirs; xchdir "/" if is_win32; ## WinNT can't delete out from ## under cwd. rmtree [ reverse sort { length $a <=> length $b } keys %tmp_dirs ] if ! $ENV{VCPNODELETE} && %tmp_dirs ; } sub tmp_dir { my VCP::Plugin $self = shift ; my $plugin_dir = ref $self ; $plugin_dir =~ tr/A-Z/a-z/ ; $plugin_dir =~ s/^VCP:://i ; $plugin_dir =~ s/::/-/g ; my $tmp_dir_root = File::Spec->catdir( File::Spec->tmpdir, "vcp$$" ) ; ## Make sure no old tmpdir is there to mess us up in case ## a previous run crashed before cleanup or $ENV{VCPNODELETE} is set. if ( ! $tmp_dirs{$tmp_dir_root} && -e $tmp_dir_root ) { pr "removing previous working directory $tmp_dir_root"; rmtree [$tmp_dir_root ], 0; } $tmp_dirs{$tmp_dir_root} = 1 ; return File::Spec->catdir( $tmp_dir_root, $plugin_dir, @_ ) ; } =item mkdir $self->mkdir( $filename ) ; $self->mkdir( $filename, $mode ) ; Makes a directory and any necessary parent directories. The default mode is 770. Does some debug logging if any directories are created. Returns nothing. =cut sub mkdir { my VCP::Plugin $self = shift ; my ( $path, $mode ) = @_ ; BUG "undefined \$path" unless defined $path; BUG "empty \$path" unless length $path; unless ( -d $path ) { $mode = 0770 unless defined $mode ; lg "\$ ", shell_quote "mkdir", sprintf( "--mode=%04o", $mode ), $path; eval { mkpath [ $path ], 0, $mode } or die "failed to create $path with mode $mode: $@\n" ; } return ; } =item mkpdir $self->mkpdir( $filename ) ; $self->mkpdir( $filename, $mode ) ; Makes the parent directory of a filename and all directories down to it. The default mode is 770. Does some debug logging if any directories are created. Returns the path of the parent directory. =cut sub mkpdir { my VCP::Plugin $self = shift ; my ( $path, $mode ) = @_ ; my ( undef, $dir ) = fileparse $path; $self->mkdir( $dir, $mode ) ; return $dir ; } =item is_sort_filter Defaults to 0, set in (at least) L and L. The L module uses this to determine whether or not to automatically insert VCP::Filter::changesets or after the source. If the filter chain contains no filters with a true is_sort_filter then VCP inserts a sort filter immediately after the source. =cut sub is_sort_filter { 0 } =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