The Perl Toolchain Summit 2025 Needs You: You can help 🙏 Learn more

# Copyright 2014 - present MongoDB, Inc.
#
# Licensed under the Apache License, Version 2.0 (the "License");
# you may not use this file except in compliance with the License.
# You may obtain a copy of the License at
#
#
# Unless required by applicable law or agreed to in writing, software
# distributed under the License is distributed on an "AS IS" BASIS,
# WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied.
# See the License for the specific language governing permissions and
# limitations under the License.
use 5.008001;
use strict;
our $VERSION = 0.001;
use Dist::Zilla 5 ();
use Moose;
use namespace::clean -except => 'meta';
has changelog => (
is => 'ro',
isa => 'Str',
default => 'Changes'
);
sub gather_files {
my ( $self, $arg ) = @_;
my $zilla = $self->zilla;
my $newver = $self->zilla->version;
my $commits = $self->_extract_jira_commits;
my $test_file = <<'TESTFILE';
#!perl
use strict;
use warnings;
# This test was generated by inc::CheckJiraInChanges
use Test::More;
plan skip_all => "Disabled" if $ENV{NO_JIRA_CHECK};
my @commits = split /\n/, <<'EOC';
INSERT_COMMITS_HERE
EOC
my %ticket_map;
for my $commit ( @commits ) {
next if $commit =~ /PERL-\d+:?\s+CI:/i;
for my $ticket ( $commit =~ /PERL-(\d+)/g ) {
next if $ENV{CHECK_JIRA_SKIP}
&& grep { $ticket eq $_ } split " ", $ENV{CHECK_JIRA_SKIP};
$ticket_map{$ticket} ||= [];
push @{$ticket_map{$ticket}}, $commit;
}
}
# grab Changes lines from new version to next un-indented line
open my $fh, "<:encoding(UTF-8)", "Changes";
my $changelog = do { local $/; <$fh> };
my @bad;
for my $ticket ( keys %ticket_map ) {
if ( index( $changelog, "PERL-$ticket" ) < 0 ) {
push @bad, $ticket;
}
}
if ( !@commits ) {
pass("No commits with Jira tickets");
}
else {
ok( ! scalar @bad, "Jira tickets in Changes")
or diag "Jira tickets missing:\n"
. join("\n", map { " * $_" } map { @{$ticket_map{$_}} } sort { $a <=> $b } @bad );
}
done_testing();
TESTFILE
$test_file =~ s/INSERT_VERSION_HERE/$newver/;
$test_file =~ s/INSERT_COMMITS_HERE/$commits/;
my $file = Dist::Zilla::File::InMemory->new(
{
name => "xt/release/check-jira-in-changes.t",
content => $test_file,
}
);
$self->add_file($file);
return;
}
sub _extract_jira_commits {
my $last_tag = qx/git describe --abbrev=0/;
chomp $last_tag;
return join( "", grep { /PERL-\d+/ } qx/git log --oneline $last_tag..HEAD/ );
}
__PACKAGE__->meta->make_immutable;
1;
# vim: ts=4 sts=4 sw=4 et: