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/p4save.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.
#

# 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'};
	    $Platform{'os'} = $Config::Config{'osname'};
	}
    }
    # bottom layer OS specific variables/constants
    if ($Platform{'os'}=~/Win/i) {
	#########################
	# win32
	#########################
	require Win32;		# need &Win32::IsWinNT()
	$Platform{'os'} = "win32";
	$Platform{'pd'} = '\\';
	if (&Win32::IsWinNT()) {
	    $Platform{'nt'} = 1;
	}
	else {
	    $Platform{'nt'} = 0;
	}
    } 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

#
# set up some globals
$ThisCmd = "p4save"; # this command name

#
# local variables
$P4 = "p4";
$verbose = 0;
$err = "***";
$metadata = "";
$metaroot = "//depot/metadata";
$client_p = $label_p = $branch_p = $admin_p = 0;

#
# now parse any args
# the usage message (for -h or on error)
$help = "$ThisCmd metadate
Function:
    $ThisCmd will save the state of the metadata argument in
    perforce.  $ThisCmd does this by versioning the metadata
    in $metaroot/[clients,labels,branches].

    For clients, the client spec is saved as the filename
    client.spec, and the have table is saved as client.have.
    Executing \"p4 -x client.have sync\" will sync a client
    to this saved state.

    For labels, the label spec is saved as label.spec, and the
    have table is saved as label.have.

    For branch specs, the branchspec is saved as branch.spec.

    For admin metadata, namely groups and the protection table,
    this metadata is saved $metaroot/admin/... 

    NOTE: $ThisCmd uses the default changeset and expects it
    to be empty.

Args:
    metadata        The metadata object that needs to be saved.
                    $ThisCmd should be able to determine the
                    type of the metadata without user input.
                      
Switches/Options:
    -h              Prints this help message
";

#
# parse command line
{
    my($i) = 0;
    while($i <= $#ARGV) {
	# scan for a help switch
	if ($ARGV[$i] =~ /^-h/i) {
	    &DieHelp("", $help);
	}
	# scan for switches
	elsif ($ARGV[$i] =~ /^-n/i) {
	    $printonly = 1;
	    $i++;
	}
	elsif ($ARGV[$i] =~ /^-admin/i) {
	    $admin_p = 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) {
	    $metadata = $ARGV[$i];
	    $i++; $param++;
	}
	else {
	    &DieHelp("Unsupported argument \"$ARGV[$i]\"\n", $help);
	}
    }
}

#
# see if there is an
&DieHelp("Must specify a piece of metadata to save") unless ($metadata or $admin_p);

#
# get the clients, labels, and branches
@RawClients = &ExecuteP4Cmd("$P4 clients", $verbose);
if ($?) {
    die "Could not execute '$P4 clients'";
}
@RawLabels = &ExecuteP4Cmd("$P4 labels", $verbose);
if ($?) {
    die "Could not execute '$P4 labels'";
}
@RawBranches = &ExecuteP4Cmd("$P4 branches", $verbose);
if ($?) {
    die "Could not execute '$P4 branches'";
}

# prune them
foreach (@RawClients) {
    /^Client (.+) [0-9]{4}\/[0-9]{2}\/[0-9]{2} /;
    push @Clients, $1;
}
foreach (@RawLabels) {
    /^Label (.+) [0-9]{4}\/[0-9]{2}\/[0-9]{2} /;
    push @Labels, $1;
}
foreach (@RawBranches) {
    /^Branch (.+) [0-9]{4}\/[0-9]{2}\/[0-9]{2} /;
    push @Branches, $1;
}
# verify that $metadata matches one of them
$safe_metadata = quotemeta($metadata);
if (grep(/^$safe_metadata$/, @Clients)) {
    $client_p = 1;
}
if (grep(/^$safe_metadata$/, @Labels)) {
    $label_p = 1;
}
if (grep(/^$safe_metadata$/, @Branches)) {
    $branch_p = 1;
}
# test
if ($client_p + $label_p + $branch_p > 1) {
    &DieHelp("Error: the supplied metadata ($metadata) is not unique.");
}

