#!/usr/local/bin/perl
#
# $Id: //guest/sandy_currier/utils/p4save.pl#3 $
#
#
# 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'} =~ /cygwin/i) {
# ugh - a cygwin perl
$Platform{'os'} = "unix";
$Platform{'pd'} = '/';
$Platform{'p4glue'} = "-d `cygpath -aw \${PWD}`";
}
elsif ($Platform{'os'}=~/Win/i) {
#########################
# win32
#########################
if (exists($ENV{'BASH'}) or $ENV{'OSTYPE'} eq "cygwin") {
# ugh - a windows perl running in a cygwin environment
die "Window's perl not supported under cygwin environment - use [/cc]/usr/local/bin/perl instead\n";
} else {
$Platform{'os'} = "win32";
$Platform{'pd'} = '\\';
}
} 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 $Platform{'p4glue'}"; # the p4 command to execute
$verbose = 0;
$err = "***";
$metadata = "";
$metaroot = "//depot/metadata";
$client_p = $label_p = $branch_p = $admin_p = 0;
$jobs_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,admin].
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
-n Will not submit the change - will leave
any changed/added files in the default change
-admin Will save off admin metadata, such as the
protect table, filetypes, triggers, groups, etc.
-jobs If -admin is set and if -jobs is set, will save
out all jobs. (def = $jobs_p)
";
#
# 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) {
$nosubmit = 1;
$i++;
}
elsif ($ARGV[$i] =~ /^-admin/i) {
$admin_p = 1;
$i++;
}
elsif ($ARGV[$i] =~ /^-jobs/i) {
$jobs_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);
&mychomp(\@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) {
if ($nosubmit) {
print STDOUT "Leaving $hit_p file(s) opened...\n";
exit 0;
}
else {
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'";
}
&mychomp(\@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/groups/$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);
# now save out the typemap file
@spec = &ExecuteP4Cmd("$P4 typemap -o", $verbose);
if (grep(/^error:/, @spec) or $?) {
die "Could not execute '$P4 typemap -o";
}
&AddorEditAndStuffFile("$metaroot/admin/typemap.table", \@spec, \@depotfilelist);
# now save out the trigger file
@spec = &ExecuteP4Cmd("$P4 triggers -o", $verbose);
if (grep(/^error:/, @spec) or $?) {
die "Could not execute '$P4 triggers -o";
}
&AddorEditAndStuffFile("$metaroot/admin/trigger.table", \@spec, \@depotfilelist);
# now save out the job specs
if ($jobs_p) {
my(@jobs) = &ExecuteP4Cmd("$P4 jobs", $verbose);
if ($?) {
die "Could not execute '$P4 jobs'";
}
&mychomp(\@jobs);
# now save out each group
foreach my $job (@jobs) {
$job =~ s|^(\S+)\s.*$|$1|;
@spec = &ExecuteP4Cmd("$P4 job -o $job", $verbose);
if ($?) {
die "Could not execute '$P4 job -o $job'";
}
# either add or edit and stuff the file
&AddorEditAndStuffFile("$metaroot/jobs/$job.spec", \@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);
}
# something to chew windows and unix trailings off
sub mychomp{
my($ptr) = @_;
if (ref($ptr) eq "ARRAY") {
foreach my $s (@$ptr) {
$s =~ s|[\n\r]*$||;
}
}
elsif (ref($ptr) eq "SCALAR") {
$$ptr =~ s|[\n\r]*$||;
}
else {
die "internal error - unknown reference to mychomp\n";
}
return;
}