Plugin.pm #21

  • //
  • guest/
  • perforce_software/
  • revml/
  • lib/
  • VCP/
  • Plugin.pm
  • View
  • Commits
  • Open Download .zip Download (25 KB)
package VCP::Plugin ;

=head1 NAME

VCP::Plugin - A base class for VCP::Source and VCP::Dest

=head1 SYNOPSIS

=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

use strict ;

use Carp ;
use Cwd ;
use File::Basename ;
use File::Path ;
use File::Spec ;
use IPC::Run ;
use UNIVERSAL qw( isa ) ;
use VCP::Debug ':debug' ;
use VCP::Branches;
use VCP::Rev ;

use vars qw( $VERSION $debug ) ;

$VERSION = 0.1 ;

$debug = 0 ;

use fields (
   'WORK_ROOT',     ## The root of the export work area.
   'COMMAND_CHDIR', ## Where to chdir to when running COMMAND
   'COMMAND_STDERR_FILTER', ## How to modify the stderr when running a command
   'COMMAND_OK_RESULT_CODES', ## HASH keyed on acceptable COMMAND return vals
   'COMMAND_RESULT_CODE',     ## What the last run_safely command returned.
   'REV_ROOT',
   'SEEN_REVS',     ## HASH of all seen revisions, keyed on name and rev_id
   'LAST_SEEN',     ## HASH of last seen revisions, keyed on name and branch_id
   'REPO_SCHEME',   ## The scheme (this is usually superfluous, since new() has
                    ## already been called on the correct class).
   'REPO_USER',     ## The user name to log in to the repository with, if any
   'REPO_PASSWORD', ## The password to log in to the repository with, if any
   'REPO_SERVER',   ## The repository to connect to
   'REPO_FILESPEC', ## The filespec to get/store

   'BRANCHES',      ## The branches database.  Filled by the source,
                    ## passed to the dest in the header.
) ;


=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->work_root( $self->tmp_dir ) ;
   rmtree $self->work_root if ! $ENV{VCPNODELETE} && -e $self->work_root ;

   $self->{SEEN_REVS} = {} ;
   $self->{LAST_SEEN} = {} ;

   $self->{COMMAND_OK_RESULT_CODES} = [ 0 ];

   $self->{BRANCHES} = VCP::Branches->new;

   $self->command_chdir( $self->work_path ) ;

   return $self ;
}


###############################################################################

=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 last_seen

   $old_rev = $self->last_seen( $new_rev ) ;

Called to register the fact that $new_rev has been seen, and to return
the base revision for the revision.  If no base revision is specified,
the previously seen revision for this branch is given.

This assumes that versions of each file are encountered in chronological
order.

This the only accessor method in VCP's API that returns the previous
value.

=cut

sub last_seen {
   my VCP::Plugin $self = shift ;

   confess "LAST_SEEN not initted: need to call SUPER::new?"
      unless defined $self->{LAST_SEEN} ;

   my VCP::Rev $r = shift;

   my $name = $r->name;
   my $base_rev_id = $r->base_rev_id;
   my $branch_id = $r->branch_id;
   $branch_id = "" unless defined $branch_id;

   my $old_r;
   if ( defined $base_rev_id ) {
      $old_r = $self->{SEEN_REVS}->{$name}->{$base_rev_id};
      die "Base revision not found: $base_rev_id of ", $r->as_string
         unless $old_r;
   }
   else {
      $old_r = $self->{LAST_SEEN}->{$name}->{$branch_id} ;
      ## TODO: Compare chang_id or rev_id to make sure the current is
      ## newer than older?
   }

   $self->{SEEN_REVS}->{$name}->{$r->rev_id} = $r;
   $self->{LAST_SEEN}->{$name}->{$branch_id} = $r;
   return $old_r ;
}


=item delete_seen

Deletes the last seen revision for a file.  Returns nothing.

=cut

sub delete_seen {
   my VCP::Plugin $self = shift ;

   confess "LAST_SEEN not initted: need to call SUPER::new?"
      unless defined $self->{LAST_SEEN} ;

   my VCP::Rev $r = shift;

   my $name = $r->name;
   my $branch_id = $r->branch_id;
   $branch_id = "" unless defined $branch_id;

   delete $self->{LAST_SEEN}->{$name}->{$branch_id} ;
   delete $self->{LAST_SEEN}->{$name} unless %{$self->{LAST_SEEN}->{$name}};
   delete $self->{SEEN_REVS}->{$name}->{$r->rev_id} ;
   delete $self->{SEEN_REVS}->{$name} unless %{$self->{SEEN_REVS}->{$name}};
   return ;
}

=item none_seen

Returns TRUE if $dest->last_seen( $r ) has not yet been called.

=cut

sub none_seen {
   my VCP::Plugin $self = shift ;

   ## This can happen if a subclass forgets to init it's base class(es).
   confess "Oops" unless defined $self->{LAST_SEEN} ;

   return ! %{$self->{LAST_SEEN}} ;
}


=item parse_repo_spec

   my $spec = $self->split_repo_spec( $spec ) ;

This splits a repository spec in one of the following formats:

   scheme:user:passwd@server:filespec
   scheme:user@server:filespec
   scheme::passwd@server:filespec
   scheme:server:filespec
   scheme:filespec

in to the indicated fields, which are stored in $self and may be
accessed and altered using L</repo_scheme>, L</repo_user>, L</repo_password>,
L</repo_server>, and L</repo_filespec>. Some sources and destinations may
add additional fields. The p4 drivers create an L<VCP::Utils::p4/repo_client>,
for instance, and parse the repo_user field to fill it in.  See
L<VCP::Utils::p4/parse_p4_repo_spec> for details.

The spec is parsed from the ends towars the middle in this order:

   1. SCHEME (up to first ':')
   2. FILESPEC  (after last ':')
   3. USER, PASSWORD (before first '@')
   4. SERVER (everything left).

This approach allows the FILESPEC string to contain '@', and the SERVER
string to contain ':' and '@'.  USER can contain ':'.  Funky, but this
works well, at least for cvs and p4.

If a section of the repo spec is not present, the corresponding entry
in $hash will not exist.

The attributes repo_user, repo_password and repo_server are set
automatically by this method.  It does not store the SCHEME anyware
since the SCHEME is usually ignored by the plugin (the plugin is
selected using the scheme, so it knows the scheme implicitly), and
the FILES setting often needs extra manipulation, so there's no point
in storing it.

=cut

sub parse_repo_spec {
   my VCP::Plugin $self = shift ;

   my ( $spec ) = @_ ;

   my $result ;

   for ( $spec ) {
      return $result unless s/^([^:]*)(?::|$)// ;
      $result->{SCHEME} = $1 ;
      $self->repo_scheme( $1 ) ;

      return $result unless s/(?:^|:)([^:]*)$// ;
      $result->{FILES} = $1 ;
      $self->repo_filespec( $1 ) ;

      if ( s/^([^\@]*?)(?::([^\@:]*))?@// ) {
         if ( defined $1 ) {
	    $result->{USER}     = $1 ;
	    $self->repo_user( $1 ) ;
	 }

         if ( defined $2 ) {
	    $result->{PASSWORD} = $2 ;
	    $self->repo_password( $2 ) ;
	 }
      }

      return $result unless length $spec ;
      $result->{SERVER} = $spec ;
      $self->repo_server( $spec ) ;
   }

   ## TODO: Return nothing.  Callers need to come to use the
   ## accessors.
   return $result
}



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

   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,
	 ) ;
	 confess ;
      }
   }

   die "can't locate '$f' to print usage.\n" ;
}


=item branches

    $plugin->branches( $b );
    my $b = $plugin->branches;

Set

=cut

sub branches {
   my VCP::Plugin $self = shift;
   $self->{BRANCHES} = shift if @_;
   return $self->{BRANCHES};
}


=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;
   ## This delay seems to be required to give NT a chance
   ## to clean up the tmpdir, otherwise we get a
   ## "permission denied error on Win32.
   select undef, undef, undef, 0.01 if $^O =~ /Win32/ ;
   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 ) {
      warn "Removing previous working directory $tmp_dir_root\n";
      rmtree [$tmp_dir_root ], 0;
   }

   $tmp_dirs{$tmp_dir_root} = 1 ;
   return File::Spec->catdir( $tmp_dir_root, $plugin_dir, @_ ) ;
}


=item work_path

   $full_path = $self->work_path( $filename, $rev ) ;

Returns the full path to the working copy of the local filename.

Each VCP::Plugin gets thier own hierarchy to use, usually rooted at
a directory named /tmp/vcp$$/plugin-source-foo/ for a module
VCP::Plugin::Source::foo.  $$ is vcp's process ID.

This is typically $work_root/$filename/$rev, but this may change.
$rev is put last instead of first in order to minimize the overhead of
creating lots of directories.

It *must* be under $work_root in order for rm_work_path() to fully
clean.

All directories will be created as needed, so you should be able
to create the file easily after calling this.  This is only
called by subclasses, and is optional: a subclass could create it's
own caching system.

Directories are created mode 0775 (rwxrwxr-x), subject to modification
by umask or your local operating system.  This will be modifiable in
the future.

=cut

sub work_path {
   my VCP::Plugin $self = shift ;

   my $path = File::Spec->canonpath(
      File::Spec->catfile( $self->work_root, @_ )
   ) ;

   return $path ;
}


=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 ) = @_ ;

   unless ( -d $path ) {
      $mode = 0770 unless defined $mode ;
      debug "vcp: mkdir $path, ", sprintf "%04o", $mode if debugging $self ;
      mkpath [ $path ], 0, $mode
         or die "vcp: 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 rm_work_path

   $self->rm_work_path( $filename, $rev ) ;
   $self->rm_work_path( $dirname ) ;

Removes a directory or file from the work.  Also removes any and
all directories that become empty as a result up to the
work root (/tmp on Unix).

=cut

sub rm_work_path {
   my VCP::Plugin $self = shift ;

   my $path = $self->work_path( @_ ) ;

   if ( defined $path && -e $path ) {
      debug "vcp: rmtree $path" if debugging $self ;
      if ( ! $ENV{VCPNODELETE} ) {
         rmtree $path or warn "$!: $path"
      }
      else {
         warn "Not removing working directory $path due to VCPNODELETE\n";
      }
   }

   my $root = $self->work_root ;

   if ( substr( $path, 0, length $root ) eq $root ) {
      while ( length $path > length $root ) {
	 ( undef, $path ) = fileparse( $path ) ;
	 ## TODO: More discriminating error handling.  But the error emitted
	 ## when a directory is not empty may differ from platform
	 ## to platform, not sure.
	 last unless rmdir $path ;
      }
   }
}


=item work_root

   $root = $self->work_root ;
   $self->work_root( $new_root ) ;
   $self->work_root( $new_root, $dir1, $dir2, .... ) ;

Gets/sets the work root.  This defaults to

   File::Spec->tmpdir . "/vcp$$/" . $plugin_name

but may be altered.  If set to a relative path, the current working
directory is prepended.  The returned value is always absolute, and will
not change if you chdir().  Depending on the operating system, however,
it might not be located on to the current volume.  If not, it's a bug,
please patch away.

=cut

sub work_root {
   my VCP::Plugin $self = shift ;

   if ( @_ ) {
      if ( defined $_[0] ) {
	 $self->{WORK_ROOT} = File::Spec->catdir( @_ ) ;
	 debug "vcp: work_root set to '",$self->work_root,"'"
	    if debugging $self ;
	 unless ( File::Spec->file_name_is_absolute( $self->{WORK_ROOT} ) ) {
	    require Cwd ;
	    $self->{WORK_ROOT} = File::Spec->catdir( Cwd::cwd, @_ ) ;
	 }
      }
      else {
         $self->{WORK_ROOT} = undef ;
      }
   }

   return $self->{WORK_ROOT} ;
}


=item command_chdir

Sets/gets the directory to chdir into before running the default command.

=cut

sub command_chdir {
   my VCP::Plugin $self = shift ;
   if ( @_ ) {
      $self->{COMMAND_CHDIR} = shift ;
      debug "vcp: command_chdir set to '", $self->command_chdir, "'"
         if debugging $self ;
   }
   return $self->{COMMAND_CHDIR} ;
}


=item command_stderr_filter

   $self->command_stderr_filter( qr/^cvs add: use 'cvs commit'.*\n/m ) ;
   $self->command_stderr_filter( sub { my $t = shift ; $$t =~ ... } ) ;

Some commands--cough*cvs*cough--just don't seem to be able to shut up
on stderr.  Other times we need to watch stderr for some meaningful output.

This allows you to filter out expected whinging on stderr so that the command
appears to run cleanly and doesn't cause $self->cmd(...) to barf when it sees
expected output on stderr.

This can also be used to filter out intermittent expected errors that
aren't errors in all contexts when they aren't actually errors.

=cut

sub command_stderr_filter {
   my VCP::Plugin $self = shift ;
   $self->{COMMAND_STDERR_FILTER} = $_[0] if @_ ;
   return $self->{COMMAND_STDERR_FILTER} ;
}


=item command_ok_result_codes

   $self->command_ok_result_codes( 0, 1 ) ;

Occasionally, a non-zero result is Ok.  this method lets you set a list
of acceptable result codes.

=cut

sub command_ok_result_codes {
   my VCP::Plugin $self = shift ;

   @{$self->{COMMAND_OK_RESULT_CODES}} = @_ if @_;

   return @{$self->{COMMAND_OK_RESULT_CODES}} ;
}


=item repo_scheme

   $self->repo_scheme( $scheme_name ) ;
   $scheme_name = $self->repo_scheme ;

Sets/gets the scheme specified ("cvs", "p4", "revml", etc). This is normally
superfluous, since the scheme name is peeked at in order to load the
correct VCP::{Source,Dest}::* class, which then calls this.

This is usually set automatically by L</parse_repo_spec>.

=cut

sub repo_scheme {
   my VCP::Plugin $self = shift ;
   $self->{REPO_SCHEME} = $_[0] if @_ ;
   return $self->{REPO_SCHEME} ;
}


=item repo_user

   $self->repo_user( $user_name ) ;
   $user_name = $self->repo_user ;

Sets/gets the user name to log in to the repository with.  Some plugins
ignore this, like revml, while others, like p4, use it.

This is usually set automatically by L</parse_repo_spec>.

=cut

sub repo_user {
   my VCP::Plugin $self = shift ;
   $self->{REPO_USER} = $_[0] if @_ ;
   return $self->{REPO_USER} ;
}


=item repo_password

   $self->repo_password( $password ) ;
   $password = $self->repo_password ;

Sets/gets the password to log in to the repository with.  Some plugins
ignore this, like revml, while others, like p4, use it.

This is usually set automatically by L</parse_repo_spec>.

=cut

sub repo_password {
   my VCP::Plugin $self = shift ;
   $self->{REPO_PASSWORD} = $_[0] if @_ ;
   return $self->{REPO_PASSWORD} ;
}


=item repo_server

   $self->repo_server( $server ) ;
   $server = $self->repo_server ;

Sets/gets the repository to log in to.  Some plugins
ignore this, like revml, while others, like p4, use it.

This is usually set automatically by L</parse_repo_spec>.

=cut

sub repo_server {
   my VCP::Plugin $self = shift ;
   $self->{REPO_SERVER} = $_[0] if @_ ;
   return $self->{REPO_SERVER} ;
}


=item repo_filespec

   $self->repo_filespec( $filespec ) ;
   $filespec = $self->repo_filespec ;

Sets/gets the filespec.

This is usually set automatically by L</parse_repo_spec>.

=cut

sub repo_filespec {
   my VCP::Plugin $self = shift ;
   $self->{REPO_FILESPEC} = $_[0] if @_ ;
   return $self->{REPO_FILESPEC} ;
}


=item rev_root

   $self->rev_root( 'depot' ) ;
   $rr = $self->rev_root ;

The rev_root is the root of the tree being sourced. See L</deduce_rev_root>
for automated extraction.

Root values should have neither a leading or trailing directory separator.

'/' and '\' are recognized as directory separators and runs of these
are converted to single '/' characters.  Leading and trailing '/'
characters are then removed.

=cut

sub _slash_hack {
   for ( my $spec = shift ) {
      confess "undef arg" unless defined $spec ;
      s{[/\\]+}{/}g ;
      s{^/}{}g ;
      s{/\Z}{}g ;
      return $_ ;
   }
}

sub rev_root {
   my VCP::Plugin $self = shift ;

   if ( @_ ) {
      $self->{REV_ROOT} = &_slash_hack ;
      debug "vcp: rev_root set to '$self->{REV_ROOT}'" if debugging $self ;
   }
   return $self->{REV_ROOT} ;
}


=item deduce_rev_root

   $self->deduce_rev_root ;
   print $self->rev_root ;

This is used in most plugins to deduce the rev_root from the filespec portion
of the source or destination spec if the user did not specify a rev_root as
an option.

This function sets the rev_root to be the portion of the filespec up to (but
not including) the first file/directory name with a wildcard.

'/' and '\' are recognized as directory separators, and '*', '?', and '...'
as wildcard sequences.  Runs of '/' and '\' characters are treated as
single '/' characters (this may damage UNC paths).

NOTE: if no wildcards are found and the last character is a '/' or '\\', then
the entire string will be considered to be the rev_root.  Otherwise the
spec is expected to refer to a file, in which case the rev_root does
not include the final name.  This means that

   cvs:/foo

and

   cvs:/foo/

are different.

=cut

sub deduce_rev_root {
   my VCP::Plugin $self = shift ;

   my ( $spec ) = @_;

   $spec =~ s{^[\\/]*}{}g;
   my @dirs ;
   for ( split( /[\\\/]+/, $spec, -1 ) ) {
      if ( /[*?]|\.\.\./ ) {
         push @dirs, "";  ## Pretend "/foo/bar/..." was "/foo/bar/"
         last ;
      }
      push @dirs, $_ ;
   }

   pop @dirs;  ## Throw away trailiing filename or ""

   $self->rev_root( join( '/', @dirs ) ) ;
}


=item normalize_name

   $fn = $self->normalize_name( $fn ) ;

Normalizes the filename by converting runs of '\' and '/' to '/', removing
leading '/' characters, and removing a leading rev_root.  Dies if the name
does not begin with rev_root.

=cut

sub normalize_name {
   my VCP::Plugin $self = shift ;

   my ( $spec ) = &_slash_hack ;

   my $rr = $self->rev_root ;
   my $rrl = length $rr ;

   return $spec unless $rrl ;
   confess "'$spec' does not begin with rev_root '$rr'"
      unless substr( $spec, 0, $rrl ) eq $rr ;
   die "No files under the rev root '$rr' in spec '$spec'\n"
      if $rrl + 1 > length $spec;
   return substr( $spec, $rrl + 1 ) ;
}


=item denormalize_name

   $fn = $self->denormalize_name( $fn ) ;

Denormalizes the filename by prepending the rev_root.  May do more in
subclass overloads.  For instance, does not prepend a '//' by default for
instance, but p4 overloads do that.

=cut

sub denormalize_name {
   my VCP::Plugin $self = shift ;

   return join( '/', $self->rev_root, shift ) ;
}


=item run

DEPRECATED: use run_safely instead.

   $self->run( [@cmd_and_args], \$stdout, \$stderr ) ;

A wrapper around L<IPC::Run/run>, which integrates debugging support and
disables stdin by default.

=cut

## output command lines using " quoting on Win32 so we can cut & paste.
my $q = $^O =~ /Win32|OS2/ ? '"' : "'";

sub run {
   my VCP::Plugin $self = shift ;
   my $cmd = shift ;


   debug "vcp: running ", join( ' ', map "$q$_$q", @$cmd )
      if debugging $self ;
   
   return IPC::Run::run( $cmd, \undef, @_ ) ;
}

=item run_safely

Runs a command "safely", first chdiring in to the proper directory and
then running it while examining STDERR through an optional filter and
looking at the result codes to see if the command exited acceptably.

Most often called from VCP::Utils::foo methods.

=cut

sub run_safely {
   my VCP::Plugin $self = shift ;
   my $cmd = shift ;

   my $cmd_path = $cmd->[0] ;
   my $cmd_name = basename( $cmd_path ) ;

   ## Prefix succinct mode args with '>', etc.
   my $childs_stderr = '' ;
   my @redirs ;
   my $fd = 1 ;
   while ( @_ ) {
      last unless ref $_[0] ;
      push @redirs, "$fd>", shift ;
      ++$fd ;
   }

   my $stderr_filter;
   my $ok_result_codes;
   while ( @_ ) {
      if ( $_[0] eq "stderr_filter" ) {
         shift;
         $stderr_filter = shift;
         next;
      }
      if ( $_[0] eq "ok_result_codes" ) {
         shift;
         $ok_result_codes = shift;
         next;
      }
      push @redirs, shift @_ ;
   }
   $stderr_filter = $self->command_stderr_filter
      unless defined $stderr_filter;
   $ok_result_codes = $self->{COMMAND_OK_RESULT_CODES}
      unless defined $ok_result_codes;

   $self->{COMMAND_RESULT_CODE} = undef;

   ## Put it on the beginning so that later redirects specified by the client
   ## can override our redirect.  This is necessary in case the client does
   ## a '2>&1' or some other subtle thing.
   unshift @redirs, '2>', \$childs_stderr
      unless grep $_ eq '2>', @redirs ;

   unshift @redirs, '<', \undef
      unless grep $_ eq '<', @redirs ;

   debug "vcp: running ", join( ' ', map "$q$_$q", @$cmd ),
      " in ", defined $self->{COMMAND_CHDIR}
         ?  $self->{COMMAND_CHDIR}
	 : "undef"
      if debugging $self, join( '::', ref $self, $cmd->[0] ) ;

   my $cwd ;

   if ( defined $self->command_chdir ) {
      $self->mkdir( $self->command_chdir )
	 unless -e $self->command_chdir ;

      $cwd = cwd;

      chdir $self->command_chdir or die "$!: ", $self->command_chdir ;
      cwd;
#      debug "now in ", cwd if debugging ;
   }
   
   my $h = IPC::Run::harness( $cmd, @redirs ) ;
   $h->run ;
   $self->{COMMAND_RESULT_CODE} = $h->full_result( 0 );

   if ( defined $cwd ) {
      chdir $cwd or die "$!: $cwd" ;
#      debug "now in ", cwd if debugging ;
   }

   my @errors ;

   if ( length $childs_stderr ) {
      if ( debugging $self ) {
         my $t = $childs_stderr ;
	 $t =~ s/^/$cmd_name: /gm ;
	 debug $t ;
      }
      if ( ref $stderr_filter eq 'Regexp' ) {
         $childs_stderr =~ s/$stderr_filter//mg ;
      }
      elsif ( ref $stderr_filter eq 'CODE' ) {
         $stderr_filter->( \$childs_stderr ) ;
      }

      if ( length $childs_stderr ) {
	 $childs_stderr =~ s/^/$cmd_name: /gm ;
	 $childs_stderr .= "\n" unless substr( $childs_stderr, -1 ) eq "\n" ;
	 push (
	    @errors,
	    "vcp: unexpected stderr from '$cmd_name':\n",
	    $childs_stderr,
	 ) ;
      }
   }

   ## In checking the result code, we assume the first one is the important
   ## one.  This is done because a few callers pipe the first child's output
   ## in to a perl sub that then does a kill 9,$$ to effectively exit without
   ## calling DESTROY.
   ## TODO: Look at all of the result codes if we can get rid of kill 9, $$.

   push(
      @errors,
      "vcp: ",
      join( ' ', @$cmd ),
      " returned ",
      $self->{COMMAND_RESULT_CODE},
      " not ",
      join( ', ', @$ok_result_codes ),
      "\n"
   )
      unless grep $_ eq $self->{COMMAND_RESULT_CODE}, @$ok_result_codes;

   die join( '', @errors ) if @errors ;

   Carp::cluck "Result of `", join( ' ', @$cmd ), "` checked"
      if defined wantarray ;
}

=item command_result_code

Returns the result code from the last C<run_safely()> command.  This is
a separate method because (a) most invocations set the ok result codes
list so that funny looking but ok results are ignored, and (2) because
returning the commend execution code from the run() command leads to
funny looking inverted logic because most shell commands return 0 for
sucess.  Now, if Perl has an "N but false" special case to go with its
"0 but true".

This is read-only.

=cut

sub command_result_code {
   my VCP::Plugin $self = shift ;

   return $self->{COMMAND_RESULT_CODE};
}


sub DESTROY {
   my VCP::Plugin $self = shift ;

   if ( defined $self->work_root ) {
      local $@ ;
      eval { $self->rm_work_path() ; } ;

      warn "Unable to remove work directory '", $self->work_root, "'\n"
	 if ! $ENV{VCPNODELETE} && -d $self->work_root ;
   }
}

=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
# Change User Description Committed
#69 4143 Barrie Slaymaker - Further adaptation to vcp.exe packaging format
#68 4077 Barrie Slaymaker - VCP on Win32 no longer whines about permission denied errors
  for some disk file cleanup tasks.
#67 4021 Barrie Slaymaker - Remove all phashes and all base & fields pragmas
- Work around SWASHGET error
#66 4012 Barrie Slaymaker - Remove dependance on pseudohashes (deprecated Perl feature)
#65 3970 Barrie Slaymaker - VCP::Source handles rev queing, uses disk to reduce RAM
- Lots of other fixes
#64 3862 Barrie Slaymaker - Use start_dir/tmp for tempdir locations so that
  VCP::Source::revml, which stashes files under
  star_dir/vcp_state, allows those files to be link()ed
#63 3855 Barrie Slaymaker - vcp scan, filter, transfer basically functional
    - Need more work in re: storage format, etc, but functional
#62 3753 Barrie Slaymaker - mkdir() trims trailing slashes for *BSD and POSIXly correct oses
#61 3491 Barrie Slaymaker - All sections are now documented in generated config files
#60 3460 Barrie Slaymaker - Revamp Plugin/Source/Dest hierarchy to allow for
  reguritating options in to .vcp files
#59 3439 Barrie Slaymaker - Temp dir cleanup now works better on Win32
#58 3429 Barrie Slaymaker - Refactor db_location() into VCP::Plugin so VCP::Source::vss will
  be able to use it.
#57 3417 Barrie Slaymaker - Win32 adaptation
#56 3402 Barrie Slaymaker - now passes all tests using the p4 api library.
  (still not default, set env var VCPP4API=1)
- foo->p4 handles branch-but-no-change case when
  --change-branch-rev-1 is passed.
- sources & dests can now provide their own command
  execution routine in place of shelling out to an
  external command (as in call the p4api library
  instead of running the p4 command).
#55 3376 John Fetkovich small changes
#54 3287 John Fetkovich Allow parse_options to silently ignore the lack of options array.
#53 3284 John Fetkovich 'sub new' constructor in Source and Dest p4.pm fixed so parse_p4_repo_spec
       only called when a $spec is provided to the constructor.  parse_p4_repo_spec
       now also sets the repo_id.  parse_repo_spec (TODO item) no longer returns
       a hash value of the values parsed, it only sets fields in $self.  Fixed a few
       places where that return hash was used.
#52 3283 John Fetkovich argument checking
#51 3271 John Fetkovich Added stub init() in VCP/Plugin.pm,
       and call to it in load_module in bin/vcp.
       This is in preparation for Sources and Dests
       to have parts of their current constructors split
       out into init() functions which will facilitate
       setting of fields from the interative ui code.
#50 3170 Barrie Slaymaker Clean up _run3 a bit.
       Avoid Carp; use BUG.
#49 3167 Barrie Slaymaker Add profiling report that details various chunks of time
       taken.
#48 3163 Barrie Slaymaker Keep system() from flushing STDOUT to the tmpfiles
       that _run3() uses.
#47 3161 Barrie Slaymaker _run3 can now capture STDOUT to a CODE ref.
#46 3155 Barrie Slaymaker Convert to logging using VCP::Logger to reduce stdout/err spew.
       Simplify & speed up debugging quite a bit.
       Provide more verbose information in logs.
       Print to STDERR progress reports to keep users from wondering
       what's going on.
       Breaks test; halfway through upgrading run3() to an inline
       function for speed and for VCP specific features.
#45 3129 Barrie Slaymaker Stop calling the slow Cwd::cwd so much, use start_dir
       instead.
#44 3120 Barrie Slaymaker Move changeset aggregation in to its own filter.
#43 3099 Barrie Slaymaker Code cleanup
#42 3014 Barrie Slaymaker minor warnings cleanups
#41 3012 Barrie Slaymaker Report stderr of child if it returns an unnaceptable result code.
#40 2958 Barrie Slaymaker Avoid undef warning, improve output by properly quoting cmd.
#39 2952 John Fetkovich removed old run_safely, and renamed run_safely_new to run_safely.
#38 2853 John Fetkovich removed some debugging output
#37 2809 Barrie Slaymaker Implement --repo-id in Plugin.pm, refactor source & dest
       options parsing starting in VCP::Source::cvs (need to
       roll out to other sources and dests), get t/91cvs2revml.t
       passing again (first time in months! branching and
       --continue support works in cvs->foo!).
#36 2802 John Fetkovich Added a source_repo_id to each revision, and repo_id to each
Source and Dest.  The repo_ids include repository type
(cvs,p4,revml,vss,...) and the repo_server fields.  Changed the
$self->...->set() and $self->...->get() lines in VCP::Dest::* to
pass in a conglomerated key value, by passing in the key as an
ARRAY ref.  Also various restructuring in VCP::DB.pm,
VCP::DB_file.pm and VCP::DB_file::sdbm.pm related to this
change.
#35 2752 John Fetkovich improve IPC::Run debug msg
#34 2743 John Fetkovich Add fields to vcp:
         source_name,
         source_filebranch_id,
         source_branch_id,
         source_rev_id,
         source_change_id

        1. Alter revml.dtd to include the fields
        2. Alter bin/gentrevml to emit legal RevML
        3. Extend VCP::Rev to have the fields
        4. Extend VCP::{Source,Dest}::revml to read/write the fields
           (VCP::Dest::revml should die() if VCP tries to emit illegal
           RevML)
        5. Extend VCP::{Source,Dest}::{cvs,p4} to read the fields
        7. Get all tests through t/91*.t to pass
           except those that rely on ch_4 labels
#33 2719 Barrie Slaymaker Improve error reporting, allow run_safely's in_dir to be
       relative to the default command_chdir setting
#32 2665 John Fetkovich change to permit profiling via unix 'time' command in run_safely_new
#31 2664 Barrie Slaymaker Try IPC::Run3 to see if it speeds up p4 calls
#30 2655 John Fetkovich Added usage of 'nix time command to run_safely in Utils.pm
       when profiling is turned on.
#29 2415 John Fetkovich POD documentation fixes.
#28 2293 Barrie Slaymaker Update CHANGES, TODO, improve .vcp files, add --init-cvs
#27 2267 Barrie Slaymaker factor out cvs2revml, test both --use-cvs and direct modes, with times
#26 2245 Barrie Slaymaker cvs -r (re)implemented for direct reads, passes all cvs-only tests
#25 2049 Barrie Slaymaker Get branching working in Dest::p4, clean up some tests.
#24 2026 Barrie Slaymaker VCP::8::cvs now supoprt branching
#23 2018 Barrie Slaymaker tweak
#22 2015 Barrie Slaymaker submit changes
#21 2009 Barrie Slaymaker lots of fixes, improve core support for branches and VCP::Source::cvs
       now supports branches.
#20 2006 Barrie Slaymaker more preparations for branching support,
       handling of cvs :foo:... CVSROOT specs,
       misc fixes, improvements
#19 1998 Barrie Slaymaker Initial, revml and core VCP support for branches
#18 1822 Barrie Slaymaker Get all other tests passing but VSS.
 Add agvcommenttime
       sort field.
#17 1809 Barrie Slaymaker VCP::Patch should ignore lineends
#16 1728 Barrie Slaymaker CVS on win32, minor bugfixes
#15 1358 Barrie Slaymaker Win32 changes
#14 719 Barrie Slaymaker vcp 0.221
#13 705 Barrie Slaymaker Release 0.22.
#12 692 Barrie Slaymaker Add VCP::Utils::p4 and use it to get VCP::Dest::p4 to create it's
own client view as needed.
#11 687 Barrie Slaymaker remove -f, tweak deduce_rev_root
#10 628 Barrie Slaymaker Cleaned up POD in bin/vcp, added BSD-style license.
#9 627 Barrie Slaymaker Beef up CVS log file parsing.
#8 609 Barrie Slaymaker Add a file to the test procedure that it alternately added and
deleted (file is named "readd"). Fixed all destinations to handle
that.
#7 608 Barrie Slaymaker Lots of changes to get vcp to install better, now up to 0.066.
Many thanks to Matthew Attaway for testing & suggestions.
#6 480 Barrie Slaymaker 0.06 Wed Dec 20 23:19:15 EST 2000
   - bin/vcp: Added --versions, which loads all modules and checks them
     for a $VERSION and print the results out.  This should help with
     diagnosing out-of-sync modules.
   - Added $VERSION vars to a few modules :-).  Forgot to increment any
     $VERSION strings.
   - VCP::Dest::cvs: The directory "deeply" was not being `cvs add`ed on
     paths like "a/deeply/nested/file", assuming "deeply" had no files
     in it.
   - VCP::Dest::revml: fixed a bug that was causing files with a lot of
     linefeeds to be emitted in base64 instead of deltaed.  This means
     most text files.
   - Various minor cleanups of diagnostics and error messages, including
     exposing "Can't locate Foo.pm" when a VCP::Source or VCP::Dest
     module depends on a module that's not installed, as reported by
     Jeff Anton.
