p4patch #9

#!/usr/local/bin/perl
# -*-Fundamental-*-

## Notice: this script is not presently considered "done" for public
## distribution; if you do find this, and use it, bear that in mind!
##   - rmg 12/28/2001

## TBD
##
##   - handle indempotentcy when a patch with an edit for F
##     is done after a patch adding F, when there's no submit in between?
##
##   - force type target to match source, or only when it's in the change?
##
##

#  perl_template - please see the comment at the end!

#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

use Carp;
use strict;
$| = 1;

my $Myname;
($Myname = $0) =~ s%^.*/%%;

my $Usage = <<LIT;
$Myname: usage:

  $Myname [<-cdHpPu p4 opts>] -out <change_num> <branch_path> |
    $Myname [<-cdHpPu p4 opts>] [-clean] [-open|-submit]
              [-change default|new|<change_num>] [ <target_root> ]

  -or- "p4patch -p4editor <descfile> <changespec>"
       (for internal use only, i.e., when I call myself!)

LIT


sub usage
{
  print STDERR $Usage;
  exit 1;
}


sub help
{
  print STDERR <<LIT;
$Usage

$Myname operates in one of two modes, "out" or "in".

In either mode, it will accept any of the standard p4 -c, -d, -H, -p,
-P and -u options, to specify the context for accessing a Perforce
server.

"Out" mode is selected by supplying the "-out" option flag; otherwise,
the mode defaults to "in". $Myname can be used in a pipeline, with the
standard output of an "out" mode instance being piped to the standard
intput of an "in" mode instance.

The "out" mode produces a "patchfile", containing enough information
to encapsulate a single changeset in its entirety. The content
consists (essentially) of the output from "p4 describe -du
<change_num>", followed by a cpio archive containing the complete
content of any files in the change that were opened for branch,
integrate, or add.

The "<branch_path>" parameter, which must be in Perforce depot syntax,
gives a path prefix representing the "branch" portion of the pathnames
in the change; this will be stripped from the pathnames in the "p4
describe" output (along with the #<n> revision numbers).

The "in" mode reads a "patchfile" (from the standard input), and
applies the changes it specifies to a "target" local directory tree,
which may also be a Perforce client workspace.

In "in" mode, if the "-open" or "-submit" option is used, then the
target assumed to be a Perforce client workspace, and the appropriate
Perforce commands (required to effect the changes in Perforce) are
executed. With "-open", the files are opened (as required) and the
patches are applied, but no "p4 submit" is done. With "-submit", the
"p4 submit" is executed after the patchfile has been applied.

Further, with "in" mode to a Perforce client workspace, the "-change"
option can be used to specify the changelist to be used. By default,
(or with "-change default") the deafult changelist will be used;
"-change new" will cause a new number changelist to be created used;
and "-change <number>" will caused the named numbered changelist to be
used.

The "<target_root>" parameter specifies, in either local or Perforce
client syntax, the path to the top of the directory tree corresponding
to the <branch_path> in the patchfile.

If neither of "-open" nor "-submit" are explcitly given, but the
<target_root> is in Perforce syntax, then "-open" is assumed.

At this time, only simple, "single-line" mappings are supported, i.e.,
a single <branch_path> with -out, and a single <target_root>

For example: <To Be Written>

LIT
  exit 1;
}

# option switch variables get defaults here...

my $P4CLIENT;
my $PWD;
my $P4HOST;
my $P4PORT;
my $P4PASSWD;
my $P4USER;

my $P4editor = 0;
my $Patchmode = "in";
my $Change = "default";
my $P4mode;
my $Clean = 0; 
my @Args;
my $Args;

