eval '(exit $?0)' && eval 'exec perl -S $0 ${1+"$@"}'
  & eval 'exec perl -S $0 $argv:q'
  if 0;
#  THE PRECEEDING STUFF EXECS perl via $PATH

#
# $Id: //guest/sandy_currier/utils/p4import.pl#1 $
#

#
# Copyright (c) 2000, Sandy Currier (sandy@releng.com)
# Distributed under the GNU GENERAL PUBLIC LICENSE:
#
#      This program is free software; you can redistribute it and/or modify
#      it under the terms of the GNU General Public License as published by
#      the Free Software Foundation; either version 1, or (at your option)
#      any later version.
#
#      This program is distributed in the hope that it will be useful,
#      but WITHOUT ANY WARRANTY; without even the implied warranty of
#      MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
#      GNU General Public License for more details.
#
#      You should have received a copy of the GNU General Public License
#      along with this program; if not, write to the Free Software Foundation,
#      Inc., 59 Temple Place, Suite 330, Boston, MA 02111-1307, USA.
#

#
# This script will import new, deleted, and edited changes
# from a disconnected p4 client.
#
# Another application is to import incoming changes from a 3rd
# party not using perforce.
#

#
# This is just a coded version of Technical Note #2
#

# first, see if unix or NT or what...
# need a recent version of perl on NT to have win32 module/config stuff
BEGIN: {
    require 5.004;
    unless ($Platform{'os'}) {
	unless ($Platform{'os'} = $^O) {
	    require Config;
	    $Platform{'os'} = $Config::Config{'osname'};
	}
    }
    # bottom layer OS specific variables/constants
    if ($Platform{'os'}=~/Win/i) {
	#########################
	# win32
	#########################
	$Platform{'os'} = "win32";
	$Platform{'pd'} = '\\';
    } elsif ($Platform{'os'}=~/vms/i) {
	#########################
	# vms
	#########################
	die "vms is currently not a supported platform";
    } elsif ($Platform{'os'}=~/os2/i) {
	#########################
	# os2
	#########################
	die "os2 is currently not a supported platform";
    } elsif ($Platform{'os'}=~/Mac/i or (defined($MacPerl::Version) and $MacPerl::Version)) {
	#########################
	# mac
	#########################
	$Platform{'pd'} = ':';	# use this in pathname pattern matching (mac)
	die "macintosh is currently not a supported platform";
    } else {
	#########################
	# unix
	#########################
	$Platform{'os'} = "unix";
	$Platform{'pd'} = '/';
    }
}

#
# Unbuffer STDERR and STDOUT
select(STDERR);
$| = 1;			# Make STDERR be unbuffered.
select(STDOUT);
$| = 1;			# STDOUT too so, they can mix.

#
# set up some globale
# Note: assume that the PATH EV is going to be used to find p4
$P4 = "p4";			# the p4 command to execute (can either be
				# absolute or relative)
$ThisCmd = "p4import.pl";	# this command name
@info = ();			# the output of p4 info
$clientname = "";		# the "Client name: "
$clientroot = "";		# the "Client root: "
$cwd = "";			# the current working directory
$filespec = "";			# the filespec to use
$unknowns = $edits = $deletes = $adds = 0;	# for summeries
$diffck = "ae";
$noprompt = 0;
$vb = ">>>";
$err = "***";

#
# now parse any args
# the usage message (for -h or on error)
$help = "$ThisCmd [filespec] [diffck] [options...]
Function:
    This command will verify a disconnected Perforce client workspace
    nominally for new, deleted, and modified files.  $ThisCmd
    can also be used to import a new distribution from a
    third party vendor.

Args:
    filespec         A directory to limit the scope of the import.
                     An import may take a LONG time if an entire client
                     directory space is chosen.  If the argument is
                     a relative path, it is taken from the current
                     working directory.
    diffck           A string composed of the characters a, d, and
                     e (for added, deleted, and edited).  Specifying
                     a character enables that part of the import.
                     For client workspaces, this is normally 'ade'.
                     For safety, the default is set to '$diffck'.
                      
Switches/Options:
    -h               Prints this help message
    -noprompt        Will not prompt for user input
";

