| 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 | # |
| 15 | # Gurusamy Sarathy <gsar@activestate.com> |
| 16 | # |
| 17 | |
| 18 | use Text::Wrap; |
| 19 | |
| 20 | $0 =~ s|^.*/||; |
| 21 | unless (@ARGV) { |
| 22 | die <<USAGE; |
| 23 | $0 [-p \$P4PORT] <change numbers or from..to> |
| 24 | USAGE |
| 25 | } |
| 26 | |
| 27 | my @changes; |
| 28 | |
| 29 | my %editkind; |
| 30 | @editkind{ qw( add edit delete integrate branch )} |
| 31 | = qw( + ! - !> +> ); |
| 32 | |
| 33 | my $p4port = $ENV{P4PORT} || 'localhost:1666'; |
| 34 | |
| 35 | while (@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 | |
| 53 | my @desc = `p4 -p $p4port describe -s @changes`; |
| 54 | if ($?) { |
| 55 | die "$0: `p4 -p $p4port describe -s @changes` failed, status[$?]\n"; |
| 56 | } |
| 57 | else { |
| 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 |
| 90 | EOT |
| 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)'] |
| 110 | if (@$files > 25 && ($kind eq 'integrate' |
| 111 | || $kind eq 'branch')) |
| 112 | || @$files > 100; |
| 113 | print wrap(sprintf("%12s ", $editkind{$kind}), |
| 114 | sprintf("%12s ", $editkind{$kind}), |
| 115 | "@$files\n"); |
| 116 | } |
| 117 | } |
| 118 | } |
| 119 | } |