| 1 | #!/usr/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 | use Text::Tabs; |
| 20 | |
| 21 | $0 =~ s|^.*/||; |
| 22 | unless (@ARGV) { |
| 23 | die <<USAGE; |
| 24 | $0 [-p \$P4PORT] [-bi branch_include] [-be branch_exclude] <change numbers or from..to> |
| 25 | USAGE |
| 26 | } |
| 27 | |
| 28 | my @changes; |
| 29 | |
| 30 | my %editkind; |
| 31 | @editkind{ qw( add edit delete integrate branch )} |
| 32 | = qw( + ! - !> +> ); |
| 33 | |
| 34 | my $p4port = $ENV{P4PORT} || 'localhost:1666'; |
| 35 | |
| 36 | my @branch_include; |
| 37 | my @branch_exclude; |
| 38 | my %branch_include; |
| 39 | my %branch_exclude; |
| 40 | |
| 41 | while (@ARGV) { |
| 42 | $_ = shift; |
| 43 | if (/^(\d+)\.\.(\d+)?$/) { |
| 44 | push @changes, $1 .. ($2 || (split(' ', `p4 changes -m 1`))[1]); |
| 45 | } |
| 46 | elsif (/^\d+$/) { |
| 47 | push @changes, $_; |
| 48 | } |
| 49 | elsif (/^-p(.*)$/) { |
| 50 | $p4port = $1 || shift; |
| 51 | } |
| 52 | elsif (/^-bi(.*)$/) { |
| 53 | push @branch_include, $1 || shift; |
| 54 | } |
| 55 | elsif (/^-be(.*)$/) { |
| 56 | push @branch_exclude, $1 || shift; |
| 57 | } |
| 58 | else { |
| 59 | warn "Arguments must be change numbers, ignoring `$_'\n"; |
| 60 | } |
| 61 | } |
| 62 | |
| 63 | @changes = sort { $b <=> $a } @changes; |
| 64 | |
| 65 | @branch_include{@branch_include} = @branch_include if @branch_include; |
| 66 | @branch_exclude{@branch_exclude} = @branch_exclude if @branch_exclude; |
| 67 | |
| 68 | my @desc = `p4 -p $p4port describe -s @changes`; |
| 69 | if ($?) { |
| 70 | die "$0: `p4 -p $p4port describe -s @changes` failed, status[$?]\n"; |
| 71 | } |
| 72 | else { |
| 73 | tr/\r/\n/ foreach @desc; |
| 74 | chomp @desc; |
| 75 | while (@desc) { |
| 76 | my ($change,$who,$date,$time,@log,$branch,$file,$type,%files); |
| 77 | my $skip = 0; |
| 78 | my $nbranch = 0; |
| 79 | $_ = shift @desc; |
| 80 | if (/^Change (\d+) by (\w+)\@.+ on (\S+) (\S+)\s*$/) { |
| 81 | ($change, $who, $date, $time) = ($1,$2,$3,$4); |
| 82 | $_ = shift @desc; # get rid of empty line |
| 83 | while (@desc) { |
| 84 | $_ = shift @desc; |
| 85 | last if /^Affected/; |
| 86 | push @log, $_; |
| 87 | } |
| 88 | if (/^Affected/) { |
| 89 | $_ = shift @desc; # get rid of empty line |
| 90 | while ($_ = shift @desc) { |
| 91 | last unless /^\.\.\./; |
| 92 | if (m{^\.\.\. //depot/(.*?perl|[^/]*)/([^#]+)#\d+ (\w+)\s*$}) { |
| 93 | ($branch,$file,$type) = ($1,$2,$3); |
| 94 | $nbranch++; |
| 95 | if (exists $branch_exclude{$branch} or |
| 96 | @branch_include and |
| 97 | not exists $branch_include{$branch}) { |
| 98 | $skip++; |
| 99 | } |
| 100 | $files{$branch} = {} unless exists $files{$branch}; |
| 101 | $files{$branch}{$type} = [] unless exists $files{$branch}{$type}; |
| 102 | push @{$files{$branch}{$type}}, $file; |
| 103 | } |
| 104 | else { |
| 105 | warn "Unknown line [$_], ignoring\n"; |
| 106 | } |
| 107 | } |
| 108 | } |
| 109 | } |
| 110 | next if ((not $change) or $skip); |
| 111 | my $output = ("_" x 76) . "\n"; |
| 112 | $output .= sprintf <<EOT, $change, $who, $date, $time; |
| 113 | [%6s] By: %-25s on %9s %9s |
| 114 | EOT |
| 115 | $output .= " Log: "; |
| 116 | my $i = 0; |
| 117 | while (@log) { |
| 118 | $_ = shift @log; |
| 119 | s/^\s*//; |
| 120 | s/^\[.*\]\s*// unless $i ; |
| 121 | # don't print last empty line |
| 122 | if ($_ or @log) { |
| 123 | $output .= " " if $i++; |
| 124 | $output .= "$_\n"; |
| 125 | } |
| 126 | } |
| 127 | for my $branch (sort keys %files) { |
| 128 | $output .= sprintf "%11s: $branch\n", 'Branch'; |
| 129 | for my $kind (sort keys %{$files{$branch}}) { |
| 130 | warn("### $kind ###\n"), next unless exists $editkind{$kind}; |
| 131 | my $files = $files{$branch}{$kind}; |
| 132 | # don't show large branches and integrations |
| 133 | $files = ["($kind " . scalar(@$files) . ' files)'] |
| 134 | if (@$files > 25 && ($kind eq 'integrate' |
| 135 | || $kind eq 'branch')) |
| 136 | || @$files > 100; |
| 137 | $output .= wrap(sprintf("%12s ", $editkind{$kind}), |
| 138 | sprintf("%12s ", $editkind{$kind}), |
| 139 | "@$files\n"); |
| 140 | } |
| 141 | } |
| 142 | print unexpand($output); |
| 143 | } |
| 144 | } |