This is a live mirror of the Perl 5 development currently hosted at https://github.com/perl/perl5
remove =for section (from Johan Vromans)
[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
9use vars qw($thisfile $change $file $fnum $h $v $p4port @addfiles);
10
11BEGIN {
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;
35Usage: $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
41A smart 'cat'. When fed the spew from "p4 describe ..." on STDIN,
42spits it right out on STDOUT, followed by patches for any new files
43detected in the spew. Can also be used to edit insitu a bunch of
44files containing said spew.
45
46WARNING: Currently only emits unified diffs.
47
48Examples:
49 p4 describe -du 123 | $0 > change-123.desc
50 p4 describe -du 123 | $0 | p4d2p > change-123.patch
51
52USAGE
53 exit(0);
54 }
55 $thisfile = "";
56}
57
58
59if ($ARGV ne $thisfile) {
60 warn "processing patchfile [$ARGV]\n" unless $ARGV eq '-';
61 $thisfile = $ARGV;
62}
63
64my $cur = m|^Affected files| ... m|^Differences|;
65
66# while we are within range
67if ($cur) {
ad315806 68 if (m{^\.\.\. (//depot/.+?#\d+) (add|branch)$}) {
1f848803
GS
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
76if (/^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
85if (eof) {
86 $_ .= newfiles();
87}
88
89sub newfiles {
90 my $addfile;
91 my $ret = "";
92 for $addfile (@addfiles) {
c3e95679 93 my $type = `p4 -p $p4port files '$addfile'`;
95470547 94 if ($?) {
c3e95679 95 warn "$0: `p4 -p $p4port print '$addfile'` failed, status[$?]\n";
95470547
GS
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 }
c3e95679 104 my @new = `p4 -p $p4port print '$addfile'`;
1f848803 105 if ($?) {
c3e95679 106 die "$0: `p4 -p $p4port print '$addfile'` failed, status[$?]\n";
1f848803
GS
107 }
108 my $desc = shift @new; # discard initial description
95470547 109 $ret .= "\n==== $addfile ($type) ====\n\n";
1f848803
GS
110 my $lines = "," . @new;
111 $lines = "" if @new < 2;
112 $ret .= "\@\@ -0,0 +1$lines \@\@\n";
113 $ret .= join("+","",@new);
c3e95679 114 $ret .= "\n\\ No newline at end of file\n" if $ret !~ /\n$/;
1f848803
GS
115 }
116 @addfiles = ();
117 return $ret;
118}