View | Details | Raw Unified | Return to bug 39877
Collapse All | Expand All

(-)a/Koha/Devel/CI/IncrementalRuns.pm (+179 lines)
Line 0 Link Here
1
package Koha::Devel::CI::IncrementalRuns;
2
3
# This file is part of Koha.
4
#
5
# Koha is free software; you can redistribute it and/or modify it
6
# under the terms of the GNU 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
# Koha is distributed in the hope that it will be useful, but
11
# WITHOUT ANY WARRANTY; without even the implied warranty of
12
# MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
13
# GNU General Public License for more details.
14
#
15
# You should have received a copy of the GNU General Public License
16
# along with Koha; if not, see <http://www.gnu.org/licenses>.
17
18
use Modern::Perl;
19
20
use File::Path  qw(make_path);
21
use File::Slurp qw(read_file write_file);
22
use File::Basename;
23
use JSON            qw(from_json to_json);
24
use List::MoreUtils qw(firstval);
25
26
use Koha::Devel::Files;
27
28
=head1 NAME
29
30
Koha::Devel::CI::IncrementalRuns - A module for managing incremental CI runs in Koha development.
31
32
=head1 SYNOPSIS
33
34
    use Koha::Devel::CI::IncrementalRuns;
35
36
    my $ci = Koha::Devel::CI::IncrementalRuns->new({
37
        context      => 'tidy',
38
    });
39
40
    my @files_to_test = $ci->get_files_to_test('pl');
41
    $ci->report_results($results);
42
43
=head1 DESCRIPTION
44
45
Koha::Devel::CI::IncrementalRuns is a module designed to manage incremental CI runs in the Koha development environment. It provides functionality to determine which files need to be tested based on previous CI runs and to report the results of those tests.
46
47
=head1 METHODS
48
49
=head2 new
50
51
    my $ci = Koha::Devel::CI::IncrementalRuns->new({
52
        incremental_run => 1,
53
        git_repo_dir    => '/path/to/repo',
54
        repo_url        => 'gitlab.com/koha-community/koha-ci-results.git',
55
        report          => 1,
56
        token           => 'your_token',
57
        test_name       => 'test_name',
58
        context         => 'tidy',
59
    });
60
61
Creates a new instance of Koha::Devel::CI::IncrementalRuns. The constructor accepts a hash reference with the following keys:
62
- `incremental_run`: A flag indicating whether to run incrementally the tests [default env KOHA_CI_INCREMENTAL_RUNS]
63
- `git_repo_dir`: The directory where the Git repository is stored [default /tmp/koha-ci-results]
64
- `repo_url`: The URL of the Git repository [default env KOHA_CI_INCREMENTAL_RUN_REPO_URL]
65
- `report`: A flag indicating whether to report the results [default env KOHA_CI_INCREMENTAL_RUNS_REPORT]
66
- `token`: The token for authenticating with the Git repository [default env KOHA_CI_INCREMENTAL_RUNS_TOKEN]
67
- `test_name`: The name of the test [default name of the test]
68
- `context`: The context for file exclusions
69
70
=cut
71
72
sub new {
73
    my ( $class, $args ) = @_;
74
75
    my $self = {
76
        incremental_run => $ENV{KOHA_CI_INCREMENTAL_RUNS} // 0,
77
        git_repo_dir    => $args->{git_repo_dir}          // q{/tmp/koha-ci-results},
78
        repo_url        => $args->{repo_url}              // $ENV{KOHA_CI_INCREMENTAL_RUN_REPO_URL}
79
            // q{gitlab.com/koha-community/koha-ci-results.git},
80
        report    => $args->{report} // $ENV{KOHA_CI_INCREMENTAL_RUNS_REPORT},
81
        token     => $args->{token}  // $ENV{KOHA_CI_INCREMENTAL_RUNS_TOKEN},
82
        test_name => $args->{test_name},
83
        context   => $args->{context},
84
    };
85
    bless $self, $class;
86
87
    unless ( $self->{test_name} ) {
88
        my @caller_info     = caller();
89
        my $script_filename = $caller_info[1];
90
        $self->{test_name} = basename($script_filename);
91
        $self->{test_name} =~ s|/|_|g;
92
        $self->{test_name} =~ s|\..*$||g;
93
    }
94
95
    if ( $self->{git_repo_dir} && $self->{repo_url} ) {
96
        unless ( -d $self->{git_repo_dir} ) {
97
            qx{git clone $self->{repo_url} $self->{git_repo_dir}};
98
        }
99
        qx{git -C $self->{git_repo_dir} fetch origin};
100
101
        make_path("$self->{git_repo_dir}/$self->{test_name}");
102
    }
103
    return $self;
104
}
105
106
=head2 get_files_to_test
107
108
    my @files_to_test = $ci->get_files_to_test('pl');
