This is a live mirror of the Perl 5 development currently hosted at https://github.com/perl/perl5
Upgrade to Digest::MD5 2.20.
[perl5.git] / Porting / p4desc
CommitLineData
95470547 1#!/usr/bin/perl -wpi.bak
1f848803
GS
2
3#
4# Munge "p4 describe ..." output to include new files.
5#
6e238990 6# Gurusamy Sarathy <gsar@activestate.com>
1f848803
GS
7#
8
9058bc9b
JH
9use vars qw($thisfile $change $file $fnum $h $v $p4port @addfiles
10 $branches $skip);
1f848803
GS
11
12BEGIN {
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 }
9058bc9b
JH
22 elsif (/^-b(.*)$/) {
23 $branches = $1;
24 }
1f848803
GS
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;
9058bc9b 37 $branches = '//depot/perl/' unless defined $branches;
1f848803
GS
38 if ($h) {
39 print STDERR <<USAGE;
40Usage: $0 [-p \$P4PORT] [-v] [-h] [files]
41
9058bc9b 42 -phost:port p4 port (e.g. myhost:1666)
1f848803
GS
43 -h print this help
44 -v output progress messages
9058bc9b
JH
45 -bbranch(es) which branches to include (regex)
46 (default: //depot/perl/)
47 -h show this help
1f848803
GS
48
49A smart 'cat'. When fed the spew from "p4 describe ..." on STDIN,
50spits it right out on STDOUT, followed by patches for any new files
51detected in the spew. Can also be used to edit insitu a bunch of
52files containing said spew.
53
9058bc9b
JH
54WARNING 1: Currently only emits unified diffs (diff -u).
55
56WARNING 2: By default only the changes in the //depot/perl branch
57are shown. To include all the branches, supply "-b." arguments
58to $0.
1f848803
GS
59
60Examples:
61 p4 describe -du 123 | $0 > change-123.desc
62 p4 describe -du 123 | $0 | p4d2p > change-123.patch
63
64USAGE
65 exit(0);
66 }
67 $thisfile = "";
68}
69
70
71if ($ARGV ne $thisfile) {
72 warn "processing patchfile [$ARGV]\n" unless $ARGV eq '-';
73 $thisfile = $ARGV;
74}
75
76my $cur = m|^Affected files| ... m|^Differences|;
77
78# while we are within range
79if ($cur) {
9058bc9b
JH
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 {
631c47bf
JH
88 push @skipped, "# $_";
89 $_ = '';
9058bc9b 90 }
1f848803
GS
91 }
92 warn "file [$file] line [$cur] file# [$fnum]\n" if $v;
93}
94
9058bc9b
JH
95if (m|^==== //depot/|) {
96 $skip = !m|$branches|;
631c47bf 97 print "# Skipped because not under branches: $branches\n" if $skip;
9058bc9b
JH
98}
99
100$_ = "# $_" if $skip;
101
1f848803
GS
102if (/^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
111if (eof) {
112 $_ .= newfiles();
631c47bf
JH
113 $_ .= join('', "\n",
114 "# Skipped because not under branches: $branches\n",
115 @skipped, "\n") if @skipped;
1f848803
GS
116}
117
118sub newfiles {
119 my $addfile;
120 my $ret = "";
121 for $addfile (@addfiles) {
c3e95679 122 my $type = `p4 -p $p4port files '$addfile'`;
95470547 123 if ($?) {
c3e95679 124 warn "$0: `p4 -p $p4port print '$addfile'` failed, status[$?]\n";
95470547
GS
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 }
c3e95679 133 my @new = `p4 -p $p4port print '$addfile'`;
1f848803 134 if ($?) {
c3e95679 135 die "$0: `p4 -p $p4port print '$addfile'` failed, status[$?]\n";
1f848803
GS
136 }
137 my $desc = shift @new; # discard initial description
95470547 138 $ret .= "\n==== $addfile ($type) ====\n\n";
1f848803
GS
139 my $lines = "," . @new;
140 $lines = "" if @new < 2;
141 $ret .= "\@\@ -0,0 +1$lines \@\@\n";
142 $ret .= join("+","",@new);
c3e95679 143 $ret .= "\n\\ No newline at end of file\n" if $ret !~ /\n$/;
1f848803
GS
144 }
145 @addfiles = ();
146 return $ret;
147}