diff --git a/Koha/Devel/CI/IncrementalRuns.pm b/Koha/Devel/CI/IncrementalRuns.pm new file mode 100644 index 0000000000..d63510e72b --- /dev/null +++ b/Koha/Devel/CI/IncrementalRuns.pm @@ -0,0 +1,179 @@ +package Koha::Devel::CI::IncrementalRuns; + +# This file is part of Koha. +# +# Koha is free software; you can redistribute it and/or modify it +# under the terms of the GNU General Public License as published by +# the Free Software Foundation; either version 3 of the License, or +# (at your option) any later version. +# +# Koha is distributed in the hope that it will be useful, but +# WITHOUT ANY WARRANTY; without even the implied warranty of +# MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the +# GNU General Public License for more details. +# +# You should have received a copy of the GNU General Public License +# along with Koha; if not, see . + +use Modern::Perl; + +use File::Path qw(make_path); +use File::Slurp qw(read_file write_file); +use File::Basename; +use JSON qw(from_json to_json); +use List::MoreUtils qw(firstval); + +use Koha::Devel::Files; + +=head1 NAME + +Koha::Devel::CI::IncrementalRuns - A module for managing incremental CI runs in Koha development. + +=head1 SYNOPSIS + + use Koha::Devel::CI::IncrementalRuns; + + my $ci = Koha::Devel::CI::IncrementalRuns->new({ + context => 'tidy', + }); + + my @files_to_test = $ci->get_files_to_test('pl'); + $ci->report_results($results); + +=head1 DESCRIPTION + +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. + +=head1 METHODS + +=head2 new + + my $ci = Koha::Devel::CI::IncrementalRuns->new({ + incremental_run => 1, + git_repo_dir => '/path/to/repo', + repo_url => 'gitlab.com/koha-community/koha-ci-results.git', + report => 1, + token => 'your_token', + test_name => 'test_name', + context => 'tidy', + }); + +Creates a new instance of Koha::Devel::CI::IncrementalRuns. The constructor accepts a hash reference with the following keys: +- `incremental_run`: A flag indicating whether to run incrementally the tests [default env KOHA_CI_INCREMENTAL_RUNS] +- `git_repo_dir`: The directory where the Git repository is stored [default /tmp/koha-ci-results] +- `repo_url`: The URL of the Git repository [default env KOHA_CI_INCREMENTAL_RUN_REPO_URL] +- `report`: A flag indicating whether to report the results [default env KOHA_CI_INCREMENTAL_RUNS_REPORT] +- `token`: The token for authenticating with the Git repository [default env KOHA_CI_INCREMENTAL_RUNS_TOKEN] +- `test_name`: The name of the test [default name of the test] +- `context`: The context for file exclusions + +=cut + +sub new { + my ( $class, $args ) = @_; + + my $self = { + incremental_run => $ENV{KOHA_CI_INCREMENTAL_RUNS} // 0, + git_repo_dir => $args->{git_repo_dir} // q{/tmp/koha-ci-results}, + repo_url => $args->{repo_url} // $ENV{KOHA_CI_INCREMENTAL_RUN_REPO_URL} + // q{gitlab.com/koha-community/koha-ci-results.git}, + report => $args->{report} // $ENV{KOHA_CI_INCREMENTAL_RUNS_REPORT}, + token => $args->{token} // $ENV{KOHA_CI_INCREMENTAL_RUNS_TOKEN}, + test_name => $args->{test_name}, + context => $args->{context}, + }; + bless $self, $class; + + unless ( $self->{test_name} ) { + my @caller_info = caller(); + my $script_filename = $caller_info[1]; + $self->{test_name} = basename($script_filename); + $self->{test_name} =~ s|/|_|g; + $self->{test_name} =~ s|\..*$||g; + } + + if ( $self->{git_repo_dir} && $self->{repo_url} ) { + unless ( -d $self->{git_repo_dir} ) { + qx{git clone $self->{repo_url} $self->{git_repo_dir}}; + } + qx{git -C $self->{git_repo_dir} fetch origin}; + + make_path("$self->{git_repo_dir}/$self->{test_name}"); + } + return $self; +} + +=head2 get_files_to_test + + my @files_to_test = $ci->get_files_to_test('pl'); + +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. + +=cut + +sub get_files_to_test { + my ( $self, $filetype ) = @_; + + my @files; + my $dev_files = Koha::Devel::Files->new( { context => $self->{context} } ); + my $no_history; + if ( $self->{incremental_run} ) { + my @koha_commit_history = qx{git log --pretty=format:"%h"}; + my @tested_commit_history = qx{ls $self->{git_repo_dir}/$self->{test_name}}; + chomp for @koha_commit_history, @tested_commit_history; + if (@tested_commit_history) { + my $last_build_commit = firstval { + my $commit = $_; + grep { $_ eq $commit } @tested_commit_history + } + @koha_commit_history; + if ($last_build_commit) { + @files = @{ from_json( read_file("$self->{git_repo_dir}/$self->{test_name}/$last_build_commit") ) }; + push @files, $dev_files->ls_perl_files("$last_build_commit HEAD"); + } else { + + # In case we run on a branch that does not have ancestor commits in the history + # We should not reach this on Jenkins + $no_history = 1; + } + } else { + $no_history = 1; + } + } + @files = $dev_files->ls_perl_files if !$self->{incremental_run} || $no_history; + + return @files; +} + +=head2 report_results + + $ci->report_results($results); + +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. + +=cut + +sub report_results { + my ( $self, $results ) = @_; + + return unless $self->{report}; + + my $commit_id = qx{git rev-parse --short HEAD}; + chomp $commit_id; + + my $failure_file = "$self->{git_repo_dir}/$self->{test_name}/$commit_id"; + my $failures = [ + sort map { + my ( $file, $exit_code ) = ( $_, $results->{$_} ); + ( $exit_code ? $file : () ) + } keys %$results + ]; + + write_file( $failure_file, to_json($failures) ); + + qx{git -C $self->{git_repo_dir} add $failure_file}; + qx{git -C $self->{git_repo_dir} commit -m "$commit_id - $self->{test_name}"}; + qx{git -C $self->{git_repo_dir} push https://gitlab-ci-token:$self->{token}\@$self->{repo_url} main}; +} + +1; diff --git a/Koha/Devel/Files.pm b/Koha/Devel/Files.pm index 7e75621c78..d2e0a2e4d1 100644 --- a/Koha/Devel/Files.pm +++ b/Koha/Devel/Files.pm @@ -1,7 +1,7 @@ package Koha::Devel::Files; use Modern::Perl; -our ( @ISA, @EXPORT_OK ); +use Array::Utils qw( array_minus ); =head1 NAME @@ -155,11 +155,22 @@ Lists Perl files (with extensions .pl, .PL, .pm, .t) that have been modified wit =cut sub ls_perl_files { - my ($self) = @_; - my $cmd = sprintf q{git ls-files '*.pl' '*.PL' '*.pm' '*.t' svc opac/svc opac/unapi debian/build-git-snapshot %s}, - $self->build_git_exclude('pl'); - my @files = qx{$cmd}; - chomp for @files; + my ( $self, $git_range ) = @_; + my @files; + if ($git_range) { + $git_range =~ s|\.\.| |; + my @modified_files = qx{git diff --name-only $git_range}; + chomp @modified_files; + push @files, grep { /\.(pl|PL|pm|t)$/ } @modified_files; + push @files, grep { /^(svc|opac\/svc)/ } @modified_files; + my @exception_files = $exceptions->{pl}->{ $self->{context} }; + @files = array_minus( @files, @exception_files ); + } else { + my $cmd = sprintf q{git ls-files '*.pl' '*.PL' '*.pm' '*.t' svc opac/svc opac/unapi debian/build-git-snapshot %s}, + $self->build_git_exclude('pl'); + @files = qx{$cmd}; + chomp for @files; + } return @files; } diff --git a/xt/pl_valid.t b/xt/pl_valid.t index 55bda4ee4b..199909dacf 100755 --- a/xt/pl_valid.t +++ b/xt/pl_valid.t @@ -18,16 +18,17 @@ use Modern::Perl; use threads; # used for parallel use Test::More; + use Test::NoWarnings; use Pod::Checker; use Parallel::ForkManager; use Sys::CPU; -use Koha::Devel::Files; +use Koha::Devel::CI::IncrementalRuns; -my $dev_files = Koha::Devel::Files->new( { context => 'valid' } ); -my @files = $dev_files->ls_perl_files; +my $ci = Koha::Devel::CI::IncrementalRuns->new( { context => 'valid' } ); +my @files = $ci->get_files_to_test('pl'); my $ncpu; if ( $ENV{KOHA_PROVE_CPUS} ) { @@ -37,16 +38,25 @@ if ( $ENV{KOHA_PROVE_CPUS} ) { } my $pm = Parallel::ForkManager->new($ncpu); +my %results; +$pm->run_on_finish( + sub { + my ( $pid, $exit_code, $ident, $exit_signal, $core_dump, $data ) = @_; + $results{$ident} = $exit_code; + } +); plan tests => scalar(@files) + 1; for my $file (@files) { - $pm->start and next; + $pm->start($file) and next; my $output = `perl -cw '$file' 2>&1`; chomp $output; + my $exit_code = 0; if ($?) { fail("$file has syntax errors"); diag($output); + $exit_code = 1; } elsif ( $output =~ /^$file syntax OK$/ ) { pass("$file passed syntax check"); } else { @@ -62,11 +72,14 @@ for my $file (@files) { if (@fails) { fail("$file has syntax warnings."); diag( join "\n", @fails ); + $exit_code = 1; } else { pass("$file passed syntax check"); } } - $pm->finish; + $pm->finish($exit_code); } $pm->wait_all_children; + +$ci->report_results( \%results );