#5 478 Barrie Slaymaker 0.05 Mon Dec 18 07:27:53 EST 2000
   - Use `p4 labels //...@label` command as per Rober Cowham's suggestion, with
     the '-s' flag recommended by Christopher Siewald and
     Amaury.FORGEOTDARC@atsm.fr.  Though it's actually something like

       vcp: running /usr/bin/p4 -u safari -c safari -p localhost:5666 -s files
       //.../NtLkly //...@compiler_a3 //.../NtLkly //...@compiler_may3

     and so //on //for 50 parameters to get the speed up.  I use the
     //.../NtLkly "file" as //a separator between the lists of files in various
     //revisions.  Hope nobody has any files named that :-).  What I should do
     is choose a random label that doesn't occur in the labels list, I guess.
   - VCP::Source::revml and VCP::Dest::revml are now binary, control code, and
     "hibit ASCII" (I know, that's an oxymoron) clean.  The <comment>, <delta>,
     and <content> elements now escape anything other than tab, line feed,
     space, or printable chars (32 <= c <= ASCII 126) using a tag like '<char
     code="0x09">'.  The test suite tests all this.  Filenames should also
     be escaped this way, but I didn't get to that.
   - The decision whether to do deltas or encode the content in base64 is now
     based on how many characters would need to be escaped.
   - We now depend on the users' diff program to have a "-a" option to force it
     to diff even if the files look binary to it.  I need to use Diff.pm and
     adapt it for use on binary data.
   - VCP::Dest::cvs now makes sure that no two consecutive revisions of the
     same file have the same mod_time.  VCP::Source::p4 got so fast at pulling
     revisions from the repositories the test suite sets up that CVS was not
     noticing that files had changed.
   - VCP::Plugin now allows you to set a list of acceptable result codes, since
     we now use p4 in ways that make it return non-zero result codes.
   - VCP::Revs now croaks if you try to add two entries of the same VCP::Rev
     (ie matching filename and rev_id).
   - The <type> tag is now limited to "text" or "binary", and is meant to
     pass that level of info between foreign repositories.
   - The <p4_info> on each file now carries the one line p4 description of
     the file so that p4->p4 transferes can pick out the more detailed
     info.  VCP::Source::p4, VCP::Dest::p4 do this.
   - VCP::{Source,Dest}::{p4,cvs} now set binaryness on added files properly,
     I think.  For p4->p4, the native p4 type is preserved.  For CVS sources,
     seeing the keyword substitution flag 'o' or 'b' implies binaryness, for
     p4, seeing a filetype like qr/u?x?binary/ or qr/x?tempobj/ or "resource"
     implies binaryness (to non-p4 destinations).  NOTE: Seeing a 'o' or 'b'
     in a CVS source only ends up setting the 'b' option on the destination.
     That should be ok for most uses, but we can make it smarter for cvs->cvs
     transfers if need be.
#4 473 Barrie Slaymaker 0.04 Tue Dec 12 00:15:57 EST 2000
   - Reorg of VCP::Source::p4
     - One large filelog command is run instead of many small ones.
       This takes advantage of the -m option to make sure enough changes
       are listed.  Many extra revisions of most files are probably
       listed, but listing and ignoring them is quicker than spawning p4
       over and over.  Wish p4 filelog had a revision range...
     - it now doesn't suck the entire filelog output in to memory, it
       parses it line by line as it's emitted from the `p4 filelog`
     - `p4 print` is now used to print a bunch of files at once, using
       the header line to separate one file from the next, kind of like
       splitting a mime-encoded message.  There's a very slight chance
       that it will misjudge the boundary between two files if a file
       happens to have a line that looks very much like the header line
       for the next file.  This is pretty unlikely and I'll fix it if it
       crops up.  I could batch them more, right now it never puts two
       revisions of the same filename in the same batch, for no really
       good reason.  Another method might be to batch 25 or 50 revs each
       time.
     - it turns out there's a problem spawning multiple p4 commands at
       the same time against the same p4d (p4d is 99.2, FWIW).  Or at
       least running large `p4 files ...` while there's a large `p4
       filelog` still also running.
     - filelog lines beginning with "... ..." are now ignored.  These
       are notifications of copy, branch, and integrate events that we
       don't yet do anything with.
     - deleted cur() and P4_CUR
     - deleted P4_IS_INCREMENTAL
   - Made an assertion in VCP::Dest::revml::handle_rev() a little
     clearer
   - Added some ok(1) calls to 90p4.t to make it easier to figure out
     which child process is whining or aborting
   - Made the message that's printed when a subcommand emits unexpected
     output say "stderr" instead of "stdout".
   - Cleaned up documentation for VC::Plugin::work_path().
#3 470 Barrie Slaymaker - Cleaned up VCP::Source::p4 a bit.
 It doesn't whine as much now
    when it sees what it considers to be old news in the log file.
  - Added an easy way to monitor the commands being issued to a
    repository: simply add "::cmd" to the debug spec for that source:

       vcp -d Source::cvs::cvs
       vcp -d Dest::p4::p4

  - The next step is to use the -m option to p4 filelog to speed
    things up.
#2 468 Barrie Slaymaker - VCP::Dest::p4 now does change number aggregation based on the
  comment field changing or whenever a new revision of a file with
  unsubmitted changes shows up on the input stream.  Since revisions of
  files are normally sorted in time order, this should work in a number
  of cases.  I'm sure we'll need to generalize it, perhaps with a time
  thresholding function.
- t/90cvs.t now tests cvs->p4 replication.
- VCP::Dest::p4 now doesn't try to `p4 submit` when no changes are
  pending.
- VCP::Rev now prevents the same label from being applied twice to
  a revision.  This was occuring because the "r_1"-style label that
  gets added to a target revision by VCP::Dest::p4 could duplicate
  a label "r_1" that happened to already be on a revision.
- Added t/00rev.t, the beginnings of a test suite for VCP::Rev.
- Tweaked bin/gentrevml to comment revisions with their change number
  instead of using a unique comment for every revision for non-p4
  t/test-*-in-0.revml files.  This was necessary to test cvs->p4
  functionality.
#1 467 Barrie Slaymaker Version 0.01, initial checkin in perforce public depot.