This is a live mirror of the Perl 5 development currently hosted at https://github.com/perl/perl5
7bac3eb1f2d8455e96fa5a92b8c8731a2f0c5908
[perl5.git] / Porting / p4desc
1 #!/usr/bin/perl -wpi.bak
2
3 #
4 # Munge "p4 describe ..." output to include new files.
5 #
6 # Gurusamy Sarathy <gsar@umich.edu>
7 #
8
9 use vars qw($thisfile $change $file $fnum $h $v $p4port @addfiles);
10
11 BEGIN {
12     $0 =~ s|^.*/||;
13     $p4port = $ENV{P4PORT} || 'localhost:1666';
14     for (@ARGV) {
15         if ($p4port =~ /^\s+$/) {
16            $p4port = $_;
17         }
18         elsif (/^-p(.*)$/) {
19             $p4port = $1 || ' ';
20         }
21         elsif (/^-v$/) {
22             $v++;
23         }
24         elsif (/^-h/) {
25             $h++;
26         }
27         else {
28             push @files, $_;
29         }
30     }
31     unless (@files) { @files = '-'; undef $^I; }
32     @ARGV = @files;
33     if ($h) {
34         print STDERR <<USAGE;
35 Usage: $0 [-p \$P4PORT] [-v] [-h] [files]
36
37         -p host:port    p4 port (e.g. myhost:1666)
38         -h              print this help
39         -v              output progress messages
40
41 A smart 'cat'.  When fed the spew from "p4 describe ..." on STDIN,
42 spits it right out on STDOUT, followed by patches for any new files
43 detected in the spew.  Can also be used to edit insitu a bunch of
44 files containing said spew.
45
46 WARNING: Currently only emits unified diffs.
47
48 Examples:
49         p4 describe -du 123 | $0 > change-123.desc
50         p4 describe -du 123 | $0 | p4d2p > change-123.patch
51
52 USAGE
53         exit(0);
54     }
55     $thisfile = "";
56 }
57
58
59 if ($ARGV ne $thisfile) {
60     warn "processing patchfile [$ARGV]\n" unless $ARGV eq '-';
61     $thisfile = $ARGV;
62 }
63
64 my $cur = m|^Affected files| ... m|^Differences|;
65
66 # while we are within range
67 if ($cur) {
68     if (m|^\.\.\. (//depot/.+?#\d+) add$|) {
69         my $newfile = $1;
70         push @addfiles, $newfile;
71         warn "$newfile add, revision != 1!\n" unless $newfile =~ /#1$/;
72     }
73     warn "file [$file] line [$cur] file# [$fnum]\n" if $v;
74 }
75
76 if (/^Change (\d+) by/) {
77     $_ = "\n\n" . $_ if $change;        # start of a new change list
78     $change = $1;
79     my $new = newfiles();
80     if ($new) {
81         $_ = $new . $_;
82     }
83 }
84
85 if (eof) {
86     $_ .= newfiles();
87 }
88
89 sub newfiles {
90     my $addfile;
91     my $ret = "";
92     for $addfile (@addfiles) {
93         my $type = `p4 -p $p4port files $addfile`;
94         if ($?) {
95             warn "$0: `p4 -p $p4port print $addfile` failed, status[$?]\n";
96             next;
97         }
98         $type =~ m|^//.*\((.+)\)$| or next;
99         $type = $1;
100         unless ($type =~ /text/) {
101             $ret .= "\n==== $addfile ($type) ====\n\n";
102             next;
103         }
104         my @new = `p4 -p $p4port print $addfile`;
105         if ($?) {
106             die "$0: `p4 -p $p4port print $addfile` failed, status[$?]\n";
107         }
108         my $desc = shift @new;          # discard initial description
109         $ret .= "\n==== $addfile ($type) ====\n\n";
110         my $lines = "," . @new;
111         $lines = "" if @new < 2;
112         $ret .= "\@\@ -0,0 +1$lines \@\@\n";
113         $ret .= join("+","",@new);
114     }
115     @addfiles = ();
116     return $ret;
117 }