# parse command line
{
    my($i,$param);
    while($i <= $#ARGV) {
	# scan for a help switch
	if ($ARGV[$i] =~ /^-h/i) {
	    &DieHelp("", $help);
	}
	# scan for switches
	elsif ($ARGV[$i] =~ /^-noprompt/i) {
	    $noprompt = 1;
	    $i++;
	}
	# scan for variable definitions (-variable value)
	elsif ($ARGV[$i] =~ /^-\w+/ and defined($ARGV[$i+1]) and $ARGV[$i+1] !~ /^-[^-]/) {
	    # NOTE: nt has a difficult time with '=' on a command line...
	    # process any variable value switches
	    my($var) = $ARGV[$i];
	    $var =~ s/^-//;
	    my($value) = $ARGV[$i+1];
	    if (defined $$var) {
		$$var = $value;
	    }
	    else {
		&DieHelp("Unknown parameter '$var'\n", $help);
	    }
	    $i=$i+2;
	}
	# catch unsupported switches
	elsif ($ARGV[$i] =~ /^-/) {
	    &DieHelp("Unsupported switch \"$ARGV[$i]\"\n", $help);
	}
	# snarf first arg
	elsif ($param == 0) {
	    $filespec = $ARGV[$i];
	    $i++; $param++;
	}
	# snarf second arg
	elsif ($param == 0) {
	    $diffck = $ARGV[$i];
	    $i++; $param++;
	}
	else {
	    &DieHelp("Extra args: @ARGV\n", $help);
	}
    }
}


#
# make sure that the correct client is selected
{
    my($client_string) = "Client name: ";
    my($root_string) = "Client root: ";
    my($cwd_string) = "Current directory: ";
    my(@tmp);
    @info = `$P4 info 2>&1`;
    if ($?) {
	die "$ThisCmd - could not execute '$P4 info'\n$info";
    }
    chomp(@info);
    # now get client name
    @tmp = grep(/^$client_string/,@info); # grep out the client name
    $clientname = &other2unix($tmp[0]);	# transfer to a scalar
    $clientname =~ s/^$client_string//; # ditch the uninteresting part
    if ($clientname eq "") {	# check things
	die "$ThisCmd - something wrong - no client name found from p4 info output";
    }
    # get the client root
    @tmp = grep(/^$root_string/,@info); # grep out the client name
    $clientroot = &other2unix($tmp[0]);	# transfer to a scalar
    $clientroot =~ s/^$root_string//; # ditch the uninteresting part
    if ($clientroot eq "") {	# check things
	die "$ThisCmd - something wrong - no client name found from p4 info output";
    }
    # get the cwd
    @tmp = grep(/^$cwd_string/,@info); # grep out the client name
    $cwd = &other2unix($tmp[0]);	# transfer to a scalar
    $cwd =~ s/^$cwd_string//; # ditch the uninteresting part
    if ($cwd eq "") {	# check things
	die "$ThisCmd - something wrong - no cwd found from p4 info output";
    }
}

#
# ask about limiting the entire depot
{
    my($input);
    print "$vb\n";
    foreach (@info) {
	print "$vb $_\n";
    }
    print "$vb\n";
    print "\nBy default, the import will search the entire client spec\n";
    print "for new (to be added), deleted, and edited files.\n";
    print "NOTE: this could take a VERY long time (many minutes)\n";
    print "You can limit the scope (and time) by specifying a more\n";
    print "limiting directory (such as foo/bar/... or c:/foo/...)\n";
    print "\nNOTE: depot syntax is not supported here\n";
    print "Change filespec to: [default = $cwd] (q to quit) ";
    # read input
    unless ($noprompt or $filespec) {
	$input = <STDIN>;
	chomp($input);
	if ($input eq "") {	# use the default
	    $input = "$cwd";
	}
	elsif ($input =~ /^q$/i) {
	    # quit
	    exit(1);
	}
	$filespec = $input;
    }
    $filespec = &other2unix($filespec);
    # test it or just let it slowly die?...
    if ($filespec =~ /^\/\/$clientname\//) {
	# a client spec
	$clientspec_p = 1;
    }
    else {
	# a real directory
	$clientspec_p = 0;
	# test it
	if (! -d $filespec) {
	    print STDERR "$err the supplied directory ($filespec) is not a valid directory\n";
	    exit(1);
	}
    }
}

