#!/usr/bin/perl -w
# $Header: //guest/matthew_rees/p4e/p4e.pl#3 $
# Everything up to the line "EndOfDescription" is a string:
local($Description) = <<EndOfDescription;
----------------------------- Perforce Emulator -----------------------------
This program emulates the Perforce client program and is intended to be used
when working disconnected. It handles edit, add, and delete commands by
logging the action, changing the write permissions, and creating a backup file
as necessary. A 'connect' command is used to later issue actual p4 commands.
Available sub-commands having p4 equivalent:
add -- Log file(s) for add
edit -- Log file(s) for edit, make writable, and backup
delete -- Log file(s) for delete, move to backup location
revert -- Revert file(s) from backup, make read-only, and release
opened -- Report all files logged (opened) under client
info -- Report client and database file information
help -- Print this description
Other sub-commands without p4 equivalent:
release -- Remove file from log and delete backup (without revert)
connect -- Perform respective p4 commands for specified file(s) or,
by default, all files logged under client; and release
General options:
-c client -- Specify client name, overriding P4CLIENT and default
-db dbfile -- Specify database (log) file, overriding default
-n -- Do not execute command, just show what would be done
-x file -- Read arguments (filenames) from file, one per line.
If file is '-', read from standard input.
EndOfDescription
# UNIX users: Name this program 'p4e' (or whatever you wish), make it
# executable, and put it somewhere in your path. You may also
# need to modify the path to perl on the first line above.
# Don't have perl? Go to http://language.perl.com
#
# Windows users: This program was tested using ActivePerl, which is
# available for free from http://www.activestate.com
# Run the 'pl2bat' program which comes with ActivePerl to
# convert this program to a batch script, and put the batch
# script somewhere in your path or modify your path accordingly.
#
# Others: This program was written to hopefully work under any platform
# but it has only been tested under UNIX (Linux) and Windows
# (98/NT). I can't guarantee that some adjustments won't have
# to be made to get it to work under other platforms.
#
# All: You may wish to customize the first three subroutines below
# for your system. (But ideally you shouldn't have to.)
#
# Written by Matthew Rees (matthew@marc.com) 26 May, 1999
# Please send your suggestions or bugs, and let me know if you find this useful
# I'm still pretty new to perl...
require 5.004;
local($Windows) = ( $^O =~ /win32/i ? 1 : 0);
local($NoAction) = 0;
local($Usage) =
"Usage: $0 [-n] [-x file] [-db dbfile] [-c client] command [files]\n";
# This subroutine simply returns the name of the directory containing the
# backup files, under the same directory as the file being backed up.
sub BackupDir {
return "P4EBackup" if( $Windows );
return ".p4ebak";
}
# This subroutine returns the name of the client (-c on command line overrides)
sub ClientName {
my($client, $config );
return $client if( $client = $ENV{P4CLIENT});
$client = &GetClientFromConfig($config) if( $config = $ENV{P4CONFIG} );
if( $Windows && !$client ) {
local($HKEY_CURRENT_USER, $srv, %vals);
require Win32::Registry;
if($HKEY_CURRENT_USER->Open("Software\\Perforce\\Environment", $srv) &&
$srv->GetValues(\%vals)) {
$client = $vals{'p4client'}[2] || $vals{'P4CLIENT'}[2];
if( !$client &&
($config=$vals{'p4config'}[2] || $vals{'P4CONFIG'}[2]) ) {
$client = &GetClientFromConfig($config);
}
$HKEY_CURRENT_USER->Close();
}
}
return $client if ($client);
$client = $ENV{HOSTNAME} || $ENV{HOST};
($client) = gethostbyname('localhost') unless ($client);
$client =~ s/^(\w+)\.?.*/$1/ if ($client); # Take only up to first dot
die "Error: Missing client name. \n" unless ($client);
return $client;
}
# This subroutine returns the name of the file used to log p4e activity.
# It logically should be located in the user's home directory, but of course
# the concept of 'home directory' is not universal across all OS's.
sub DBFileName {
my($home) = $ENV{HOME} || $ENV{LOGDIR} || $ENV{HOMEPATH};
use File::Spec;
my($root, $name, $t1);
unless( $home ) {
if( $Windows ) {
use Cwd;
($root) = cwd() =~ m!^(\w:)!; # Current drive letter (i.e. 'C:')
$name = getlogin();
if( ($name && -d ($t1=File::Spec->catdir($root, "Users", $name)))
or ( -d ($t1=File::Spec->catdir( $root, "My Documents" ))) ) {
$home = $t1;
}
} else {
$home = (getpwuid($<))[7];
}
}
die "Error: Cannot determine home directory for locating the " .
"database file. \n" unless ($home);
$name = ( $Windows ? "P4Edb" : ".p4e" );
return File::Spec->catfile($home, $name);
}
### Hopefully you shouldn't have to customize anything below here ####
###############################################################################
###############################################################################
sub ParseInput {
my ($arg, $cmd, $infile, $i, $client, $dbfile, $file);
local(*FILE);
while ($arg = shift(@ARGV)) {
if( $arg eq "-db" ) {
unless ($dbfile = shift(@ARGV)) { die $Usage; }
next;
}
if( $arg eq "-c" ) {
unless ($client = shift(@ARGV)) { die $Usage; }
next;
}
if( $arg eq "-n" ) { $NoAction = 1; next; }
if( $arg eq "-x" ) {
unless ($infile = shift(@ARGV)) { die $Usage; }
next;
}
if( $arg =~ /^-.*/ ) {
warn "$0: Unrecognized option $arg \n";
next;
}
if( ! $cmd ) {
$cmd = $arg;
next;
}
push( @files, $arg );
}
if(! $cmd) { die $Usage; }
if( $infile ) { # Note: if file is '-' perl reads from STDIN
open( FILE, $infile ) or die "Could not open $infile! \n";
while(<FILE>) {
($file) = /^\s*(\S+)/; # Take only the first word on each line
push(@files, $file) if $file;
}
close( FILE );
}
use Cwd 'abs_path';
use File::Basename;
use File::Spec;
for($i = 0; $i <= $#files; $i++) {
$file = $files[$i];
my($name, $path) = fileparse($file);
unless ($name && $path) { die "Error parsing filename $file! \n"; }
$file = File::Spec->catfile( abs_path($path), $name );
splice( @files, $i, 1, ($file) );
}
return ($cmd, $dbfile, $client, @files);
}
###############################################################################
# Attempt to find a config file and get the client from it.
sub GetClientFromConfig {
my($config) = @_;
my($client);
use Cwd;
use Cwd 'abs_path';
use File::Spec;
my($dir) = cwd();
my($file, $tfile);
while( -d $dir) {
$dir = abs_path( $dir );
$tfile = File::Spec->catfile( $dir, $config );
if( -f $tfile ) { $file = $tfile; last; }
last if( $dir eq File::Spec->rootdir() or
($Windows && $dir =~ m!^\w:[/\\]$!) );
$dir = File::Spec->catfile( $dir, File::Spec->updir() );
}
if( $file ) {
local(*FILE);
open(FILE, $file) or die "Can't open $file! \n";
while(<FILE>) {
my($var,$val) = m!(\w+)\s*=\s*(\S+)!;
if($var eq "P4CLIENT" && $val) { $client = $val; last; }
}
close(FILE);
}
return $client;
}
###############################################################################
# Check that all the files in the given list in fact exist
sub CheckFiles {
my(@files) = @_;
my($i, $file);
for( $i = 0; $i <= $#files; $i++ ) {
$file = $files[$i];
die "File $file does not exist! \n" unless( -f $file );
}
}
###############################################################################
# Create an associative array of action/file pairs by reading the dbfile.
sub ReadDB {
my($dbfile, $client) = @_;
my(%list, $action, $p4file);
local(*FILE);
if(open(FILE, $dbfile)) {
while(<FILE>) { last if( m/^\#\s*$client\s*$/ ); }
while(<FILE>) {
last if( m/^\#/ );
my($line) = $_;
chomp($line);
($action, $p4file) = split(/\s+/, $line, 2);
$list{$p4file} = $action;
}
} elsif (-f $dbfile) {
die "Error: db file $dbfile found but could not be opened! \n";
}
return %list;
}
###############################################################################
# Write out the given associate array of action/file pairs to the dbfile.
sub WriteDB {
my($dbfile, $client, %list) = @_;
return 1 if( $NoAction );
my($file, $action, $i);
local(*FILE);
my(@otherlines) = ();
return if( ! -f $dbfile and ! %list );
if(open(FILE, $dbfile)) {
while(<FILE>) {
if( m/^\#\s*$client\s*$/ ) {
while(<FILE>) { if( m/^\#/ ) { push(@otherlines, $_); last; } }
} else {
push(@otherlines, $_);
}
}
close(FILE);
} else {
if( -f $dbfile ) { die "Failed while opening $dbfile! \n"; }
}
if( $#otherlines < 0 and ! %list ) {
unlink($dbfile);
return;
}
open(FILE, ">$dbfile") or die "Failed while opening $dbfile! \n";
print FILE "# $client \n" if (%list);
foreach $file (sort(keys(%list))) {
print FILE "$list{$file}\t$file\n";
}
while( defined($_ = shift(@otherlines)) ) { print FILE; }
close(FILE);
}
###############################################################################
# Determine the full backup filename for a given file
sub BackupName {
my($file) = @_;
use File::Basename;
use File::Spec;
my($name, $path) = fileparse($file);
unless( $name && $path ) { die "Error parsing filename $file! \n"; }
my($backupdir) = File::Spec->catdir( $path, &BackupDir() );
unless (-d $backupdir || $NoAction || mkdir( "$backupdir", 0777 )) {
die "Cannot create backup directory $backupdir! \n";
}
return (File::Spec->catfile( $backupdir, $name ), $backupdir);
}
###############################################################################
sub Backup {
my($file, $del) = @_;
return 1 if( $NoAction );
unless ( -f $file ) {
die "Error! File \"$file\" does not exist! \n";
}
my($bakfile) = &BackupName( $file );
if( -f $bakfile ) {
print "Backup file $bakfile already exists. Please delete first! \n";
return 0;
}
unless( $del and rename($file, $bakfile) ) {
&Copy( $file, $bakfile );
&Chmod( $bakfile, 0 );
unlink ($file) if ($del);
}
return 1;
}
###############################################################################
sub UnBackup {
my($file) = @_;
return 1 if ( $NoAction );
my($bakfile, $bakdir) = &BackupName( $file );
unless ( -f $bakfile ) {
warn "Backup file $bakfile does not exist! \n";
return 0;
}
unless( &Chmod($bakfile, 1) && unlink( $bakfile ) ) {
warn "Warning: Failed to remove backup file $bakfile. \n";
}
rmdir ($bakdir) unless readdir($bakdir);
return 1;
}
###############################################################################
sub Revert {
my($file) = @_;
return 1 if ( $NoAction );
my($bakfile, $bakdir) = &BackupName( $file );
unless ( -f $bakfile ) {
warn "Backup file \"$bakfile\" does not exist! \n";
return 0;
}
unless( rename($bakfile, $file) ) {
&Copy( $bakfile, $file );
unless( &Chmod($bakfile, 1) && unlink( $bakfile ) ) {
warn "Warning: Failed to remove backup file $bakfile. \n";
}
}
rmdir ($bakdir) unless readdir($bakdir);
&Chmod( $file, 0 );
return 1;
}
###############################################################################
sub Copy {
my($file1, $file2) = @_;
return 1 if ($NoAction);
use File::Copy;
unless( copy( $file1, $file2 ) ) {
die "Error! Could not copy $file1 to $file2! \n";
}
}
###############################################################################
# Make the given file writeable/read-only
sub Chmod {
my($file, $writable) = @_;
return 1 if ($NoAction);
my($mode) = (-x $file ? ($writable ? 0777 : 0555) :
($writable ? 0666 : 0444) );
unless( chmod( $mode, $file ) ) {
warn "Failed setting file permissions for $file. \n";
return 0;
}
return 1;
}
##################### MAIN #################################################
my($command, $dbfile, $client, @files) = &ParseInput;
if( $command eq "help" ) {
print $Description;
exit 0;
}
$client = &ClientName unless ($client);
$dbfile = &DBFileName unless ($dbfile);
if( $command eq "info" ) {
print "Perforce Emulator \n",
"Client: $client \n",
"Database file: $dbfile \n";
exit 0;
}
my(%list) = &ReadDB( $dbfile, $client );
my($i, $action, $file);
my($count) = 0;
if( $command eq "add" ) {
if( $#files < 0 ) { die $Usage; }
&CheckFiles( @files );
for($i = 0; $i <= $#files; $i++) {
$file = $files[$i];
if( $action = $list{$file} ) {
warn "File $file already opened for $action. \n";
next;
}
$list{$file} = "add";
print "$file --opened for add \n";
$count++;
}
&WriteDB( $dbfile, $client, %list ) if ($count);
exit 0;
}
if( $command eq "edit" ) {
if( $#files < 0 ) { die $Usage; }
&CheckFiles( @files );
for($i = 0; $i <= $#files; $i++) {
$file = $files[$i];
if( $action = $list{$file} ) {
warn "File $file already opened for $action. \n";
next;
}
unless (&Backup( $file, 0 )) { next; }
Chmod( $file, 1 );
$list{$file} = "edit";
print "$file --opened for edit \n";
$count++;
}
&WriteDB( $dbfile, $client, %list ) if ($count);
exit 0;
}
if( $command eq "delete" ) {
if( $#files < 0 ) { die $Usage; }
&CheckFiles( @files );
for($i = 0; $i <= $#files; $i++) {
$file = $files[$i];
if( $action = $list{$file} ) {
warn "File $file already opened for $action. \n";
next;
}
unless (&Backup( $file, 1 )) { next; }
$list{$file} = "delete";
print "$file --opened for delete \n";
$count++;
}
&WriteDB( $dbfile, $client, %list ) if ($count);
exit 0;
}
if( $command eq "revert" ) {
if( $#files < 0 ) { die $Usage; }
for($i = 0; $i <= $#files; $i++) {
$file = $files[$i];
unless( $action = $list{$file} ) {
warn "File $file not opened on client $client. \n";
next;
}
unless ($action eq "add" or &Revert($file)) { next; }
delete( $list{$file} );
print "$file --was $action, reverted \n";
$count++;
}
&WriteDB( $dbfile, $client, %list ) if ($count);
exit 0;
}
if( $command eq "release" ) {
if( $#files < 0 ) { die $Usage; }
for( $i = 0; $i <= $#files; $i++) {
$file = $files[$i];
unless( $action = $list{$file} ) {
warn "File $file not opened on client $client. \n";
next;
}
&UnBackup($file);
delete( $list{$file} );
print "$file --was $action, released \n";
$count++;
}
&WriteDB( $dbfile, $client, %list ) if ($count);
exit 0;
}
if( $command eq "opened" ) {
unless (%list) {
warn "No files opened on client $client \n";
exit 0;
}
if( $#files >= 0 ) {
for($i = 0; $i <= $#files; $i++) {
if( $action = $list{$files[$i]} ) {
print "$files[$i] --opened for $action \n";
} else {
warn "File $file not opened on client $client \n";
}
}
}
else {
while(($file, $action) = each(%list)) {
print "$file --opened for $action \n";
}
}
exit 0;
}
if( $command eq "connect" ) {
if( ! %list ) {
warn "No files opened on client $client \n";
exit 0;
}
my(%worklist);
if( $#files >= 0 ) {
for($i = 0; $i <= $#files; $i++) {
$file = $files[$i];
if( $action = $list{$file} ) {
$worklist{$file} = $action;
}
else {
warn "File $file not opened on client $client. \n";
}
}
}
else {
%worklist = %list;
}
# It would be much more efficient for Perforce if all adds, edits, and
# deletes were processed together (p4 add <filelist>; p4 edit <filelist>..)
# but I want to know _which_ ones succeed so that those are released
# and those that fail remain "opened" by this program.
my($exitcode) = 0;
foreach $file (sort(keys(%worklist))) {
$action = $worklist{$file};
print "p4 -c $client $action $file \n";
next if $NoAction;
if( system( "p4 -c $client $action $file" ) ) {
warn "$0: Error code returned from p4 \n";
warn "$0: Halting connect before completion due to error.\n"
if( $count < keys(%worklist)-1 );
$exitcode = 1;
last;
} else {
delete( $list{$file} );
&UnBackup($file) unless( $action eq "add" );
$count++;
}
}
&WriteDB( $dbfile, $client, %list ) if ($count);
exit $exitcode;
}
die "$0: Unrecognized command - $command \n";
exit;