| 1 | #!perl |
| 2 | use strict; |
| 3 | use warnings; |
| 4 | use Getopt::Long qw/GetOptions/; |
| 5 | use Term::ANSIColor qw/color/; |
| 6 | use constant GITCMD => 'git'; |
| 7 | |
| 8 | sub usage { |
| 9 | print <<HERE; |
| 10 | Usage: $0 [options] [<start-commit> [<end-commit>]] |
| 11 | |
| 12 | Scans the commit logs for commits that are potentially, illegitimately |
| 13 | touching modules that are primarily maintained outside of the perl core. |
| 14 | Also checks for commits that span multiple distributions in cpan/ or dist/. |
| 15 | Makes sure that updated CPAN distributions also update Porting/Maintainers.pl, |
| 16 | but otherwise ignores changes to that file (and MANIFEST). |
| 17 | |
| 18 | Skip the <start-commit> to go back indefinitely. <end-commit> defaults to |
| 19 | HEAD. |
| 20 | |
| 21 | -h/--help shows this help |
| 22 | -v/--verbose shows the output of "git show --stat <commit>" for each commit |
| 23 | -c/--color uses colored output |
| 24 | HERE |
| 25 | exit(1); |
| 26 | } |
| 27 | |
| 28 | our $Verbose = 0; |
| 29 | our $Color = 0; |
| 30 | GetOptions( |
| 31 | 'h|help' => \&usage, |
| 32 | 'v|verbose' => \$Verbose, |
| 33 | 'c|color|colour' => \$Color, |
| 34 | ); |
| 35 | |
| 36 | my $start_commit = shift; |
| 37 | my $end_commit = shift; |
| 38 | $end_commit = 'HEAD' if not defined $end_commit; |
| 39 | my $commit_range_cmd = defined($start_commit) ? " $start_commit..$end_commit" : ""; |
| 40 | |
| 41 | # format: hash\0author\0committer\0short_msg |
| 42 | our $LogCmd = GITCMD() . q{ log --no-color -M -C --name-only '--pretty=format:%h%x00%an%x00%cn%x00%s'} . $commit_range_cmd; |
| 43 | our @ColumnSpec = qw(hash author committer commit_msg); |
| 44 | |
| 45 | open my $fh, '-|', $LogCmd |
| 46 | or die "Can't run '$LogCmd' to get the commit log: $!"; |
| 47 | |
| 48 | my ($safe_commits, $unsafe_commits) = parse_log($fh); |
| 49 | |
| 50 | if (@$unsafe_commits) { |
| 51 | my $header = "Potentially unsafe commits:"; |
| 52 | print color("red") if $Color; |
| 53 | print $header, "\n"; |
| 54 | print("=" x length($header), "\n\n") if $Verbose; |
| 55 | print color("reset") if $Color; |
| 56 | print_commit_info($_) foreach reverse @$unsafe_commits; |
| 57 | print "\n"; |
| 58 | } |
| 59 | |
| 60 | if (@$safe_commits) { |
| 61 | my $header = "Presumably safe commits:"; |
| 62 | print color("green") if $Color; |
| 63 | print $header, "\n"; |
| 64 | print("=" x length($header), "\n") if $Verbose; |
| 65 | print color("reset") if $Color; |
| 66 | print_commit_info($_) foreach reverse @$safe_commits; |
| 67 | print "\n"; |
| 68 | } |
| 69 | |
| 70 | exit(0); |
| 71 | |
| 72 | |
| 73 | |
| 74 | # single-line info about the commit at hand |
| 75 | sub print_commit_info { |
| 76 | my $commit = shift; |
| 77 | |
| 78 | my $author_info = "by $commit->{author}" |
| 79 | . ($commit->{author} eq $commit->{committer} |
| 80 | ? '' |
| 81 | : " committed by $commit->{committer}"); |
| 82 | |
| 83 | if ($Verbose) { |
| 84 | print color("yellow") if $Color; |
| 85 | my $header = "$commit->{hash} $author_info: $commit->{msg}"; |
| 86 | print "$header\n", ("-" x length($header)), "\n"; |
| 87 | print color("reset") if $Color; |
| 88 | |
| 89 | my $cmd = GITCMD() . ' show --stat ' . ($Color?'--color ':'') |
| 90 | . $commit->{hash}; |
| 91 | print `$cmd`; # make sure git knows this isn't a terminal |
| 92 | print "\n"; |
| 93 | } |
| 94 | else { |
| 95 | print color("yellow") if $Color; |
| 96 | print " $commit->{hash} $author_info: $commit->{msg}\n"; |
| 97 | print color("reset") if $Color; |
| 98 | } |
| 99 | } |
| 100 | |
| 101 | |
| 102 | # check whether the commit at hand is safe, unsafe or uninteresting |
| 103 | sub check_commit { |
| 104 | my $commit = shift; |
| 105 | my $safe = shift; |
| 106 | my $unsafe = shift; |
| 107 | |
| 108 | # Note to self: Adding any more greps and such will make this |
| 109 | # look even more silly. Just use a single foreach, smart guy! |
| 110 | my $touches_maintainers_pl = 0; |
| 111 | my @files = grep { |
| 112 | $touches_maintainers_pl = 1 |
| 113 | if $_ eq 'Porting/Maintainers.pl'; |
| 114 | $_ ne 'MANIFEST' and $_ ne 'Porting/Maintainers.pl' |
| 115 | } |
| 116 | @{$commit->{files}}; |
| 117 | my @touching_cpan = grep {/^cpan\//} @files; |
| 118 | return if not @touching_cpan; |
| 119 | |
| 120 | # check for unsafe commits to cpan/ |
| 121 | my %touched_cpan_dirs; |
| 122 | $touched_cpan_dirs{$_}++ for grep {defined $_} |
| 123 | map {s/^cpan\/([^\/]*).*$/$1/; $_} |
| 124 | @touching_cpan; |
| 125 | |
| 126 | my $touches_multiple_cpan_dists = (keys(%touched_cpan_dirs) > 1); |
| 127 | |
| 128 | my $touches_others = @files - @touching_cpan; |
| 129 | |
| 130 | if (@touching_cpan) { |
| 131 | if ($touches_others) { |
| 132 | $commit->{msg} = 'Touched files under cpan/ and other locations'; |
| 133 | push @$unsafe, $commit; |
| 134 | } |
| 135 | elsif ($touches_multiple_cpan_dists) { |
| 136 | $commit->{msg} = 'Touched multiple directories under cpan/'; |
| 137 | push @$unsafe, $commit; |
| 138 | } |
| 139 | elsif (not $touches_maintainers_pl) { |
| 140 | $commit->{msg} = 'Touched files under cpan/, but does not update ' |
| 141 | . 'Porting/Maintainers.pl'; |
| 142 | push @$unsafe, $commit; |
| 143 | } |
| 144 | elsif ($commit->{commit_msg} =~ /(?:up(?:grad|dat)|import)(?:ed?|ing)/i) { |
| 145 | $commit->{msg} = 'Touched files under cpan/ with ' |
| 146 | . '"upgrading"-like commit message'; |
| 147 | push @$safe, $commit; |
| 148 | } |
| 149 | else { |
| 150 | $commit->{msg} = 'Touched files under cpan/ without ' |
| 151 | . '"upgrading"-like commit message'; |
| 152 | push @$unsafe, $commit; |
| 153 | } |
| 154 | } |
| 155 | |
| 156 | # check for unsafe commits to dist/ |
| 157 | my @touching_dist = grep {/^dist\//} @files; |
| 158 | my %touched_dist_dirs; |
| 159 | $touched_dist_dirs{$_}++ for grep {defined $_} |
| 160 | map {s/^dist\/([^\/]*).*$/$1/; $_} |
| 161 | @touching_dist; |
| 162 | $touches_others = @files - @touching_dist; |
| 163 | my $touches_multiple_dists = (keys(%touched_dist_dirs) > 1); |
| 164 | |
| 165 | if (@touching_dist) { |
| 166 | if ($touches_others) { |
| 167 | $commit->{msg} = 'Touched files under dist/ and other locations'; |
| 168 | push @$unsafe, $commit; |
| 169 | } |
| 170 | elsif ($touches_multiple_dists) { |
| 171 | $commit->{msg} = 'Touched multiple directories under cpan/'; |
| 172 | push @$unsafe, $commit; |
| 173 | } |
| 174 | } |
| 175 | } |
| 176 | |
| 177 | # given file handle, parse the git log output and put the resulting commit |
| 178 | # structure into safe/unsafe compartments |
| 179 | sub parse_log { |
| 180 | my $fh = shift; |
| 181 | my @safe_commits; |
| 182 | my @unsafe_commits; |
| 183 | my $commit; |
| 184 | while (defined(my $line = <$fh>)) { |
| 185 | chomp $line; |
| 186 | if (not $commit) { |
| 187 | next if $line =~ /^\s*$/; |
| 188 | my @cols = split /\0/, $line; |
| 189 | @cols == @ColumnSpec && !grep {!defined($_)} @cols |
| 190 | or die "Malformed commit header line: '$line'"; |
| 191 | $commit = { |
| 192 | files => [], |
| 193 | map {$ColumnSpec[$_] => $cols[$_]} (0..$#cols) |
| 194 | }; |
| 195 | next; |
| 196 | } |
| 197 | elsif ($line =~ /^\s*$/) { # within commit, blank line |
| 198 | check_commit($commit, \@safe_commits, \@unsafe_commits); |
| 199 | $commit = undef; |
| 200 | } |
| 201 | else { # within commit, non-blank (file) line |
| 202 | push @{$commit->{files}}, $line; |
| 203 | } |
| 204 | } |
| 205 | |
| 206 | return(\@safe_commits, \@unsafe_commits); |
| 207 | } |
| 208 | |