[p4] [Newbie Question] Evaluating Perforce

Stephen Vance steve at vance.com
Fri Oct 19 14:47:57 PDT 2001


At 12:02 PM 10/19/2001 -0500, divya at cig.mot.com wrote:

>Hi all,
>
>Please excuse the real basic nature of these questions, but I
>was unable to grok the user guides for answers to this issue.
>
>I want to evaluate Perforce for smaller groups of mobile users
>and a typical setup would consist of a central Windows 2000 Server
>machine hosting the depot and users connecting to this depot
>over the LAN or via Dialup to co and ci files. The users do
>most of their work on thir laptops in a disconnected mode.
>
>How can this be set up? Do I need to get a demo license to set this
>up on a trial basis? The quickstart user guides seem to assume that
>the client and server are on the same host.

You only need a demo license if you want more than two users or two client 
workspaces.

That quickstart assumption is only a convenience for a quick start.  It 
really doesn't impact.

>Any ideas and advice would be greatly appreciated.

For disconnected use, tech note #2 works well, as Rusty pointed out.

Another tool that used to be around is p4e, the Perforce emulator.  It 
gives you one changelists worth of open, edit, and delete with revert 
capability.  Once you reconnect, you simply issue 'p4e connect' and it 
replays the transactions to the server.  It's a Perl script, so it requires 
Perl for NT, but it worked well when I used it.  I've attached the copy I 
downloaded long ago.  Search the mailing list for its original location for 
a possible update.


Stephen Vance
mailto:steve at vance.com
http://www.vance.com/
-------------- next part --------------
@rem = '--*-Perl-*--
@echo off
if "%OS%" == "Windows_NT" goto WinNT
perl -x -S "%0" %1 %2 %3 %4 %5 %6 %7 %8 %9
goto endofperl
:WinNT
perl -x -S "%0" %*
if NOT "%COMSPEC%" == "%SystemRoot%\system32\cmd.exe" goto endofperl
if %errorlevel% == 9009 echo You do not have Perl in your PATH.
goto endofperl
@rem ';
#!/usr/bin/perl -w
#line 14
# $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 at 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;

__END__
:endofperl
-------------- next part --------------
#!/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 at 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;



More information about the perforce-user mailing list