This is a live mirror of the Perl 5 development currently hosted at https://github.com/perl/perl5
FAQ sync.
[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@activestate.com>
7 #
8
9 use vars qw($thisfile $change $file $fnum $h $v $p4port @addfiles
10             $branches $skip);
11
12 BEGIN {
13     $0 =~ s|^.*/||;
14     $p4port = $ENV{P4PORT} || 'localhost:1666';
15     for (@ARGV) {
16         if ($p4port =~ /^\s+$/) {
17            $p4port = $_;
18         }
19         elsif (/^-p(.*)$/) {
20             $p4port = $1 || ' ';
21         }
22         elsif (/^-b(.*)$/) {
23             $branches = $1;
24         }
25         elsif (/^-v$/) {
26             $v++;
27         }
28         elsif (/^-h/) {
29             $h++;
30         }
31         else {
32             push @files, $_;
33         }
34     }
35     unless (@files) { @files = '-'; undef $^I; }
36     @ARGV = @files;
37     $branches = '//depot/perl/' unless defined $branches;
38     if ($h) {
39         print STDERR <<USAGE;
40 Usage: $0 [-p \$P4PORT] [-v] [-h] [files]
41
42         -phost:port     p4 port (e.g. myhost:1666)
43         -h              print this help
44         -v              output progress messages
45         -bbranch(es)    which branches to include (regex)
46                         (default: //depot/perl/)
47         -h              show this help
48
49 A smart 'cat'.  When fed the spew from "p4 describe ..." on STDIN,
50 spits it right out on STDOUT, followed by patches for any new files
51 detected in the spew.  Can also be used to edit insitu a bunch of
52 files containing said spew.
53
54 WARNING 1: Currently only emits unified diffs (diff -u).
55
56 WARNING 2: By default only the changes in the //depot/perl branch
57 are shown.  To include all the branches, supply "-b." arguments
58 to $0.
59
60 Examples:
61         p4 describe -du 123 | $0 > change-123.desc
62         p4 describe -du 123 | $0 | p4d2p > change-123.patch
63
64 USAGE
65         exit(0);
66     }
67     $thisfile = "";
68 }
69
70
71 if ($ARGV ne $thisfile) {
72     warn "processing patchfile [$ARGV]\n" unless $ARGV eq '-';
73     $thisfile = $ARGV;
74 }
75
76 my $cur = m|^Affected files| ... m|^Differences|;
77
78 # while we are within range
79 if ($cur) {
80     if (m|^\.\.\. |) {
81         if (m|$branches|) {
82             if (m{^\.\.\. (//depot/.+?\#\d+) (add|branch)$}) {
83                 my $newfile = $1;
84                 push @addfiles, $newfile;
85                 warn "$newfile add, revision != 1!\n" unless $newfile =~ /#1$/;
86             }
87         } else {
88             push @skipped, "# $_";
89             $_ = '';
90         }
91     }
92     warn "file [$file] line [$cur] file# [$fnum]\n" if $v;
93 }
94
95 if (m|^==== //depot/|) { 
96     $skip = !m|$branches|;
97     print "# Skipped because not under branches: $branches\n" if $skip;
98 }
99
100 $_ = "# $_" if $skip; 
101
102 if (/^Change (\d+) by/) {
103     $_ = "\n\n" . $_ if $change;        # start of a new change list
104     $change = $1;
105     my $new = newfiles();
106     if ($new) {
107         $_ = $new . $_;
108     }
109 }
110
111 if (eof) {
112     $_ .= newfiles();
113     $_ .= join('', "\n",
114                "# Skipped because not under branches: $branches\n",
115                @skipped, "\n") if @skipped; 
116 }
117
118 sub newfiles {
119     my $addfile;
120     my $ret = "";
121     for $addfile (@addfiles) {
122         my $type = `p4 -p $p4port files '$addfile'`;
123         if ($?) {
124             warn "$0: `p4 -p $p4port print '$addfile'` failed, status[$?]\n";
125             next;
126         }
127         $type =~ m|^//.*\((.+)\)$| or next;
128         $type = $1;
129         unless ($type =~ /text/) {
130             $ret .= "\n==== $addfile ($type) ====\n\n";
131             next;
132         }
133         my @new = `p4 -p $p4port print '$addfile'`;
134         if ($?) {
135             die "$0: `p4 -p $p4port print '$addfile'` failed, status[$?]\n";
136         }
137         my $desc = shift @new;          # discard initial description
138         $ret .= "\n==== $addfile ($type) ====\n\n";
139         my $lines = "," . @new;
140         $lines = "" if @new < 2;
141         $ret .= "\@\@ -0,0 +1$lines \@\@\n";
142         $ret .= join("+","",@new);
143         $ret .= "\n\\ No newline at end of file\n" if $ret !~ /\n$/;
144     }
145     @addfiles = ();
146     return $ret;
147 }