|
| 1 | +#!/usr/bin/env perl6 |
| 2 | +# Copyright © 2017 |
| 3 | +# Aleks-Daniel Jakimenko-Aleksejev <alex.jakimenko@gmail.com> |
| 4 | +# |
| 5 | +# This program is free software: you can redistribute it and/or modify |
| 6 | +# it under the terms of the GNU Affero General Public License as published by |
| 7 | +# the Free Software Foundation, either version 3 of the License, or |
| 8 | +# (at your option) any later version. |
| 9 | +# |
| 10 | +# This program is distributed in the hope that it will be useful, |
| 11 | +# but WITHOUT ANY WARRANTY; without even the implied warranty of |
| 12 | +# MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the |
| 13 | +# GNU Affero General Public License for more details. |
| 14 | +# |
| 15 | +# You should have received a copy of the GNU Affero General Public License |
| 16 | +# along with this program. If not, see <http://www.gnu.org/licenses/>. |
| 17 | + |
| 18 | +use Whateverable; |
| 19 | +use Misc; |
| 20 | + |
| 21 | +use IRC::Client; |
| 22 | + |
| 23 | +unit class Releasable does Whateverable; |
| 24 | + |
| 25 | +# ↓ Git itself suggests 9 characters, and 12 characters may be a better |
| 26 | +# ↓ choice for the hundred-year language… but let's increase it only |
| 27 | +# ↓ when needed |
| 28 | +my $SHA-LENGTH = 8; |
| 29 | +my $RELEASE-HOUR = 19; # GMT+0 |
| 30 | +my $BLOCKERS-URL = ‘https://perl6.fail/release/blockers.json’; |
| 31 | +my $TICKET-URL = ‘https://rt.perl.org/rt3/Public/Bug/Display.html?id=’; |
| 32 | + |
| 33 | +method help($msg) { |
| 34 | + “status | status link” |
| 35 | +} |
| 36 | + |
| 37 | +sub ignored-commits() { |
| 38 | + my $last-release = to-full-commit chomp slurp “$RAKUDO/VERSION”; |
| 39 | + die ‘Cannot resolve the tag for the last release’ unless $last-release; |
| 40 | + my $result = run :out, :cwd($RAKUDO), ‘git’, ‘log’, ‘--pretty=%b’, |
| 41 | + ‘-z’, “$last-release..HEAD”, ‘--’, ‘docs/ChangeLog’; |
| 42 | + die ‘Cannot git log the changelog’ unless $result; |
| 43 | + |
| 44 | + return gather for $result.out.split(0.chr, :skip-empty) { |
| 45 | + next unless /‘not logged’\N*‘:’ \s* [ @<shas>=[<.xdigit>**4..* ] ]+ % \s+/; |
| 46 | + { take ~$_ if .chars == $SHA-LENGTH } for @<shas> |
| 47 | + } |
| 48 | +} |
| 49 | + |
| 50 | +sub time-left($then) { |
| 51 | + my $time-left = $then.Instant - now; |
| 52 | + my ($seconds, $minutes, $hours, $days) = $time-left.polymod: 60, 60, 24; |
| 53 | + return ‘is just a few moments away’ if not $days and not $hours; |
| 54 | + my $answer = ‘in ’; |
| 55 | + $answer ~= “$days day{$days ≠ 1 ?? ‘s’ !! ‘’} and ” if $days; |
| 56 | + $answer ~= “≈$hours hour{$hours ≠ 1 ?? ‘s’ !! ‘’}”; |
| 57 | + $answer |
| 58 | +} |
| 59 | + |
| 60 | +sub time-to-release($msg) { |
| 61 | + my $guide = slurp “$RAKUDO/docs/release_guide.pod”; |
| 62 | + die ‘Unable to parse the release guide’ unless $guide ~~ / |
| 63 | + ^^ ‘=head2 Planned future releases’ $$ |
| 64 | + .*? |
| 65 | + (^^‘ ’(\d\d\d\d‘-’\d\d‘-’\d\d)\s+ ‘Rakudo #’(\d+) [\s+‘(’ (<-[)]>+) ‘)’]? \n)+ |
| 66 | + /; |
| 67 | + my @dates = $0.map: { %(date => Date.new(~.[0]), id => +.[1], manager => (.Str with .[2])) }; |
| 68 | + my $important-date; |
| 69 | + my $annoying-warning = False; |
| 70 | + for @dates { |
| 71 | + my $release = .<date>.yyyy-mm-dd.split(‘-’)[0,1].join: ‘.’; |
| 72 | + if not to-full-commit $release { |
| 73 | + $important-date = $_; |
| 74 | + if not .<manager> and not $annoying-warning { |
| 75 | + $msg.reply: “Release manager is not specified yet.” |
| 76 | + } |
| 77 | + last |
| 78 | + } |
| 79 | + if not $annoying-warning { |
| 80 | + $annoying-warning = True; |
| 81 | + $msg.reply: “Release date for Rakudo $release is listed in” |
| 82 | + ~ “ “Planned future releases”, but it was already released.”; |
| 83 | + } |
| 84 | + } |
| 85 | + die ‘Release date not found’ without $important-date; |
| 86 | + my $time-left = time-left DateTime.new(date => $important-date<date>, |
| 87 | + hour => $RELEASE-HOUR); |
| 88 | + “Next release $time-left” |
| 89 | +} |
| 90 | + |
| 91 | +sub changelog-to-stats($changelog) { |
| 92 | + if not $changelog.match: /^ ‘New in ’ (.*?) ‘:’ (.*?) ^^ ‘New in ’ (.*?) ‘:’/ { |
| 93 | + return { summary => ‘Unknown changelog format’ } |
| 94 | + } |
| 95 | + my ($version, $changes, $version-old) = ~$0, ~$1, ~$2; |
| 96 | + |
| 97 | + my $actual-commit = to-full-commit $version; |
| 98 | + with $actual-commit { |
| 99 | + return { summary => ‘Changelog for this release was not started yet’ } |
| 100 | + } |
| 101 | + my $actual-commit-old = to-full-commit $version-old; |
| 102 | + die ‘Cannot resolve the tag for the previous release’ without $actual-commit-old; |
| 103 | + |
| 104 | + my @shas = $changes.match(:g, / [‘[’ (<.xdigit>**4..*) ‘]’ \s*]+ $$/)»[0].flat».Str; |
| 105 | + my $result = run :out, :cwd($RAKUDO), ‘git’, ‘log’, ‘-z’, ‘--pretty=%H’, |
| 106 | + ‘--reverse’, “$actual-commit-old..HEAD”; |
| 107 | + die ‘Failed to query rakudo git log’ unless $result; |
| 108 | + my @git-commits = $result.out.slurp-rest.split(0.chr, :skip-empty) |
| 109 | + .map: *.substr: 0, $SHA-LENGTH; |
| 110 | + my @warnings; |
| 111 | + my $commit-mentioned = set gather for @shas { |
| 112 | + when .chars ≠ $SHA-LENGTH { |
| 113 | + @warnings.push: “$_ should be $SHA-LENGTH characters in length” |
| 114 | + } |
| 115 | + when @git-commits.none { |
| 116 | + @warnings.push: “$_ was referenced but there is no commit with this id” |
| 117 | + } |
| 118 | + default { take $_ } |
| 119 | + } |
| 120 | + my $ignored = set ignored-commits; |
| 121 | + my @unlogged = @git-commits.grep: * !∈ ($commit-mentioned ∪ $ignored); # ordered |
| 122 | + my $summary = “{@git-commits - @unlogged} out of {+@git-commits} commits logged”; |
| 123 | + { :$summary, :@unlogged, :@warnings } |
| 124 | +} |
| 125 | + |
| 126 | +sub blockers() { |
| 127 | + use HTTP::UserAgent; |
| 128 | + my $ua = HTTP::UserAgent.new; |
| 129 | + my $response = try { $ua.get: $BLOCKERS-URL }; |
| 130 | + return { summary => ‘R6 is down’ } without $response; |
| 131 | + return { summary => ‘R6 is down’ } unless $response.is-success; |
| 132 | + if $response.content-type ne ‘application/json;charset=UTF-8’ { |
| 133 | + return { summary => ‘R6 is weird’ } |
| 134 | + } |
| 135 | + my %data = from-json $response.decoded-content; |
| 136 | + return { summary => ‘R6 is weird’ } unless %data<tickets>:exists; |
| 137 | + my @tickets = %data<tickets>.list; |
| 138 | + return { summary => ‘No blockers’ } unless @tickets; |
| 139 | + my $summary = “{+@tickets} blocker{@tickets ≠ 1 ?? ‘s’ !! ‘’}”; |
| 140 | + {:$summary, :@tickets} |
| 141 | +} |
| 142 | + |
| 143 | +multi method irc-to-me($msg where /^ \s* [changelog|status|release|when]‘?’? |
| 144 | + [\s+ $<url>=[‘http’.*]]? $/) { |
| 145 | + my $changelog = process-url ~$_, $msg with $<url>; |
| 146 | + $changelog //= slurp “$RAKUDO/docs/ChangeLog”; |
| 147 | + my $answer = time-to-release($msg) ~ ‘. ’ without $<url>; |
| 148 | + my %stats = changelog-to-stats $changelog; |
| 149 | + my %blockers = blockers without $<url>; |
| 150 | + |
| 151 | + # ↓ All code here just to make the message pretty ↓ |
| 152 | + $answer ~= “$_. ” with %blockers<summary>; |
| 153 | + $answer ~= %stats<summary>; |
| 154 | + $answer ~= “ (⚠ {+%stats<warnings>} warnings)” if %stats<warnings>; |
| 155 | + $msg.reply: $answer; |
| 156 | + return if none %blockers<tickets>, %stats<unlogged>, %stats<warnings>; |
| 157 | + |
| 158 | + # ↓ And here just to make a pretty gist ↓ |
| 159 | + my &escape-html = { .trans: (‘&’, ‘<’, ‘>’) => (‘&’, ‘<’, ‘>’) }; |
| 160 | + my %files; |
| 161 | + |
| 162 | + my $blockers = join “\n”, (%blockers<tickets> // ()).map: { ‘<a href="’ |
| 163 | + ~ $TICKET-URL ~ .<ticket_id> ~ ‘">RT #’ |
| 164 | + ~ .<ticket_id> ~ ‘</a> ’ ~ escape-html .<subject> }; |
| 165 | + %files<!blockers!.md> = ‘<pre>’ ~ $blockers ~ ‘</pre>’ if %blockers<tickets>; |
| 166 | + |
| 167 | + my $warnings = .join(“\n”) with %stats<warnings>; |
| 168 | + %files<!warnings!> = $warnings if $warnings; |
| 169 | + |
| 170 | + with %stats<unlogged> { |
| 171 | + my $descs = run :out, :cwd($RAKUDO), ‘git’, ‘show’, |
| 172 | + ‘--format=%s’, |
| 173 | + “--abbrev=$SHA-LENGTH”, ‘--quiet’, |$_; |
| 174 | + my $links = run :out, :cwd($RAKUDO), ‘git’, ‘show’, |
| 175 | + ‘--format=[<a href="’ ~ $RAKUDO-REPO ~ ‘/commit/%H">%h</a>]’, |
| 176 | + “--abbrev=$SHA-LENGTH”, ‘--quiet’, |$_; |
| 177 | + my $unreviewed = join “\n”, ($descs.out.lines Z $links.out.lines).map: |
| 178 | + {‘ + ’ ~ escape-html(.[0]) ~ ‘ ’ ~ .[1]}; |
| 179 | + %files<unreviewed.md> = ‘<pre>’ ~ $unreviewed ~ ‘</pre>’ if $unreviewed; |
| 180 | + } |
| 181 | + (‘’ but FileStore(%files)) but PrettyLink({“Details: $_”}) |
| 182 | +} |
| 183 | + |
| 184 | +Releasable.new.selfrun: ‘releasable6’, [ / release6? <before ‘:’> /, |
| 185 | + fuzzy-nick(‘releasable6’, 2) ] |
| 186 | + |
| 187 | +# vim: expandtab shiftwidth=4 ft=perl6 |
0 commit comments