while ($#ARGV >= 0)
  {
       if ($ARGV[0] eq "-open")    { $P4mode = "open"; shift; next; }
    elsif ($ARGV[0] eq "-submit")  { $P4mode = "submit"; shift; next; }
    elsif ($ARGV[0] eq "-out")     { $Patchmode = "out"; shift; next; }
    elsif ($ARGV[0] eq "-clean")   { $Clean = 1; shift; next; }
    elsif ($ARGV[0] eq "-p4editor")  { $P4editor = 1; shift; next; }
    elsif ($ARGV[0] eq "-change")
      { shift; if ($ARGV[0] < 0) { &usage; }; $Change = $ARGV[0]; shift; next; }
    elsif ($ARGV[0] eq "-c")
      { shift; if ($ARGV[0] < 0) { &usage; }; $P4CLIENT = $ARGV[0]; shift; next; }
    elsif ($ARGV[0] eq "-d")
      { shift; if ($ARGV[0] < 0) { &usage; }; $PWD = $ARGV[0]; shift; next; }
    elsif ($ARGV[0] eq "-H")
      { shift; if ($ARGV[0] < 0) { &usage; }; $P4HOST = $ARGV[0]; shift; next; }
    elsif ($ARGV[0] eq "-p")
      { shift; if ($ARGV[0] < 0) { &usage; }; $P4PORT = $ARGV[0]; shift; next; }
    elsif ($ARGV[0] eq "-P")
      { shift; if ($ARGV[0] < 0) { &usage; }; $P4PASSWD = $ARGV[0]; shift; next; }
    elsif ($ARGV[0] eq "-u")
      { shift; if ($ARGV[0] < 0) { &usage; }; $P4USER = $ARGV[0]; shift; next; }
    elsif ($ARGV[0] eq "-help")
      { &help; }
    elsif ($ARGV[0] =~ /^-/) { &usage; }
    if ($Args ne "") { $Args .= " "; }
    push(@Args, $ARGV[0]);
    shift;
  }

if ($P4editor)
  {
    # So we can do a
    #   P4EDIT="$Myname -p4edit <descfile>" p4 submit"
    # and be the editor, which just inserts (or appends) the
    # desciption text supplied in $descfile.
    #

    if ($#Args != 1)
      { &fail("wrong number of args for \"-p4edit\" mode!"); }

    my ($descfile, $change) = @Args;

    if (! open(DESC, "<$descfile"))
      { &fail("can't open \"<$descfile\": $!."); }

    if (! open(OCHG, "<$change"))
      { &fail("can't open \"<$change\": $!."); }

    if (! open(NCHG, ">$change.new"))
      { &fail("can't open \">$change.new\": $!."); }

    my $mode = "finddesc";
    my $desc_added = 0;
    while (<OCHG>)
      {
        if (/^Description:/)
          {
            print NCHG;
            $mode = "indesc";
          }
        elsif (/^Files:/)
          { 
	    my $fileshdr = $_;

            while (<DESC>) { print NCHG "\t$_"; }
            close DESC;
            unlink $descfile;
            $desc_added = 1;

            $mode = "infiles";
            print NCHG $fileshdr;
          }
        elsif ($mode eq "indesc")
          {
            # we copy through any existing Description lines...
            if (/^\s<enter description here>$/) { next; } # (well, almost any!)
            print NCHG;
          }
        else # anything else gets copied through unchanged...
          { print NCHG; }
      }

    close OCHG;

    if (! $desc_added)
      {
        while (<DESC>) { print NCHG "\t$_"; }
        close DESC;
        unlink $descfile;
        $desc_added = 1;
      }

    close NCHG;

    if (! rename("$change.new", $change))
      { &fail("can't rename(\"$change.new\", \"$change\"): $!."); }

    exit 0;
  }      


my $P4 = "p4";
if ($P4CLIENT) { $P4 .= " -c $P4CLIENT"; }
if ($PWD)      { $P4 .= " -d $PWD"; }
if ($P4HOST)   { $P4 .= " -H $P4HOST"; }
if ($P4PORT)   { $P4 .= " -p $P4PORT"; }
if ($P4PASSWD) { $P4 .= " -P $P4PASSWD"; }
if ($P4USER)   { $P4 .= " -u $P4USER"; }

################################################################################
#  
#  "out" mode.
#
#  This is relatively straightforward, since it's basically just
#  packaging up information from inside a nice safe Perforce depot -
#  there's no dependence on some sort of client state (as there in for
#  the "in" mode).
#

if ($Patchmode eq "out") { &out; }

sub out # overcome indentation
{
  if ($#Args != 1) { &usage; }

  my $change_num = shift @Args;
  my $branch_path = shift @Args;

  if ($branch_path !~ /^\/\//)
    { print STDERR "$Myname: <branch_path> must be in depot notation.\n"; &usage; }
  
  if (! open(INFO, "$P4 info |"))
    { &fail("open(\"$P4 info |\"): $!."); }

  my $Server;

  while (<INFO>)
    { if (/^Server address: (.*)$/) { $Server = $1; } }
  close INFO;

  $branch_path =~ s/\/$//;

  if (! open(DESC, "$P4 describe -du $change_num |"))
    { &fail("open(\"$P4 describe -du $change_num |\"): $!."); }

  my @addfiles;
  my %skipped;
  my $skipping = 0;
  my $fatality = 0;
  
  print "$Server: ";

  while (<DESC>)
    {
      if (/^\.\.\. (.*) (\w+)$/)
        {
          my ($depot_path, $action) = ($1, $2);
          my $path = $depot_path;

          if ($path !~ /^$branch_path\//)
            {
              print STDERR "$Myname: revision <$depot_path> not in <$branch_path> (skipped)\n";
              $skipped{$depot_path} = 1;
              next;
            }
          $path =~ s/^$branch_path\///;
          $path =~ s/#\d+$//;

          print "... $path $action\n";

          # Remember added or branched (or imported, which is
          # "branched" form a remote depot) files, so we remember to
          # add them to the new-file archive...
          #
          if ($action =~ /^(branch|add|import)$/) { push(@addfiles, $depot_path); }
        }
      elsif (/^==== (.*) \(([a-z\+\/]+)\) ====$/)
        {
          my ($depot_path, $type) = ($1, $2);

	  if ($skipped{$depot_path}) { $skipping = 1; next; }

          $skipping = 0;

          $depot_path =~ s/^$branch_path\///;
          $depot_path =~ s/#\d+$//;
          print "==== $depot_path ($type) ====\n";
        }
      else
        { if (! $skipping) { print; } }
    }
  close DESC;
  if ($fatality) { exit 1; }

  if ($#addfiles >= 0)
    {
      #  We need to tack on the cpio archive...
      #
      #  So: we need to make a temp tree to hold the files.
      #
      #  Note: yep, if we catch a sig and die unexpectedly, we can
      #  strand temp files. Ain't we a stinker? (yep, a we need that
      #  elusive Perl cpio module!)
      #

      print STDERR "### cpio\n";

      my $tmpdir = "/usr/tmp/$Myname.$$.dir";
      my $tmpfiles = "/usr/tmp/$Myname.$$.files";
      if (! mkdir $tmpdir) { &fail("couldn't make temp dir \"$tmpdir\": $!."); }
      if (! open(FILES, ">$tmpfiles")) { &fail("open(FILES, \">$tmpfiles\"): $!."); }
      foreach my $depot_path (@addfiles)
        {
          my $path = $depot_path;
          $path =~ s/^$branch_path\///;
          $path =~ s/#\d+$//;

          my $tmppath = "$tmpdir/$path";

	  &insdir(&dirname($tmppath), 0755);

          if (system("$P4 print -q $depot_path > $tmppath"))
            {
              system "/bin/rm -rf $tmpfiles";
              &fail("\"$P4 print -q $depot_path > $tmppath\" failed.");
            }

          print FILES "$path\n";
        }
      close FILES;

      print "\n#### cpio\n";

      # OK, now we have the temp tree built; run a cpio to construct the cpio archive.
      #
      if (! open(CPIO, "cd $tmpdir && /bin/cpio -c -o < $tmpfiles |"))
        {
          system "/bin/rm -rf $tmpfiles";
          &fail("open(CPIO, \"cd $tmpdir && /bin/cpio -c -o < $tmpfiles |\"): $!.");
        }

      while (<CPIO>) { print; }
      close CPIO; my $status = $?;
      system "/bin/rm -rf $tmpdir $tmpfiles";
      if ($status) { &fail("\"cd $tmpdir && /bin/cpio -c -o < $tmpfiles\" returned <$status>."); }

    }
  
  exit 0;
}


################################################################################
#  
#  "in" mode.
#
#  This is somewhat trickier than "out" mode, since it depends on the
#  state of the client tree (or Perforce workspace). E.g., if the
#  patch contains a file deletion, and the file doesn't exist in the
#  target, should this be a fatal error, a warning, or silently
#  ignored?

#  For this first cut, we'll go with a warning-where-possible
#  preference, on the principal that the operation may be more like a
#  merge than a fixed patch. Fatality will be reserved for obvious
#  failures of primitive operations. But one size may not fit all,
#  so in later versions we might want to have a "strict" mode, or
#  even think about adding support for making the whole thing more
#  explicitly "mergy".
#

if ($#Args > 0) { &usage; }

my $target_root = ".";

if ($#Args == 0) { $target_root = shift @Args; }

$target_root =~ s/\/$//; # just in case.

#  If $target_root is in Perforce syntax, map it into a local
#  filesystem path.
#
if ($target_root =~ /^\/\/([^\/]+)(.*)/)
  {
    my ($client_name, $client_path) = ($1, $2);
    
    $client_path =~ s/^\///;

    if (! $P4mode) { $P4mode = "open"; }

    my $root;
    my $valid = 0;
    foreach (split(/\n/, `$P4 client -o $client_name`))
      {
        if (/^Root:\s+(.*)/) { $root = $1; }
        if (/^Update:\s/)    { $valid = 1; }
      }

    if (! $valid) { &fail("no such client workspace \"$client_name\"."); }

    $target_root = "$root";
    if ($client_path) { $target_root .= "/$client_path"; }        
  }

if (! chdir($target_root)) { &fail("chdir(\"$target_root\"): $!"); }

# To avoid a confused Perforce:
#
my $pwd = `/bin/pwd`; chomp $pwd; $ENV{"PWD"} = $pwd;

#  Parse the description, up to the start of the diffs.
#

my $Change_head;
my $Description;
my %Files;

while (<STDIN>)
  { if (/: Change \d+ /) { $Change_head = $_; <>; last; } }
if (! $Change_head)
  { &fail("couldn't recognize a change description."); }

while (<STDIN>)
  {
    if (/^\t(.*)/) { $Description .= "$1\n"; }
    else           { last; }
  }
      
$Description .= "\n=== $Change_head\n";

my $affected = 0;
while (<STDIN>)
  { if (/^Affected files .../) { $affected = 1; <>; last; } }
if (! $affected) { &fail("couldn't find \"Affected files\" section."); }

while (<STDIN>)
  {
    if (/^\.\.\. (.*) (\w+)$/)
      {
        my ($path, $action) = ($1, $2);
        $path =~ s/#\d+$//;
        $Files{$path} = $action;
      }
    else
      { last; }
  }

#  Ok, here with $Change_head, $Description and %Files, but we haven't
#  modified anything yet. A great time for some error checking and
#  prep, before we actually do anything that would change the state of
#  the target.
#

#  Someday, maybe; if we error check here, and suumarize possible
#  problems, the user can chose wther to proceed, before changing any
#  statein the target, which may be difficult to revert...
#
#foreach my $path (sort(keys(%Files)))
#  {
#  }

#  OK, do we need a new changelist (or to append the description
#  to an existing one)?
#
if ($P4mode && $Change ne "default")
  {
    my $descfile = &mkdescfile($Description);
    $ENV{"P4EDITOR"} = "$Myname -p4editor $descfile";
    if ($Change eq "new") { $Change = ""; }
    my($status, @output) = &s("$P4 change $Change");
    if ($status != 0) { &fail("$P4 change returned exit status <$status>"); }

    if (! $Change)
      {
        foreach (@output) { if (/Change (\d+) created./) { $Change = $1; } }
        if (! $Change) { &fail("couldn't find new change number"); }
      }
  }

#  OK, here we know Change is valid.

#  Here we go. Iterate through the %Files list, doing whichever
#  p4 or local filesystem actions are implied by the values therein.

#  For now, let's just implement the "natural" path, and think about
#  the dizzying special-case error handling another day... the user will see
#  any errors, and _they_ can decide what to do before submitting.
#

my (@edits, @adds, @deletes);

foreach my $path (sort(keys(%Files)))
  {
    my $action = $Files{$path};

    if ($action eq "delete")
      {
        if ($P4mode)
          { push(@deletes, $path); }
        else
          { &s("/bin/rm $path"); }
      }
    elsif ($action =~ /^(branch|add|import)$/)
      {
        if ($P4mode) { push(@adds, $path); }

        #  (if we're not in $P4mode, then cpio will just overlay whatever's
        #  there, if anything.
      }
    elsif ($action =~ /^(edit|integrate)$/)
      {
        #  For these, the changes will be in the form of a "p4 diff -du" diff,
	#  to be processed by "patch".
        #
        if ($P4mode) { push(@edits, $path); }

        # now ready to patch
     }
  }


# Hey, doesn't this pup need some error checking?! TBD
#
sub dop4
{
  my ($op, $Change, @paths) = @_;

  if (! open(P4, "|$P4 -x - $op -c $Change"))
  { &fail("open(P4, \"|$P4 -x - $op -c $Change\": $!."); }
  foreach my $p (@paths) { print P4 $p."\n"; }
  close P4;
}


if ($P4mode)
  {
    print STDERR "### p4 deletes\n";
    &dop4("delete", $Change, @deletes);

    print STDERR "### p4 edits\n";
    &dop4("edit", $Change, @edits);
  }


## patching phase
#

print STDERR "### patching\n";

my $have_cpio = 0;

if ($Clean)
  {
    &s("/usr/bin/find . ".
         "\\( -name \\*.rej -o -name \\*.orig \\) -exec /bin/rm -f {} \\;");
  }

while (<STDIN>)
  {
    if (/^#### cpio$/) { $have_cpio = 1; last; }

    if (/^==== (.*) \(([a-z\+\/]+)\) ====$/)
      {
        my ($path, $type) = ($1, $2);
        <STDIN>;

        my $patchpath = "$path.patch";

	# ? &insdir(&dirname($patchpath), 0755); # but shouldn't it already exist?

        if (! open(PATCH, ">$patchpath"))
          { &fail("open(\">$patchpath\"): $!"); }

        print PATCH <<EOM;
--- $path~	Wed Dec 19 10:28:05 2001
+++ $path	Wed Dec 19 10:29:08 2001
EOM

        while (<STDIN>)
          {
            if (/^$/) { last; }
            # There's always an empty line after the diffs, so we
            # can't miss "#### cpio" here - right?
            print PATCH;
          }

        close PATCH;

        &s("/usr/bin/patch -p0 < $patchpath");

        unlink $patchpath;

        if ($P4mode && $type =~ /([^\/]+)\/([^\/]+)$/)
          { &s("$P4 reopen -t $2 $path"); }
      }
  }


if ($have_cpio)
  {
    print STDERR "### cpio/p4 adds\n";

    if (! open(CPIO, "|/bin/cpio -c -u -d -i"))
      { &fail("open(CPIO, \"|/bin/cpio -d -c -i\": $!."); }
    while (<STDIN>) { print CPIO; }
    close CPIO;
    my $status = $?;
    if ($status)
      { &fail("cpio exitted with status: $status."); }
    if ($P4mode) { &dop4("add", $Change, @adds); }
  }        
  
if ($P4mode eq "submit")
  {
    # We're gonna go all the way, yehaw!

    # First, stash the description:

    my $descfile = &mkdescfile($Description);

    # (The P4EDITOR invocation will only happen here when $Change is "default")
    #
    $ENV{"P4EDITOR"} = "$Myname -p4editor $descfile";
    &s("$P4 submit -c $Change");
  }

exit 0;

#--------- Utility functions


sub mkdescfile
{
  my ($Description) = @_;

  my $descfile = "/usr/tmp/$Myname.$$.desc";
  if (! open(DESC, ">$descfile"))
    { &fail("can't open \"<$descfile\": $!."); }
  print DESC $Description; close DESC;
  return $descfile;
}

sub fail
{
  my ($m) = @_;
  print STDERR "$Myname: $m\n";
  exit 1;
}


sub dirname
{
  my ($dir) = @_;
 
  $dir =~ s%^$%.%; $dir = "$dir/";
  if ($dir =~ m%^/[^/]*//*$%) { return "/"; }
  if ($dir =~ m%^.*[^/]//*[^/][^/]*//*$%)
    { $dir =~ s%^(.*[^/])//*[^/][^/]*//*$%$1%; { return $dir; } }
  return ".";
}

sub mkd
{
  my($dir, $mode) = @_;

  #printf STDERR "$Myname: mkdir %s %04o\n", $dir, $mode;
  mkdir($dir, $mode) || &fail("can't mkdir \"$dir\": $!.");
}


#  insure that the directory(s) required to store path "$dir" exist.
#  if $dir" or any require parent in the $dir pathname do not exist,
#  created them with the specified mode.
#
sub insdir
{
  my($dir, $insmode) = @_;

  if (! -e $dir)
    {
      &insdir(&dirname($dir));
      &mkd($dir, 0755);
      return;
    }

  # So, it already exists, is it a dir?
  
  if (! -d $dir)
    { &fail("existing \"$dir\" is not a directory."); }

  if (! $insmode) { return; } 

  # Last thing to insure is the mode...

  my(@stat) = stat($dir) || &fail("can't stat \"$dir\": $!.");

  if (($stat[2] & 0777) == $insmode) { return; }

  chmod $insmode, $dir || &fail("can't chmod \"$dir\": $!.");
}

#  Execute a system command, (which may be a $P4 command).
#  Returns ($status, @output), where
#    $status is, for perforce commands that exit with 0, the count of the
#            number of "error: " lines in the output; for all other commands,
#            it is simply the exit status.
#    @output is the lines of the compbined stderr and stdout
#            (p4 -s format, for p4 commands)
#    
sub s
{
  my ($cmd) = @_;

  my $p4 = 0;
  if ($cmd =~ /^$P4 /)
    {
      $cmd =~ s/^$P4 /$P4 -s /;
      $p4 = 1;  
    }

  print STDERR "$Myname: > $cmd\n";
  my @output = split(/\n/, `$cmd 2>&1`);
  my $status = $?;

  my $p4_errors = 0;
  foreach (@output)
    {
      my $line;
      if ($p4)
        {
          my $tag;
          ($tag, $line) = ($_ =~ /^([a-z\d]+): (.*)/);
          if ($tag eq "error") { $p4_errors++; }
        } 
      else
        { $line = $_; }        

      print STDERR "$Myname: : $line\n";  
    }

  if ($status == 0 && $p4) { $status = $p4_errors; }

  return ($status, @output);
}