Implement contributor lookup for past releases

Can be handy, like when fixing missing contributors for
R#2024 #2024

tools/contributors.p6

@@ -1,16 +1,93 @@
 #!/usr/bin/env perl6
 use v6;
 
-sub MAIN (
-    $last_release? is copy,
-    :$rakudo = '.',
-    :$doc    = '../doc',
-    :$nqp    = 'nqp',
-    :$moar   = 'nqp/MoarVM',
-    :$roast  = 't/spec',
+my %*SUB-MAIN-OPTS = :named-anywhere;
+# repeat named args in MAIN multies for nice USAGE messsages
+constant   RAK_REPO = '.';
+constant   DOC_REPO = '../doc';
+constant   NQP_REPO = 'nqp';
+constant  MOAR_REPO = 'nqp/MoarVM';
+constant ROAST_REPO = 't/spec';
+
+subset PathToRepo of Str where .so;
+
+#|(past releases)
+multi MAIN('for', 'release', $release,
+    PathToRepo :$rakudo = RAK_REPO,
+    PathToRepo :$doc    = DOC_REPO,
+    PathToRepo :$nqp    = NQP_REPO,
+    PathToRepo :$moar   = MOAR_REPO,
+    PathToRepo :$roast  = ROAST_REPO,
+) {
+    # fetch all available tags, creating a list of hashes, each of which got
+    # a tag name and the date it was created on
+    my @releases = run(:out, :cwd($rakudo),
+      «git for-each-ref --sort=taggerdate
+        '--format=%(tag)|%(creatordate)' refs/tags»
+    ).out.lines(:close).map(
+        *.split('|', :skip-empty).List
+    ).grep(* == 2).map: { %(:tag(.head), :date(parse-date .tail)) };
+
+    ~$release ∈ @releases».<tag> or die "Could not find $release in the list of"
+      ~ " known releases: @releases».<tag>";
+
+    # create a map of tag => the tag immediatelly previous to it (temporally)
+    # this gives us the tag (along with that tag's date) for the previous rls
+    my %prev-rel = @releases.rotor(2 => -1).map: {.tail<tag> => .head };
+    %prev-rel{$release} or die "Could not figure out the tag for previous"
+      ~ " release. Did you give me the first release ever? I can't handle it";
+
+    # gen committers using the dates of the tag we were asked for and the
+    # the tag that's previous to it, temporally, giving us the space of one rls
+    say join ', ', committers :since(%prev-rel{$release}<date>),
+        :until(@releases.first(*.<tag> eq $release)<date>),
+        :$rakudo, :$doc, :$nqp, :$moar, :$roast
+}
+
+#|(current release)
+multi MAIN ($last_release? is copy,
+    PathToRepo :$rakudo = RAK_REPO,
+    PathToRepo :$doc    = DOC_REPO,
+    PathToRepo :$nqp    = NQP_REPO,
+    PathToRepo :$moar   = MOAR_REPO,
+    PathToRepo :$roast  = ROAST_REPO
 ) {
     $last_release //= get-last-release-date-for $rakudo;
+    say join ', ', committers since => $last_release,
+        :$rakudo, :$doc, :$nqp, :$moar, :$roast
+}
 
+sub parse-date ($date) {
+    # newer gits have `--date` option to set format; I don't have such a new
+    # git, so do this business of extracting the date:
+    # 'Fri Feb 23 08:03:10 2018 +0200'
+    # Thu Feb 26 23:51:11 2009 -0600
+    if $date ~~ /
+        $<wkd>=\w**3 \s+ $<mon>=\w**3 \s+ $<day>=\d+ \s+
+        $<time>=[[\d**2 \:]**2 \d**2] \s+ $<year>=\d**4 \s+ $<offset>=\S+
+    / {
+        my $month = <
+          NaM Jan Feb Mar Apr May Jun Jul Aug Sep Oct Nov Dec
+        >.antipairs.Hash{$<mon>};
+        DateTime.new:
+          "$<year>-$month.fmt("%02d")-$<day>.Str.fmt("%02d")T$<time>$<offset>";
+    }
+    elsif (try DateTime.new: $date) {
+        warn "Date `$date` is in unexpected format. Parsed it as $^res";
+        $^res
+    }
+    else { die "I don't know how to parse date $date" }
+}
+
+sub committers (
+    :$since!,
+    :$until,
+    :$rakudo = RAK_REPO,
+    :$doc    = DOC_REPO,
+    :$nqp    = NQP_REPO,
+    :$moar   = MOAR_REPO,
+    :$roast  = ROAST_REPO,
+) {
     # Check all the places with repos that may be applicable.  Get all of the
     # committers in that repo since the given date as commit ID => author pairs.
     # Only keep the unique commit ID's (so that each author only gets credited
@@ -30,9 +107,10 @@ sub MAIN (
     my @*CREDITS = ($rakudo, $doc, $nqp, $moar, $roast
         )».IO».child('CREDITS').grep(*.r)».lines.flat;
 
-    say "Contributors to Rakudo since the release on $last_release:";
+    say "Contributors to Rakudo since $since"
+      ~ (" until $until" with $until) ~ ":";
     my @contributors = @repos.map({
-      |get-committers($_,$last_release)
+      |get-committers($_, $since, |($_ with $until))
     }).unique(:as(*.key))».value.Bag.sort(-*.value)».key;
 
     for @contributors -> $name is rw {
@@ -46,7 +124,7 @@ sub MAIN (
         }
 
     }
-    say @contributors.join(', ');
+    @contributors
 }
 
 sub get-last-release-date-for ($rakudo-repo) {
@@ -63,19 +141,21 @@ sub get-last-release-date-for ($rakudo-repo) {
     ).out.slurp(:close).lines.head;
 }
 
-sub get-committers($repo, $since) {
+sub get-committers($repo, $since, $until?) {
     die "Expected a repo in `$repo` but did not find one"
          unless $repo.IO.d && "$repo/.git".IO.d;
 
     my @commits = run(:out, :cwd($repo),
-      <git log --since>, $since, '--pretty=format:%an|%cn|%H|%s'
+      <git log --since>, $since, |('--until', $_ with $until),
+        '--pretty=format:%an|%cn|%H|%s'
     ).out.lines.grep: ?*; # grep needed because of (Str) on empty pipe
 
     @commits or warn qq:to/END/;
 
     *********************** !! WARNING !! ********************
 
-    Did not find any commits in $repo since last release ($since).
+    Did not find any commits in directory `$repo`
+    between $since and {$until ?? $until !! "now"}
     Are you sure it's current and is on the right branch?
 
     *********************** !! WARNING !! ********************