Commit | Line | Data |
69c406f3 |
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; |
a45a6dbc |
10 | Usage: $0 [options] [<start-commit> [<end-commit>]] |
69c406f3 |
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/. |
a45a6dbc |
15 | Makes sure that updated CPAN distributions also update Porting/Maintainers.pl, |
16 | but otherwise ignores changes to that file (and MANIFEST). |
69c406f3 |
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 | |
a45a6dbc |
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 | } |
69c406f3 |
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 | } |
a45a6dbc |
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 | } |
69c406f3 |
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); |
a45a6dbc |
164 | |
69c406f3 |
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 | |