#!/usr/bin/perl

# Patch a source tree and check the result into Perforce
# Usage:
#   p4patch [-S] [-c comment] [-l label] [-p path] workarea patch 
#
# Attempts to detect renames by looking for identical files which disappear
# and reappear elsewhere in the next version.
#
# 1997-1999 Jeremy Fitzhardinge <jeremy@goop.org>
#
# $Id: //depot/perforce/p4patch#11 $

use MD5;
use Getopt::Std;
use File::Find;
use FileHandle;
use IPC::Open2;

sub p4 ($@) {
    my ($op, @args) = (@_);
    my $cmd = "p4 $op ".(join " ", @args);
    #print "doing $cmd\n";
    if (system ($cmd) != 0) {
	warn "Perforce command $cmd failed: $?; skipping submit\n";
	$opt_S = 1;
    }
}

sub canon($) {
    my ($f) = @_;
    $f =~ s,/+,/,g;
    $f =~ s,/\.$,/,;
    $f =~ s,/\./,/,g;
    $f =~ s,/+$,,;
    #print "canon $_[0] -> $f\n";
    return $f;
}

if ($#ARGV < 1) {
    die "Usage: p4patch [-S] [-p depth] [-l label] [-c comment] workarea patchfile\n";
}

sub reaper () {
    wait;
}

$SIG{CLD} = \&reaper;

open PATCH, "patch --version|" or die;
$ok = 0;
while (<PATCH>) {
    munch;
    if (/^patch 2\.5/) {
	$ok = 1;
	last;
    }
}
close PATCH;
die "patch 2.5 not installed\n" if !$ok;

getopts('p:l:c:S');

$work = $ARGV[0];
$patch = $ARGV[1];

$moved = 0;

if (!$opt_c) {
    $opt_c = "Patch $patch applied";
}

if ($patch =~ /\.(Z|gz)$/) {
    $from = "zcat $patch";
} else {
    $from = "cat $patch";
}

die "$patch does not exist\n" unless (-e $patch);

$work = canon "$work/";

# Apply the patch
print "Applying patch...\n";
open PATCH,  "$from | patch --backup --version-control=simple --suffix=.orig -p$opt_p -d $work --forward --force --remove-empty-files 2>&1 |" or die "Applying $patch to $work failed (1).\n";
while (<PATCH>) {
    chop;
    print "$_\n" if /^patch:/;
    s,^patching file `?([^ ']+)'?,$1, or next;
    $f = canon "$work/$_";
    print "patching $f\n";
    push @patched, "$f";
    $patched{"$f"} = "$f";
}
close PATCH;
# die "Applying $patch to $work failed (2).\n" if ($?);

# Create a new change
open P4, "p4 change -o|";
while(<P4>) {
    s/<enter description here>/$opt_c/;
    last if /^Files:/;

    #print "$_";
    $change .= $_;
}
close P4;
#die "Failed creating new change" if ($?);

$pid = open2(\*P4, \*P4IN, "p4 change -i");
print P4IN $change;
close P4IN;

while(<P4>) {
    next unless /^Change ([0-9]+) created/;
    $changeno = $1;
}
close P4;
die "Can't get change number\n" if $? || !$changeno;

# Find *.orig files with no new file (deleted) and empty *.orig files (created)
print "Finding new and deleted files...\n";

foreach $file (@patched) {
    if (-e "$file.rej") {
	warn "$file.rej reject file found: skipping submit\n";
	$opt_S = 1;
	next;
    }
    my $orig = "$file.orig";
#print "examining $file\n";
    push @patchcruft, $orig;
    if (-e $file) {
	if (-z $orig) {
	    push @created, $file;
	    $created{$file} = $file;
#print "$file created\n";
	}
    } else {
        push @deleted, $file;
	$deleted{$file} = $file;
#print "$file deleted\n";
    }
}

# Hash to find mapping from deleted to created files (a rename)
# XXX assumes 1:1 ratio between files and hashes (no collisions)
foreach $file (@created) {
    my $md5 = new MD5;
    if (!open HASH, $file) {
      warn "Can't open $file: $!\n";
      next;
    }

    $md5->addfile(HASH);
    $creathash{canon $file} = $md5->hexdigest;

    close HASH;
}

foreach $file (@deleted) {
    my $md5 = new MD5;
    if (!open HASH, "$file.orig") {
      warn "Can't open $file.orig: $!\n";
      next;
    }

    $md5->addfile(HASH);
    $delhash{$md5->hexdigest} = $file;

    close HASH;
}

# Look for obvious renames, and tell Perforce about them
foreach $to (keys %creathash) {
    my $from = $delhash{$creathash{$to}};

    if (defined $from) {
	print "move $from -> $to\n";
	unlink $to;
	p4 "integrate", "-c", $changeno, ($from, $to);
	undef $created{$to};
	undef $patched{$to};
	undef $patched{$from};
	#p4("delete", $from);
	$moved = 1;
    }
}

foreach $f (@deleted) {
    #print "$f deleted\n";
    undef $patched{$f};
    p4 "delete", "-c", $changeno, ($f) if defined $deleted{$f};
}

foreach $f (@created) {
    #print "$f created\n";
    undef $patched{$f};
    p4 "add", "-c", $changeno, "-t", "text", $f if defined $created{$f};
}

foreach $f (@patched) {
    #print "$f changed\n";
    p4 "edit", "-c", $changeno, ($f) if defined $patched{"$f"};
}

if (!$opt_S) {
    p4 "submit", "-c", $changeno;
} else {
    print "Skipping submit\n";
}

if ($opt_l) {
    $_ = `p4 where $work`;
    chop;
    ($client, $depot) = split / +: +/;

    open P4, "|p4 label -i";
    print P4 <<EOF;
Label: $opt_l
Description: $opt_c
View: $depot... //$opt_l/...
EOF
    close P4;
    die "Can't create label $opt_l\n" if ($?);

    p4 "labelsync", ("-l $opt_l", canon "$work/...", ">/dev/null");
}

# p4 "get", canon "$work/..." if $moved;

print "deleting patch cruft...\n";
unlink @patchcruft;