backtrack.pl
(plain)
1 #!/usr/bin/env perl 2 # 3 # Copyright (c) 2024, 2025, 2026 Amelia Campbell 4 # 5 # Redistribution and use in source and binary forms, with or without 6 # modification, are permitted provided that the following conditions are met: 7 # 8 # 1. Redistributions of source code must retain the above copyright notice, 9 # this list of conditions and the following disclaimer. 10 # 2. Redistributions in binary form must reproduce the above copyright 11 # notice, this list of conditions and the following disclaimer in the 12 # documentation and/or other materials provided with the distribution. 13 # 14 # THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS "AS IS" 15 # AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE 16 # IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE 17 # ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT OWNER OR CONTRIBUTORS BE 18 # LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR 19 # CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF 20 # SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS 21 # INTERRUPTION) HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN 22 # CONTRACT, STRICT LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE) 23 # ARISING IN ANY WAY OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF THE 24 # POSSIBILITY OF SUCH DAMAGE. 25 26 use strict; 27 use warnings; 28 use List::Util qw(min); 29 use File::Basename; 30 use Getopt::Long; 31 use Pod::Usage; 32 use Cwd; 33 use Cwd 'abs_path'; 34 35 my $multirepo = 0; 36 my $do_changed = 0; 37 38 # create unique IDs for each data table, so that we don't plot the same data 39 # twice when writing to the same gnuplot command file. 40 sub cookie { return sprintf "%08X", int(rand(0xffffffff)); } 41 42 # start a data table and return the generated cookie for it 43 sub print_eod_start { 44 my $c = cookie; 45 print {shift} "\$M$c << EOD\n"; 46 return $c; 47 } 48 49 # data table end (nothing special, but just in case) 50 sub print_eod_end { print {shift} "EOD\n"; } 51 52 # data table separator, time axis, grid, y-label and format 53 sub print_time_format { 54 printf {shift} "set datafile separator ',' 55 set xdata time 56 set xtics rotate 57 set style fill transparent 58 set timefmt '%%s' 59 set format x '%%d/%%m/%%y' 60 set format y '%%.0f' 61 set ylabel '%s' 62 set grid\n", shift; 63 } 64 65 sub print_y2tics { 66 printf {shift} "set y2tics 67 set format y2 '%%.0f' 68 set y2label '%s'\n", shift; 69 } 70 71 sub print_loctics { 72 my $o = shift; 73 print_y2tics($o, 'line delta') if $do_changed; 74 print_time_format($o, 'lines of code'); 75 } 76 77 # in: git log --reverse --format="%h,%ct,%ae,%an" 78 sub parse_contributors ($$$) { 79 my ($in, $out, $lim) = @_; 80 my (%rnames, %emails, %contrib, @history); 81 82 $rnames{OTHER} = 'Others'; 83 $emails{OTHER} = '...'; 84 85 # return the keys of %t containing the top values (in descending order) 86 # incl. a special "OTHER" token denoting all inferior keys 87 sub top { 88 my ($sz, $t) = @_; 89 my @k = keys %$t; 90 my @a = (sort { $t->{$b} <=> $t->{$a} } @k)[0..min($#k, $sz-1)]; 91 unshift(@a, 'OTHER') unless grep(/^OTHER$/, @a); 92 return @a; 93 } 94 95 # trim keys of %t not in @p if the quantity of keys in %t exceeds length 96 # of @p, this is primarily a memory-saving measure for large repositories 97 sub trim { 98 my ($t, @p) = @_; 99 my @k = keys %$t; 100 my %s; @s{@p} = (); 101 return if $#k <= $#p; 102 foreach (grep { !exists $s{$_} } @k) { 103 # accumulate all of our trimmed values into the special OTHER token 104 $t->{OTHER} += $t->{$_}; 105 delete $t->{$_}; 106 } 107 } 108 109 my $it; while (<$in>) { 110 chomp; 111 # extract relevant details from each record, filtering emails into a 112 # unique username token where the domain is stripped only if the user 113 # exceeds 3 characters. 114 my ($t, $e, $u, $n) = 115 grep(defined, /\w*,(\d*),(([^\s]{4,})@[^\s]*|([^\s]*)),(.*)/); 116 next if (!$t); 117 118 # bizarre workaround for rendering issue...for now 119 $e =~ s/@/＠/g; 120 121 # $u is our uniquely identifying token per contributor, but we want to 122 # store useful details about who this person actually is. we update 123 # these values constantly, just in case the user changes their name 124 # or address. note that we have a deliberately fuzzy definition of a 125 # unique user entry. 126 $u = lc $u; 127 $rnames{$u} = $n; 128 $emails{$u} = $e; 129 130 $contrib{$u}++; 131 132 # store a trimmed copy of the contributions table at this exact moment 133 my %copy = %contrib; 134 trim(\%copy, top(2*$lim, \%contrib)); 135 push(@history, [$t, \%copy]); 136 137 # print useful progress data 138 $it++; printf STDERR "visit %d commits, %d authors\n", 139 $it, 0+keys(%contrib); 140 } 141 142 # we've reached the end of the commit history, so we can now compute the 143 # final list of top contributors. 144 my @win = top($lim+1, \%contrib); 145 146 # if we never needed to trim, OTHER will not exist in the history, thus 147 # there is no purpose in plotting it. 148 shift @win if !exists $history[$#history]->[1]->{OTHER}; 149 150 my $ck = print_eod_start $out; 151 foreach (@history) { 152 my ($t, $h) = @$_; 153 # do another trim to bring each history snapshot into alignment with 154 # the final computed list of top contributors. 155 trim($h, @win); 156 157 # create a data table of their contributions at this point in history. 158 my ($s, $c, $i); 159 foreach (@win) { 160 # accumulate values in $c so that they form a stack graph on plot. 161 $s .= ($c += (defined $$h{$_} ? $$h{$_} : 0)) . ',' if $i++ < $lim; 162 } 163 # remove the trailing comma. 164 chop $s; 165 166 print $out "$t,$s\n"; 167 } 168 print_eod_end $out; 169 print $out "set key below\n"; 170 171 # finally, plot each column of the data table on top of each other 172 # (starting with the tallest due to paint order), all along a time axis, 173 # and provide gnuplot with their real names and email addresses. 174 my @plots; 175 for (reverse 0..min($#win, $lim-1)) { 176 push(@plots, sprintf( 177 "\$M$ck using 1:%d title '%s (%s)' w filledcurves x1", 178 $_+2, $rnames{$win[$_]}, $emails{$win[$_]}));; 179 } 180 181 return @plots; 182 } 183 184 # in: git log --reverse --numstat --format="%h %ct" 185 sub parse_loc ($$$) { 186 my ($in, $out, $title) = @_; 187 my @s = (0)x4; # values for this line 188 189 # we'll need to dump the accumulated line count data both when we switch 190 # commits and when we finish the input file 191 sub commit_dump { printf {shift} join(',', @_)."\n" if $_[1]; return @_; } 192 193 my $ck = print_eod_start $out; 194 my $it; while (<$in>) { 195 chomp; 196 # match a pattern for the commit header or a numstat record 197 my ($a, $d, $c, $t) = /^(\d+)\s+(\d*)\s+.*|(\w+)\s+(\d+)$/; 198 199 # if this is a commit header: dump the current accumulated values and 200 # reset the state for a new commit. 201 @s = ($c, $t, (commit_dump($out, @s))[2], 0) if defined $c; 202 203 # if this is the additions/deletions to a file: accumulate those values 204 map { $_ += ($a - $d) } @s[2,3] if defined $a; 205 206 # print useful progress data 207 $it++; printf STDERR "visit %d commits, %d lines\n", $it, $s[2]; 208 } 209 210 # the file is over, dump the last record 211 commit_dump($out, @s); 212 print_eod_end $out; 213 214 # finally, plot the line for this repository 215 my ($plines, $pdelta) = ( 216 "\$M$ck using 2:3 w steps title '$title'", 217 "\$M$ck using 2:4 w impulses axes x1y2 title 'Δ$title'"); 218 return $do_changed ? join(', ', $plines, $pdelta) : $plines; 219 } 220 221 # format and print the commands to plot an array of line descriptions 222 sub show_plots { print {shift} "plot " . join(', ', @_) . "\n"; } 223 224 # we'll be switching repositories a lot 225 my $origin; 226 227 sub switch_repo { $origin = getcwd; chdir(shift); } 228 sub restore_origin { chdir($origin); } 229 230 sub repo_name { return (basename shift) =~ s/.git$//r; } 231 232 # run a command and open its output as a file handle, failing if necessary 233 sub failrun { 234 open(my $h, '-|', @_) || die "$0: failed to execute $_[0]\n"; 235 return $h; 236 } 237 238 # run a git command in a given repository, returning its file handle 239 sub git_read_cmd { 240 switch_repo shift; 241 my $h = failrun('git', @_); 242 restore_origin; 243 return $h; 244 } 245 246 # loc & contributor commands respectively 247 sub get_filestats { 248 return git_read_cmd(shift, 249 'log', '--reverse', '--numstat', '--format=%h %ct', 250 @_); 251 } 252 253 sub get_contribstats { 254 return git_read_cmd(shift, 255 'log', '--reverse', '--format=%h,%ct,%ae,%an', 256 @_); 257 } 258 259 # functions for plotting those graphs 260 sub repo_contrib { 261 # <outfh> <repo> <lim> <...> 262 my ($o, $r, $l) = (shift, shift, shift); 263 my $h = get_contribstats($r, @_); 264 265 print_time_format($o, 'commits'); 266 show_plots($o, parse_contributors($h, $o, $l)); 267 } 268 269 sub repo_loc { 270 # <outfh> <repo> <...> 271 my ($o, $r) = (shift, shift); 272 my $h = get_filestats($r, @_); 273 274 return parse_loc($h, $o, repo_name $r); 275 } 276 277 sub repo_loc1 { 278 # <outfh> <repo> <...> 279 my ($o) = @_; 280 281 print_loctics $o; 282 show_plots($o, repo_loc @_); 283 } 284 285 sub repo_locs { 286 # <outfh> <repo...> 287 my @plots; 288 my ($o, @rs) = @_; 289 290 print_loctics $o; 291 push(@plots, repo_loc($o, $_)) foreach @rs; 292 show_plots($o, @plots); 293 } 294 295 my ($man, $help) = (0, 0); 296 297 my ($contrib_lim, 298 $width, 299 $height, 300 $canvasname, 301 $output, 302 $outfile, 303 $gnuplot, 304 $mode, 305 @repos) = (8, 1024, 768, 'plot'); 306 307 GetOptions('r|repo=s' => \@repos, 308 'l|contrib-limit=i' => \$contrib_lim, 309 't|output=s' => \$output, 310 'o|outfile=s' => \$outfile, 311 'w|width=i' => \$width, 312 'h|height=i' => \$height, 313 'g|gnuplot' => \$gnuplot, 314 'n|canvas-name=s' => \$canvasname, 315 'm|mode=s' => \$mode, 316 'c|show-changed' => \$do_changed, 317 318 'help|?' => \$help, 319 man => \$man) or pod2usage(2); 320 pod2usage(1) if $help; 321 pod2usage(-exitval => 0, -verbose => 2) if $man; 322 323 die "$0: no subcommand specified! (contrib/loc)\n" if ! defined $mode; 324 die "$0: you must specify at least one repository!\n" if 0+@repos < 1; 325 $multirepo = 0+@repos > 1; 326 327 my $fh = *STDOUT; 328 open($fh, '|-', 'gnuplot -p') 329 or die "$0: couldn't execute gnuplot: $!\n" if defined $gnuplot; 330 331 if (defined $output) { 332 my $ov = $output =~ /^ov-/; 333 334 if (! $ov) { 335 die "$0: no output file specified!\n" if ! defined $outfile; 336 $outfile = abs_path($outfile) =~ s/'/\\'/gr; 337 } 338 339 if ($output eq "png") { 340 print $fh "set terminal png size $width,$height\n"; 341 } elsif ($output eq "js") { 342 $canvasname =~ s/'/\\'/g; 343 344 print $fh 345 "set terminal canvas name '$canvasname' size $width,$height\n"; 346 } elsif ($output eq "svg") { 347 print $fh "set terminal svg size $width,$height dynamic\n"; 348 } elsif ($ov) { 349 print $fh "set terminal " . $output =~ s/^ov-//r . "\n"; 350 } else { 351 die "$0: invalid output mode specification (png/js/svg)\n"; 352 } 353 354 print $fh "set output '$outfile'\n" if ! $ov; 355 } 356 357 if ($mode =~ /^(c|contrib)$/) { 358 die "$0: contrib subcommand can only process one repository!\n" 359 if $multirepo; 360 361 repo_contrib($fh, $repos[0], $contrib_lim, @ARGV); 362 } elsif ($mode =~ /^(l|loc)$/) { 363 if ($multirepo) { 364 repo_locs($fh, @repos); 365 } else { 366 repo_loc1($fh, $repos[0], @ARGV); 367 } 368 } else { 369 die "$0: invalid mode specification ([c]ontrib/[l]oc)\n"; 370 } 371 372 if (defined $gnuplot) { 373 close STDOUT; wait 374 } 375 376 __END__ 377 378 =head1 NAME 379 380 backtrack - Walk the history of a Git repository and compute statistics 381 382 =head1 SYNOPSIS 383 384 backtrack [options | -rltowhgnmc] -- [git options] 385 386 options a list of options to backtrack itself 387 git options a list of options to be fed to git subcommands 388 389 =head1 OPTIONS 390 391 =over 8 392 393 =item B<--man> 394 395 Prints the manual page and exits. 396 397 =item B<--help> 398 399 Print a brief help message and exits. 400 401 =item B<-r|--repo=STR> 402 403 Specify the path to a repository to examine. This argument can be provided 404 more than once. 405 406 =item B<-l|--contrib-limit=INT> 407 408 Specifies the maximum number of top contributors to keep track of when in 409 "contrib" mode. 410 411 =item B<-t|--output=STR> 412 413 Specifies the output terminal that gnuplot should use. Can be either "js," 414 "svg," or "png." If no terminal is specified, gnuplot will simply use the 415 default, which on most systems is an interactive GUI. If the input to this 416 argument begins with "ov-" then the rest of the argument will be passed through 417 to gnuplot's "set terminal" directly. 418 419 =item B<-o|--outfile=STR> 420 421 Specifies the path to the output file that gnuplot should write to. 422 423 =item B<-w|--width=INT> 424 425 Specifies the width in pixels. 426 427 =item B<-h|--height=INT> 428 429 Specifies the height in pixels. 430 431 =item B<-g|--gnuplot> 432 433 Actually execute gnuplot automatically instead of writing gnuplot commands to 434 the standard output. 435 436 =item B<-n|--canvas-name> 437 438 Specifies the name of the canvas to write to when output is "js." 439 440 =item B<-m|--mode> 441 442 Specifies the subcommand to use, and thus the statistics to be collected. Can 443 be either [c]ontrib or [l]oc. In contrib mode, the program generates a stacked 444 graph of the top contributors to the repository over time. In loc mode, the 445 program generates a graph of the lines of code in the repository over time. If 446 more than one repository is to be plotted on the same graph, the "git options" 447 arguments are ignored. 448 449 =item B<-c|--show-changed> 450 451 In loc mode, overlay a graph onto the second Y-axis showing lines added or 452 deleted over time. 453 454 =back 455 456 =head1 DESCRIPTION 457 458 B<This program> will walk the log of a Git repository, starting from its first 459 commit (by default) and generate graphs (via gnuplot) of various statistics 460 that can be ascertained from this data, determined by the -m/--mode argument. 461 462 =cut