This is a live mirror of the Perl 5 development currently hosted at https://github.com/perl/perl5
integrate mainline changes
[perl5.git] / Porting / genlog
CommitLineData
808270a4
GS
1#!/l/local/bin/perl -w
2#
3# Generate a nice changelist by querying perforce.
4#
5# Each change is described with the change number, description,
6# which branch the change happened in, files modified,
7# and who was responsible for entering the change.
8#
9# Can be called with a list of change numbers or a range of the
10# form "12..42". Changelog will be printed from highest number
11# to lowest.
12#
13# Outputs the changelist to stdout.
14#
1d7c1841 15# Gurusamy Sarathy <gsar@activestate.com>
808270a4
GS
16#
17
18use Text::Wrap;
19
20$0 =~ s|^.*/||;
21unless (@ARGV) {
22 die <<USAGE;
23 $0 [-p \$P4PORT] <change numbers or from..to>
24USAGE
25}
26
27my @changes;
28
29my %editkind;
30@editkind{ qw( add edit delete integrate branch )}
31 = qw( + ! - !> +> );
32
33my $p4port = $ENV{P4PORT} || 'localhost:1666';
34
35while (@ARGV) {
36 $_ = shift;
37 if (/^(\d+)\.\.(\d+)$/) {
38 push @changes, $1 .. $2;
39 }
40 elsif (/^\d+$/) {
41 push @changes, $_;
42 }
43 elsif (/^-p(.*)$/) {
44 $p4port = $1 || shift;
45 }
46 else {
47 warn "Arguments must be change numbers, ignoring `$_'\n";
48 }
49}
50
51@changes = sort { $b <=> $a } @changes;
52
53my @desc = `p4 -p $p4port describe -s @changes`;
54if ($?) {
55 die "$0: `p4 -p $p4port describe -s @changes` failed, status[$?]\n";
56}
57else {
58 chomp @desc;
59 while (@desc) {
60 my ($change,$who,$date,$time,@log,$branch,$file,$type,%files);
61 $_ = shift @desc;
62 if (/^Change (\d+) by (\w+)\@.+ on (\S+) (\S+)\s*$/) {
63 ($change, $who, $date, $time) = ($1,$2,$3,$4);
64 $_ = shift @desc; # get rid of empty line
65 while (@desc) {
66 $_ = shift @desc;
67 last if /^Affected/;
68 push @log, $_;
69 }
70 if (/^Affected/) {
71 $_ = shift @desc; # get rid of empty line
72 while ($_ = shift @desc) {
73 last unless /^\.\.\./;
74 if (m{^\.\.\. //depot/(.*?perl|[^/]*)/([^#]+)#\d+ (\w+)\s*$}) {
75 ($branch,$file,$type) = ($1,$2,$3);
76 $files{$branch} = {} unless exists $files{$branch};
77 $files{$branch}{$type} = [] unless exists $files{$branch}{$type};
78 push @{$files{$branch}{$type}}, $file;
79 }
80 else {
81 warn "Unknown line [$_], ignoring\n";
82 }
83 }
84 }
85 }
86 next unless $change;
87 print "_" x 76, "\n";
88 printf <<EOT, $change, $who, $date, $time;
89[%6s] By: %-25s on %9s %9s
90EOT
91 print " Log: ";
92 my $i = 0;
93 while (@log) {
94 $_ = shift @log;
95 s/^\s*//;
96 s/^\[.*\]\s*// unless $i ;
97 # don't print last empty line
98 if ($_ or @log) {
99 print " " if $i++;
100 print "$_\n";
101 }
102 }
103 for my $branch (sort keys %files) {
104 printf "%11s: $branch\n", 'Branch';
105 for my $kind (sort keys %{$files{$branch}}) {
106 warn("### $kind ###\n"), next unless exists $editkind{$kind};
107 my $files = $files{$branch}{$kind};
108 # don't show large branches and integrations
109 $files = ["($kind " . scalar(@$files) . ' files)']
6abf89b4
GS
110 if (@$files > 25 && ($kind eq 'integrate'
111 || $kind eq 'branch'))
112 || @$files > 100;
808270a4
GS
113 print wrap(sprintf("%12s ", $editkind{$kind}),
114 sprintf("%12s ", $editkind{$kind}),
115 "@$files\n");
116 }
117 }
118 }
119}