#
# determine new files
# though this could be coded natively in perl, but since a single
# p4 command has to be invoked anyway, might as well invoke
# the entire thing in a sub-shell process anyway...
# Note: as a side effect, this step will cd into the correct directory!

# but first, grab some statistics
$script = "$P4 opened";
@oldfiles = `$script`; # ignore errors
chomp(@oldfiles);

# now, create the best place to cd into
$destdir = $filespec;
# replace clientname with a real dir if a clientspec is being used
$destdir =~ s/^\/\/$clientname/$clientroot/;
print "$err Note: cd'ing to $destdir\n";
$tmp = chdir $destdir;
unless ($tmp) {
    die "$ThisCmd - could not cd to $destdir\n$!";
}
if ($diffck =~ /a/) {
    if ($Platform{'os'} eq "unix") {
	$script = "find . -type f -print | $P4 -x - add";
	print "$\nvb\n$vb Running: $script\n$vb\n";
	$tmp = system($script);
	# ignore errors for now...
	if (0) {
	    # now what - just keep going
	    print STDERR "$ThisCmd - something happened with p4 add...\n$tmp\n";
	}
    }
    elsif ($Platform{'os'} eq "win32") {
	$script = "dir /s /b | $P4 -x - add";
	print "\n$vb\n$vb Running: $script\n$vb\n";
	$tmp = system($script);
	# ignore errors for now...
	if (0) {
	    # now what - just keep going
	    print STDERR "$ThisCmd - something happened with p4 add...\n$tmp\n";
	}
    }
    else {
	die "$ThisCmd - unknown os";
    }
}

#
# determine deleted files
if ($diffck =~ /d/) {
    $script = "p4 diff -sd ... | $P4 -x - delete";
    print "\n$vb\n$vb Running: $script\n$vb\n";
    $tmp = system($script);
    if ($tmp) {
	# now what - just keep going
	print STDERR "$ThisCmd - something happened with p4 delete...\n$tmp\n";
    }
}

#
# determine edited files
if ($diffck =~ /e/) {
    $script = "p4 diff -se ... | $P4 -x - edit";
    print "\n$vb\n$vb Running: $script\n$vb\n";
    $tmp = system($script);
    if ($tmp) {
	# now what - just keep going
	print STDERR "$ThisCmd - something happened with p4 delete...\n$tmp\n";
    }
}
 
#
# print some statistics?...
$script = "$P4 opened";
@newfiles = `$script`; # ignore errors
chomp(@newfiles);
# compare the old with the new, and print something
# construct a hash
foreach (@newfiles) {
    # let the entire string be the key
    if (!defined($new{$_})) {
	$new{$_} = 1;
    }
}
# delete from the hash anything that matches from @oldfiles
foreach (@oldfiles) {
    if (defined($new{$_})) {
	delete $new{$_};
    }
}
# catagorize what is left, and print
foreach (keys(%new)) {
    my($file, $string) = split(/\#[0-9]+ - /);
    if ($string =~ /^edit/) {
	$edits++;
    }
    elsif ($string =~ /^add/) {
	$adds++;
    }
    elsif ($string =~ /^delete/) {
	$deletes++;
    }
    else {
	$unknowns++;
    }
}
print "Summary: added $adds file(s), deleted $deletes file(s), edited $edits file(s)\n";
print "unknown files: $unknowns\n" if ($unknowns);

#
# the end
exit(0);

# will convert a random OS delimited pathname to a perl pathname
sub other2unix {
    my($filename) = @_;
    my($pattern) = $Platform{'pd'};
    $pattern =~ s/(\W)/\\$1/g;	# escape wildchars
    $filename =~ s|$pattern|/|g;
    return("/") if ($filename =~ /^\/+$/); # if just /+, return just /
    if ($filename =~ /^\/\//) {
	# add them back in later
	$filename =~ s|/+|/|g;	# remove doubles
	$filename = "/$filename";
    }
    else {
	$filename =~ s|/+|/|g;	# remove doubles
    }
    # remove trailing
    $filename =~ s|/+$||;
    return($filename);
}

sub DieHelp {
    my($str, $help) = @_;
    print STDERR "$err $str\nUsage: $help";
    exit(2);
}