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

(-)a/Koha/Devel/CI/IncrementalRuns.pm (+180 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;
180
(-)a/Koha/Devel/Files.pm (-5 / +16 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 127-136 Lists Perl files (with extensions .pl, .PL, .pm, .t) that have been modified wit Link Here
127
=cut
127
=cut
128
128
129
sub ls_perl_files {
129
sub ls_perl_files {
130
    my ($self) = @_;
130
    my ( $self, $git_range ) = @_;
131
    my $cmd    = sprintf q{git ls-files '*.pl' '*.PL' '*.pm' '*.t' svc opac/svc %s}, $self->build_git_exclude('pl');
131
    my @files;
132
    my @files  = qx{$cmd};
132
    if ($git_range) {
133
    chomp for @files;
133
        $git_range =~ s|\.\.| |;
134
        my @modified_files = qx{git diff --name-only $git_range};
135
        chomp @modified_files;
136
        push @files, grep { /\.(pl|PL|pm|t)$/ } @modified_files;
137
        push @files, grep { /^(svc|opac\/svc)/ } @modified_files;
138
        my @exception_files = $exceptions->{pl}->{ $self->{context} };
139
        @files = array_minus( @files, @exception_files );
140
    } else {
141
        my $cmd = sprintf q{git ls-files '*.pl' '*.PL' '*.pm' '*.t' svc opac/svc %s}, $self->build_git_exclude('pl');
142
        @files = qx{$cmd};
143
        chomp for @files;
144
    }
134
    return @files;
145
    return @files;
135
}
146
}
136
147
(-)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;
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