#!/usr/bin/perl -w
# $Header: //guest/matthew_rees/p4e/p4e.pl#2 $

# 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:
  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
  release        -- Remove file from log and delete backup (without revert)
  help           -- Print this description
  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 this 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;