109
110
Determines the list of files to be tested based on the incremental run settings. If incremental runs are enabled, it retrieves the list of files that have been modified since the last build. Otherwise, it retrieves all relevant files.
111
112
=cut
113
114
sub get_files_to_test {
115
    my ( $self, $filetype ) = @_;
116
117
    my @files;
118
    my $dev_files = Koha::Devel::Files->new( { context => $self->{context} } );
119
    my $no_history;
120
    if ( $self->{incremental_run} ) {
121
        my @koha_commit_history   = qx{git log --pretty=format:"%h"};
122
        my @tested_commit_history = qx{ls $self->{git_repo_dir}/$self->{test_name}};
123
        chomp for @koha_commit_history, @tested_commit_history;
124
        if (@tested_commit_history) {
125
            my $last_build_commit = firstval {
126
                my $commit = $_;
127
                grep { $_ eq $commit } @tested_commit_history
128
            }
129
            @koha_commit_history;
130
            if ($last_build_commit) {
131
                @files = @{ from_json( read_file("$self->{git_repo_dir}/$self->{test_name}/$last_build_commit") ) };
132
                push @files, $dev_files->ls_perl_files("$last_build_commit HEAD");
133
            } else {
134
135
                # In case we run on a branch that does not have ancestor commits in the history
136
                # We should not reach this on Jenkins
137
                $no_history = 1;
138
            }
139
        } else {
140
            $no_history = 1;
141
        }
142
    }
143
    @files = $dev_files->ls_perl_files if !$self->{incremental_run} || $no_history;
144
145
    return @files;
146
}
147
148
=head2 report_results
149
150
    $ci->report_results($results);
151
152
Reports the results of the tests by committing the list of failures to the Git repository. This method is called only if the `report` flag is set.
153
154
=cut
155
156
sub report_results {
157
    my ( $self, $results ) = @_;
158
159
    return unless $self->{report};
160
161
    my $commit_id = qx{git rev-parse --short HEAD};
162
    chomp $commit_id;
163
164
    my $failure_file = "$self->{git_repo_dir}/$self->{test_name}/$commit_id";
165
    my $failures     = [
166
        sort map {
167
            my ( $file, $exit_code ) = ( $_, $results->{$_} );
168
            ( $exit_code ? $file : () )
169
        } keys %$results
170
    ];
171
172
    write_file( $failure_file, to_json($failures) );
173
174
    qx{git -C $self->{git_repo_dir} add $failure_file};
175
    qx{git -C $self->{git_repo_dir} commit -m "$commit_id - $self->{test_name}"};
176
    qx{git -C $self->{git_repo_dir} push https://gitlab-ci-token:$self->{token}\@$self->{repo_url} main};
177
}
178
179
1;
(-)a/Koha/Devel/Files.pm (-6 / +17 lines)
Lines 1-7 Link Here
1
package Koha::Devel::Files;
1
package Koha::Devel::Files;
2
2
3
use Modern::Perl;
3
use Modern::Perl;
4
our ( @ISA, @EXPORT_OK );
4
use Array::Utils qw( array_minus );
5
5
6
=head1 NAME
6
=head1 NAME
7
7
Lines 147-157 Lists Perl files (with extensions .pl, .PL, .pm, .t) that have been modified wit Link Here
147
=cut
147
=cut
148
148
149
sub ls_perl_files {
149
sub ls_perl_files {
150
    my ($self) = @_;
150
    my ( $self, $git_range ) = @_;
151
    my $cmd = sprintf q{git ls-files '*.pl' '*.PL' '*.pm' '*.t' svc opac/svc debian/build-git-snapshot %s},
151
    my @files;
152
        $self->build_git_exclude('pl');
152
    if ($git_range) {
153
    my @files = qx{$cmd};
153
        $git_range =~ s|\.\.| |;
154
    chomp for @files;
154
        my @modified_files = qx{git diff --name-only $git_range};
155
        chomp @modified_files;
156
        push @files, grep { /\.(pl|PL|pm|t)$/ } @modified_files;
157
        push @files, grep { /^(svc|opac\/svc)/ } @modified_files;
158
        my @exception_files = $exceptions->{pl}->{ $self->{context} };
159
        @files = array_minus( @files, @exception_files );
160
    } else {
161
        my $cmd = sprintf q{git ls-files '*.pl' '*.PL' '*.pm' '*.t' svc opac/svc debian/build-git-snapshot %s},
162
            $self->build_git_exclude('pl');
163
        @files = qx{$cmd};
164
        chomp for @files;
165
    }
155
    return @files;
166
    return @files;
156
}
167
}
157
168
(-)a/xt/pl_valid.t (-6 / +18 lines)
Lines 18-33 Link Here
18
use Modern::Perl;
18
use Modern::Perl;
19
use threads;    # used for parallel
19
use threads;    # used for parallel
20
use Test::More;
20
use Test::More;
21
21
use Test::NoWarnings;
22
use Test::NoWarnings;
22
use Pod::Checker;
23
use Pod::Checker;
23
24
24
use Parallel::ForkManager;
25
use Parallel::ForkManager;
25
use Sys::CPU;
26
use Sys::CPU;
26
27
27
use Koha::Devel::Files;
28
use Koha::Devel::CI::IncrementalRuns;
28
29
29
my $dev_files = Koha::Devel::Files->new( { context => 'valid' } );
30
my $ci    = Koha::Devel::CI::IncrementalRuns->new( { context => 'valid' } );
30
my @files     = $dev_files->ls_perl_files;
31
my @files = $ci->get_files_to_test('pl');
31
32
32
my $ncpu;
33
my $ncpu;
33
if ( $ENV{KOHA_PROVE_CPUS} ) {
34
if ( $ENV{KOHA_PROVE_CPUS} ) {
Lines 37-52 if ( $ENV{KOHA_PROVE_CPUS} ) { Link Here
37
}
38
}
38
39
39
my $pm = Parallel::ForkManager->new($ncpu);
40
my $pm = Parallel::ForkManager->new($ncpu);
41
my %results;
42
$pm->run_on_finish(
43
    sub {
44
        my ( $pid, $exit_code, $ident, $exit_signal, $core_dump, $data ) = @_;
45
        $results{$ident} = $exit_code;
46
    }
47
);
40
48
41
plan tests => scalar(@files) + 1;
49
plan tests => scalar(@files) + 1;
42
50
43
for my $file (@files) {
51
for my $file (@files) {
44
    $pm->start and next;
52
    $pm->start($file) and next;
45
    my $output = `perl -cw '$file' 2>&1`;
53
    my $output = `perl -cw '$file' 2>&1`;
46
    chomp $output;
54
    chomp $output;
55
    my $exit_code = 0;
47
    if ($?) {
56
    if ($?) {
48
        fail("$file has syntax errors");
57
        fail("$file has syntax errors");
49
        diag($output);
58
        diag($output);
59
        $exit_code = 1;
50
    } elsif ( $output =~ /^$file syntax OK$/ ) {
60
    } elsif ( $output =~ /^$file syntax OK$/ ) {
51
        pass("$file passed syntax check");
61
        pass("$file passed syntax check");
52
    } else {
62
    } else {
Lines 62-72 for my $file (@files) { Link Here
62
        if (@fails) {
72
        if (@fails) {
63
            fail("$file has syntax warnings.");
73
            fail("$file has syntax warnings.");
64
            diag( join "\n", @fails );
74
            diag( join "\n", @fails );
75
            $exit_code = 1;
65
        } else {
76
        } else {
66
            pass("$file passed syntax check");
77
            pass("$file passed syntax check");
67
        }
78
        }
68
    }
79
    }
69
    $pm->finish;
80
    $pm->finish($exit_code);
70
}
81
}
71
82
72
$pm->wait_all_children;
83
$pm->wait_all_children;
73
- 
84
85
$ci->report_results( \%results );

Return to bug 39877