#
# decide which way to go...
if ($admin_p) {
    &SaveAdmin();
}
elsif ($client_p) {
    &SaveClient($metadata);
}
elsif ($label_p) {
    &SaveLabel($metadata);
}
elsif ($branch_p) {
    &SaveBranch($metadata);
}

#
# the end
exit(0);


#
# subroutines
#

#
# either exit or submit 
sub ExitOrSubmit {
    my($arrayref) = @_;
    my($hit_p) = 0;
    # note: opened returns files in depot syntax
    my(@output) = &ExecuteP4Cmd("$P4 -s opened", $verbose);
    chomp(@output);
    my(@files) = grep(/^info:.* default change /, @output);
    foreach my $file (@files) {
	$file =~ s|^info: ||;	# remove info: token
	$file =~ s|\#.*$||;	# remove revision stuff
	my($safefile) = quotemeta($file);
	$hit_p++ if (grep(/^$safefile$/, @{$arrayref})); # only delete our files
    }
    if ($hit_p) {
	system("$P4 submit");
    }
    else {
	print STDOUT "Nothing to submit - exiting...\n";
	exit 0;
    }
}

# save out the admin state
# assumes that one is superuser
sub SaveAdmin {
    my(@spec, @depotfilelist);
    # first, get the groups
    my(@groups) = &ExecuteP4Cmd("$P4 groups", $verbose);
    if ($?) {
	die "Could not execute '$P4 groups'";
    }
    chomp(@groups);
    # now save out each group
    foreach my $group (@groups) {
	@spec = &ExecuteP4Cmd("$P4 group -o $group", $verbose);
	if ($?) {
	    die "Could not execute '$P4 group -o $group'";
	}
	# either add or edit and stuff the file
	&AddorEditAndStuffFile("$metaroot/admin/$group.spec", \@spec, \@depotfilelist);
    }
    # now save out the protection table
    @spec = &ExecuteP4Cmd("$P4 -s protect -o", $verbose);
    if (grep(/^error:/, @spec) or $?) {
	die "Could not execute '$P4 -s protect -o";
    }
    foreach (@spec) {
	s|^info: ||;		# remove info token
	s|^exit.*$||;		# remove exit line
	s|^\s+super .*$||;	# remove super lines for security...
    }
    &AddorEditAndStuffFile("$metaroot/admin/protect.table", \@spec, \@depotfilelist);
    # exit or submit
    &ExitOrSubmit(\@depotfilelist);
}

# save out client metadata
sub SaveClient {
    my($client) = @_;
    my(@depotfilelist);
    # get the client spec
    my(@clientspec) = &ExecuteP4Cmd("$P4 client -o $client", $verbose);
    if ($?) {
	die "Could not execute '$P4 client -o $client'";
    }
    # get the haves
    my(@haves) = &ExecuteP4Cmd("$P4 files //...\@$client", $verbose);
    if ($?) {
	die "Could not execute '$P4 files //...\@$client'";
    }
    # either add or edit and stuff the file
    &AddorEditAndStuffFile("$metaroot/clients/$client.spec", \@clientspec, \@depotfilelist);
    &AddorEditAndStuffFile("$metaroot/clients/$client.have", \@haves, \@depotfilelist);
    # now submit it (let the form popup)
    &ExitOrSubmit(\@depotfilelist);
}

# save out label metadata
sub SaveLabel {
    my($client) = @_;
    my(@depotfilelist);
    # get the client spec
    my(@clientspec) = &ExecuteP4Cmd("$P4 label -o $client", $verbose);
    if ($?) {
	die "Could not execute '$P4 label -o $client'";
    }
    # get the haves
    my(@haves) = &ExecuteP4Cmd("$P4 files //...\@$client", $verbose);
    if ($?) {
	die "Could not execute '$P4 files //...\@$client'";
    }
    # either add or edit and stuff the file
    &AddorEditAndStuffFile("$metaroot/labels/$client.spec", \@clientspec, \@depotfilelist);
    &AddorEditAndStuffFile("$metaroot/labels/$client.have", \@haves, \@depotfilelist);
    # now submit it (let the form popup)
    &ExitOrSubmit(\@depotfilelist);
}

# save out branch metadata
sub SaveBranch {
    my($client) = @_;
    my(@depotfilelist);
    # get the client spec
    my(@clientspec) = &ExecuteP4Cmd("$P4 branch -o $client", $verbose);
    if ($?) {
	die "Could not execute '$P4 branch -o $client'";
    }
    # either add or edit and stuff the file
    &AddorEditAndStuffFile("$metaroot/branches/$client.spec", \@clientspec, \@depotfilelist);
    # now submit it (let the form popup)
    &ExitOrSubmit(\@depotfilelist);
}

# will push both filelist arrays with the correct file syntax as a side effect...
sub AddorEditAndStuffFile {
    my($filename, $arrayref, $depotfilelistref) = @_;
    my(@output, $safe_filename, $mapping, $add_p);
    push @$depotfilelistref, $filename;
    $safe_filename = quotemeta($filename);
    # see if the client can map the file - exit if cannot
    @output = &ExecuteP4Cmd("$P4 -s where \"$filename\"", $verbose);
    if (grep(/^error:/, @output) or $?) {
	die "This client cannot map the file '$filename':\n@output";
    }
    else {
	# else - save the mapping
	$mapping = $output[0];
    }
    # see if the file exists in the depot
    @output = &ExecuteP4Cmd("$P4 -s files \"$filename\"", $verbose);
    if ($?) {
	die "Could not execute '$P4 -s files \"$filename\"'";
    }
    # file does not exist yet
    if (grep(/^error: .* - no such file\(s\).$/, @output)) {
	$add_p++;
	@output = &ExecuteP4Cmd("$P4 -s add -t text \"$filename\"", $verbose);
	if ($?) {
	    die "Could not execute '$P4 -s add -t text \"$filename\"'";
	}
	if (grep(/^error:/, @output)) {
	    die "'$P4 -s add -t text \"$filename\"' returned an error";
	}
    }
    # file already exists
    else {
	# first, sync to head
	@output = &ExecuteP4Cmd("$P4 -s sync \"$filename\"", $verbose);
	if ((!grep(/^error:.* - file\(s\) up-to-date/, @output) and grep(/^error:/, @output)) or $?) {
	    die "Could not sync file '$filename':\n@output";
	}
	@output = &ExecuteP4Cmd("$P4 -s edit \"$filename\"", $verbose);
	if ($?) {
	    die "Could not execute '$P4 -s edit \"$filename\"'";
	}
	if (grep(/^error:/, @output)) {
	    die "'$P4 -s edit \"$filename\"' returned an error";
	}
    }
    # now stuff it - use the mapping
    {
	my($realfilename, @tmp, $dir);
	if ($Platform{'os'} eq "win32") {
	    @tmp = split(/ ([a-zA-Z]:\\)/, $mapping);
	    if ($#tmp == 2) {
		# the expected number
		$mapping =~ / ([a-zA-Z]:\\)/;
		$realfilename = "$1$tmp[2]";
	    }
	}
	else {
	    @tmp = split(/ \//, $mapping);
	    if ($#tmp == 3) {
		# the expected number
		$realfilename = "/$tmp[3]";
	    }
	}
	unless ($realfilename) {
	    die "Could not determine the workspace mapping to $filename";
	}
	# yech - must create all the parent dirs if they do not exist...
	$dir = &DirName(&dos2unix($realfilename));
	&CreateMissingDirs($dir);
	if (!open(OUT, ">$realfilename")) {
	    die "Could not open '$realfilename' for writing";
	}
	foreach (@{$arrayref}) {
	    print OUT $_;
	}
	close(OUT);
    }
    # now see if it is different enough to not revert
    unless ($add_p) {
	my($dir) = &DirName($filename);
	@output = &ExecuteP4Cmd("$P4 -s diff \"$filename\"");
	if ($?) {
	    die "Could not execute '$P4 -s diff \"$filename\"'";
	}
	if (grep(/^error:/, @output)) {
	    die "'$P4 -s diff \"$filename\"' returned an error";
	}
	# only look at ^< and ^> lines
	@output = grep(/(^<)|(^>)/, @output);
	# now ignore these lines
	@output = grep(!/^[<>] Access:/, @output); # Access lines in client type specs
	@output = grep(!/^[<>] $dir\//, @output); # the filename itself in have type files
	# now if output is not empty, file is different
	if ($#output == -1) {
	    # revert the file
	    @output = &ExecuteP4Cmd("$P4 -s revert \"$filename\"", $verbose);
	    if (grep(/^error:/, @output) or $?) {
		die "Could not revert file $filename\n@output";
	    }
	}
    }
}

# print a help message and die
sub DieHelp {
    my($str, $help) = @_;
    print STDERR "$err $str\nUsage: $help";
    exit(1);
}


#
# Note: this will actually execute any command...
# returns the action of the revision of the specified file#revision
sub ExecuteP4Cmd {
    my($script, $verbose, $print_output, $no_error_check, $stream_p) = @_;
    my(@output);
    if ($stream_p) {
	print $stream_p "$vb\n$vb running: $script\n$vb\n" if ($verbose);
    }
    else {
	print STDOUT "$vb\n$vb running: $script\n$vb\n" if ($verbose);
    }
    if (!$Platform{'nt'} and $Platform{'os'} eq "win32") {
	@output = `$script` unless ($printonly);
    }
    else {
	@output = `$script 2>&1` unless ($printonly);
    }
    if ($stream_p) {
	print $stream_p "@output" if ($print_output);
    } else {
	print STDOUT "@output" if ($print_output);
    }
    if (!$no_error_check and $?) {
	# now what - just keep going
	print STDERR "$err $ThisCmd - something happened with '$script'\n$?";
    }
    return(@output);
}

sub dos2unix {
    my($filename) = @_;
    $filename =~ s|\\|/|g;
    return($filename);
}

sub DirName {
    my($string) = @_;
    # unclear as to what to return when parent dir is null...
    # maybe best thing to do is return null string... yes, this is best
    return("") if ($string !~ /\//);
    $string =~ s|(.*)/[^/]*$|$1|;
    return("$string");
}

sub CreateMissingDirs {
    my($dir, $relative_pname, $notrecord_p, $dirmode) = @_;
    my($newdir, $tmp);
    # if $dirmode is not set, set it
    $dirmode = 0775 unless ($dirmode);

    # if dir is a directory, just return
    return(0) if (-d $dir);

    # just in case, remove double // and trailing /
    $dir =~ s|//+|/|g;
    $dir =~ s|/$||;
    # remove \./
    $dir =~ s|/\./|/|g;

    $newdir = &DirName($dir);
    # may need more recursion (the parent directory must be created)
    if (-l $newdir) {
	# if the parent is a link to a dir, and the dir does not exist,
	# error
	my($srclink) = readlink($newdir);
	if (! -e $srclink) {
	    die "Error: CreateMissingDirs - parent dir ($newdir) is a dangling link to ($srclink)";
	}
	if (! -d $srclink) {
	    die "Error: CreateMissingDirs - parent dir ($newdir) is a link ($srclink) that does not point to a directory";
	    return(1);
	}
    }
    elsif (! -d $newdir) {	# if it is not a directory
	$tmp = &CreateMissingDirs($newdir, $relative_pname, $notrecord_p, $dirmode);
	return(1) if ($tmp);	# if a parent didn't get created, just unravel the recursion
    }
    # at this point, all non-existing parent dirs have been created
    # However, if the path has ".."'s in it, then the current directory
    # might actually now exist.  Just return quietly if it does...
    return(0) if (-d $dir);
    # at this point, the parent does not exist!
    # first, print something
    $tmp = $dir;
    if ($relative_pname) {
	$tmp =~ s|^$relative_pname/||;
    }
    # create the dir 
    $tmp = mkdir($dir, $dirmode);
    if (!$tmp) {
	die "Error: CreateMissingDirs - Unable to mkdir '$dir' (mode=$dirmode)\n$!";
	return(1);
    }
    return(0);
}