File: CheckJiraInChanges.pm

package info (click to toggle)
libmongodb-perl 2.2.2-1
  • links: PTS, VCS
  • area: main
  • in suites: bullseye
  • size: 10,264 kB
  • sloc: perl: 14,419; python: 299; makefile: 20; sh: 11
file content (116 lines) | stat: -rw-r--r-- 2,833 bytes parent folder | download | duplicates (2)
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
#  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
#
#  http://www.apache.org/licenses/LICENSE-2.0
#
#  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;
use warnings;

package CheckJiraInChanges;

our $VERSION = 0.001;

use Dist::Zilla 5 ();
use Dist::Zilla::File::InMemory;
use Moose;
use namespace::clean -except => 'meta';

has changelog => (
    is      => 'ro',
    isa     => 'Str',
    default => 'Changes'
);

with 'Dist::Zilla::Role::FileGatherer';

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: