This is a live mirror of the Perl 5 development currently hosted at https://github.com/perl/perl5
Upgrade to Net::Ping 2.18 (no core-relevant changes,
[perl5.git] / Porting / p4genpatch
index fd744af..ccedff1 100644 (file)
@@ -10,6 +10,8 @@
 use strict;
 use File::Temp qw(tempdir);
 use File::Compare;
+use File::Spec;
+use File::Spec::Unix;
 use Time::Local;
 use Getopt::Long;
 use Cwd qw(cwd);
@@ -26,13 +28,14 @@ Getopt::Long::Configure("no_ignore_case");
 GetOptions(\%OPT, "b=s", "p=s", "d=s", "D=s", "h", "v", "V") or die Usage;
 print Usage and exit if $OPT{h};
 print "$VERSION\n" and exit if $OPT{V};
-die Usage unless @ARGV == 1;
+die Usage unless @ARGV == 1 && $ARGV[0] =~ /^\d+$/;
+my $CHANGE = shift;
 
 for my $p4opt (qw(p)) {
   push @P4opt, "-$p4opt $OPT{$p4opt}" if $OPT{$p4opt};
 }
 
-my $system = "p4 @P4opt describe -s @ARGV |";
+my $system = "p4 @P4opt describe -s $CHANGE |";
 open my $p4, $system or die "Could not run $system";
 my @action;
 while (<$p4>) {
@@ -48,88 +51,107 @@ while (<$p4>) {
 close $p4;
 
 my $tempdir;
+my @unlink;
 print "Differences ...\n";
 for my $a (@action) {
-  $tempdir ||= tempdir( "tmp-XXXX", CLEANUP => 1 );
+  $tempdir ||= tempdir( "tmp-XXXX", CLEANUP => 1, TMPDIR => 1 );
+  @unlink = ();
   my($action,$file,$prefix) = @$a;
   my($path,$basename,$number) = $file =~ m|\Q$prefix\E/(.+/)?([^/]+)#(\d+)|;
+
+  my @splitdir = File::Spec::Unix->splitdir($path);
+  $path = File::Spec->catdir(@splitdir);
+
+  my($depotfile) = $file =~ m|^(.+)#\d+\z|;
   die "Panic: Could not parse file[$file]" unless $number;
   $path = "" unless defined $path;
-  my($d1,$d2,$prev);
+  my($d1,$d2,$prev,$prevchange,$prevfile,$doadd,$t1,$t2);
   $prev = $number-1;
-  if ($prev==0 or $action =~ /^(add|branch)$/) {
-    $d1 = "/dev/null";
+  $prevchange = $CHANGE-1;
+  # can't assume previous rev == $number-1 due to obliterated revisions
+  $prevfile = "$depotfile\@$prevchange";
+  if ($number == 1 or $action =~ /^(add|branch)$/) {
+    $d1 = $^O eq 'MacOS' ? File::Spec->devnull : "/dev/null";
+    $t1 = $d1;
+    ++$doadd;
   } elsif ($action =~ /^(edit|integrate)$/) {
-    $d1 = "$path$basename#$prev";
+    $d1 = File::Spec->catfile($path, "$basename-$prevchange");
+    $t1 = File::Spec->catfile($tempdir, $d1);
     warn "==> $d1 <==\n" if $OPT{v};
-    my $system = "p4 @P4opt print -o $tempdir/$d1 //depot/$path$basename#$prev";
+    my $system = qq[p4 @P4opt print -o "$t1" "$prevfile"];
     my $status = `$system`;
     if ($?) {
       warn "$0: system[$system] failed, status[$?]\n";
       next;
     }
-    chmod 0644, "$tempdir/$d1";
-    if (my($prevch) = $status =~ / \s change \s (\d+) \s /x) {
+    chmod 0644, $t1;
+    if ($status =~ /\#(\d+) \s - \s \w+ \s change \s (\d+) \s /x) {
+      ($prev,$prevchange) = ($1,$2);
+      $prevfile = "$depotfile#$prev";
       my $oldd1 = $d1;
-      $d1 .= "~$prevch~";
-      rename "$tempdir/$oldd1", "$tempdir/$d1";
+      $d1 =~ s/-\d+$/#$prev~$prevchange~/;
+      my $oldt1 = $t1;
+      $t1 = File::Spec->catfile($tempdir, $d1);
+      rename $oldt1, $t1;
     }
+    push @unlink, $t1;
   } else {
     die "Unknown action[$action]";
   }
-  $d2 = "$path$basename";
+  $d2 = File::Spec->catfile($path, $basename);
+  $t2 = File::Spec->catfile($tempdir, $d2);
+  push @unlink, $t2;
   warn "==> $d2#$number <==\n" if $OPT{v};
-  my $system = "p4 @P4opt print -o $tempdir/$d2 $file";
+  my $system = qq[p4 @P4opt print -o "$t2" "$file"];
   # warn "system[$system]";
   my $type = `$system`;
   if ($?) {
     warn "$0: `$system` failed, status[$?]\n";
     next;
   }
-  chmod 0644, "$tempdir/$d2";
+  chmod 0644, $t2;
   $type =~ m|^//.*\((.+)\)$| or next;
   $type = $1;
-  if (File::Compare::compare("$tempdir/$d1", "$tempdir/$d2")) {
+  if ($doadd or File::Compare::compare($t1, $t2)) {
     print "\n==== $file ($type) ====\n";
     unless ($type =~ /text/) {
       next;
     }
-    print "Index: $path$basename\n";
-    my @filelog = `p4 @P4opt filelog $file`;
-    correctmtime(\@filelog,$prev,"$tempdir/$d1");
-    correctmtime(\@filelog,$number,"$tempdir/$d2");
+    unless ($^O eq 'MacOS') {
+      $d1 =~ s,\\,/,g;
+      $d2 =~ s,\\,/,g;
+    }
+    print "Index: $d2\n";
+    correctmtime($prevfile,$prev,$t1) unless $doadd;
+    correctmtime($file,$number,$t2);
     chdir $tempdir or warn "Could not chdir '$tempdir': $!";
     $system = qq[$OPT{D} -$OPT{d} "$d1" "$d2"];
     system($system); # no return check because diff doesn't always return 0
     chdir $TOPDIR or warn "Could not chdir '$TOPDIR': $!";
   }
-  for ("$tempdir/$d1","$tempdir/$d2") {
+}
+continue {
+  for (@unlink) {
     unlink or warn "Could not unlink $_: $!" if -f;
   }
 }
 print "End of Patch.\n";
 
+my($tz_offset);
 sub correctmtime ($$$) {
-  my($filelog,$nr,$file) = @_;
-  for my $line (@$filelog) {
-    my($rev,$change,$action,$date) =
-        $line =~ m{ ^ \.\.\. \s
-                    \#
-                    (\d+)            # rev
-                    \s change \s
-                    (\d+)            # change
-                    \s (\w+) \s      # action
-                    on \s (\S+)      # date
-                  }x or next;
-    # warn "rev[$rev]";
-    next unless $rev == $nr;
-    my(@date) = split m|/|, $date;
-    $date[0] -= 1900;
-    $date[1]--;
-    my $time = timelocal(0,0,0,reverse @date);
-    utime $time, $time, $file;
-    last;
+  my($depotfile,$nr,$localfile) = @_;
+  my %fstat = map { /^\.\.\. (\w+) (.*)$/ } `p4 @P4opt fstat -s "$depotfile"`;
+  return unless exists($fstat{headRev}) and $fstat{headRev} == $nr;
+
+  if ($^O eq 'MacOS') {  # fix epoch ... still off by three hours (EDT->PDT)
+    require Time::Local;
+    $tz_offset ||= sprintf "%+0.4d\n", (
+      Time::Local::timelocal(localtime) - Time::Local::timelocal(gmtime)
+    );
+    $fstat{headTime} += 2082844801 + $tz_offset;
   }
+
+  utime $fstat{headTime}, $fstat{headTime}, $localfile;
 }
 
 sub Usage () {