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#3 $
#
#
# Copyright (c) 2000, Sandy Currier ([email protected])
# 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
$directory = ""; # the directory 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 [directory] [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:
directory 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. If null, the CWD is used.
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) {
$directory = $ARGV[$i];
$i++; $param++;
}
# snarf second arg
elsif ($param == 1) {
$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 "\nThe import can search the entire client spec\n";
print "for new (to be added), deleted, and edited files.\n";
print "Since this could take a VERY long time (many minutes), you\n";
print "may want to limit the scope (and time) by specifying a more\n";
print "limiting directory (such as foo/bar or c:/foo/bar)\n";
print "\nNOTE: depot syntax is not supported here\n";
print "Directory to import: [default = $cwd] (q to quit) ";
# read input
unless ($noprompt or $directory) {
$input = <STDIN>;
chomp($input);
if ($input eq "") { # use the default
$input = "$cwd";
}
elsif ($input =~ /^q$/i) {
# quit
exit(1);
}
$directory = $input;
}
$directory = &other2unix($directory);
# test it or just let it slowly die?...
if ($directory =~ /^\/\/$clientname\//) {
# a client spec
$clientspec_p = 1;
}
else {
# a real directory
$clientspec_p = 0;
# test it
if (! -d $directory) {
print STDERR "$err the supplied directory ($directory) 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 = $directory;
# 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);
}