Bug 39876: Move `git ls-files` to Koha::Devel::Files

This patch introduces a new Koha::Devel namespace. It clearly shows
that its purpose is for development and will not contain any business
logic.

Signed-off-by: David Nind <david@davidnind.com>
Signed-off-by: Tomas Cohen Arazi <tomascohen@theke.io>
Signed-off-by: Lucas Gass <lucas@bywatersolutions.com>
(cherry picked from commit 1d4071298c)
Signed-off-by: Paul Derscheid <paul.derscheid@lmscloud.de>
This commit is contained in:
Jonathan Druart 2025-05-12 12:30:55 +02:00 committed by Paul Derscheid
parent 091d002636
commit 87c14156bb
No known key found for this signature in database
GPG Key ID: C25F9FD44CED595B
2 changed files with 153 additions and 55 deletions

141
Koha/Devel/Files.pm Normal file
View File

@ -0,0 +1,141 @@
package Koha::Devel::Files;
use Modern::Perl;
our ( @ISA, @EXPORT_OK );
=head1 NAME
Koha::Devel::Files - A utility module for managing and filtering file lists in the Koha codebase
=head1 SYNOPSIS
use Koha::Devel::Files;
my $file_manager = Koha::Devel::Files->new({ context => 'tidy' });
my @perl_files = $file_manager->ls_perl_files($git_range);
my @js_files = $file_manager->ls_js_files();
my @tt_files = $file_manager->ls_tt_files();
my $filetype = $file_manager->get_filetype($filename);
=head1 DESCRIPTION
Koha::Devel::Files is a utility module designed to assist in managing and filtering lists of files in the Koha codebase. It provides methods to list Perl, JavaScript, and Template Toolkit files, with options to exclude specific files based on a given context.
=head1 EXCEPTIONS
The module defines a set of exceptions for different file types and contexts. These exceptions are used to exclude specific files or directories from the file listings.
=cut
my $exceptions = {
pl => [qw(Koha/Schema/Result Koha/Schema.pm)],
js => [
qw(koha-tmpl/intranet-tmpl/lib koha-tmpl/intranet-tmpl/js/Gettext.js koha-tmpl/opac-tmpl/lib Koha/ILL/Backend/)
],
tt => [qw(Koha/ILL/Backend/ *doc-head-open.inc misc/cronjobs/rss)],
};
=head1 METHODS
=cut
=head2 new
my $file_manager = Koha::Devel::Files->new({ context => 'tidy' });
Creates a new instance of Koha::Devel::Files. The constructor accepts a hash reference with a 'context' key, which specifies the context for file exclusions.
=cut
sub new {
my ($class) = @_;
my $self = {};
bless $self, $class;
return $self;
}
=head2 build_git_exclude
my $exclude_pattern = $file_manager->build_git_exclude($filetype);
Builds a Git exclude pattern for a given file type based on the context provided during object creation.
=cut
sub build_git_exclude {
my ( $self, $filetype ) = @_;
return join( " ", map( "':(exclude)$_'", @{ $exceptions->{$filetype} } ) );
}
=head2 ls_perl_files
my @perl_files = $file_manager->ls_perl_files($git_range);
Lists Perl files (with extensions .pl, .PL, .pm, .t) that have been modified within a specified Git range. If no range is provided, it lists all Perl files, excluding those specified in the exceptions.
=cut
sub ls_perl_files {
my ($self) = @_;
my $cmd = sprintf q{git ls-files '*.pl' '*.PL' '*.pm' '*.t' svc opac/svc %s}, $self->build_git_exclude('pl');
my @files = qx{$cmd};
chomp for @files;
return @files;
}
=head2 ls_js_files
my @js_files = $file_manager->ls_js_files();
Lists JavaScript and TypeScript files (with extensions .js, .ts, .vue) in the repository, excluding those specified in the exceptions.
=cut
sub ls_js_files {
my ($self) = @_;
my $cmd = sprintf q{git ls-files '*.js' '*.ts' '*.vue' %s}, $self->build_git_exclude('js');
my @files = qx{$cmd};
chomp for @files;
return @files;
}
=head2 ls_tt_files
my @tt_files = $file_manager->ls_tt_files();
Lists Template Toolkit files (with extensions .tt, .inc) in the repository, excluding those specified in the exceptions.
=cut
sub ls_tt_files {
my ($self) = @_;
my $cmd = sprintf q{git ls-files '*.tt' '*.inc' %s}, $self->build_git_exclude('tt');
my @files = qx{$cmd};
chomp for @files;
return @files;
}
=head2 get_filetype
my $filetype = $file_manager->get_filetype($filename);
Determines the file type of a given file based on its extension or path. Returns 'pl' for Perl files, 'js' for JavaScript/TypeScript files, and 'tt' for Template Toolkit files. Dies with an error message if the file type cannot be determined.
=cut
sub get_filetype {
my ( $self, $file ) = @_;
return 'pl' if $file =~ m{^svc} || $file =~ m{^opac/svc};
return 'pl' if $file =~ m{\.pl$} || $file =~ m{\.pm} || $file =~ m{\.t$};
return 'pl' if $file =~ m{\.PL$};
return 'js' if $file =~ m{\.js$} || $file =~ m{\.ts$} || $file =~ m{\.vue$};
return 'tt' if $file =~ m{\.inc$} || $file =~ m{\.tt$};
die sprintf 'Cannot guess filetype for %s', $file;
}
1;

View File

@ -8,6 +8,8 @@ use File::Slurp qw( read_file write_file );
use IPC::Cmd qw( run );
use Parallel::ForkManager;
use Koha::Devel::Files;
my ( $perl_files, $js_files, $tt_files, $nproc, $no_write, $silent, $help );
our $perltidyrc = '.perltidyrc';
@ -34,13 +36,7 @@ pod2usage("--no-write can only be passed with a single file") if $no_write && @f
pod2usage("--perl, --js and --tt can only be passed without any other files in parameter")
if @files && ( $perl_files || $js_files || $tt_files );
my $exceptions = {
pl => [qw(Koha/Schema/Result Koha/Schema.pm)],
js => [
qw(koha-tmpl/intranet-tmpl/lib koha-tmpl/intranet-tmpl/js/Gettext.js koha-tmpl/opac-tmpl/lib Koha/ILL/Backend/)
],
tt => [qw(Koha/ILL/Backend/ *doc-head-open.inc misc/cronjobs/rss)],
};
my $dev_files = Koha::Devel::Files->new;
my @original_files = @files;
if (@files) {
@ -48,8 +44,8 @@ if (@files) {
# This is inefficient if the list of files is long but most of the time we will have only one
@files = map {
my $file = $_;
my $filetype = get_filetype($file);
my $cmd = sprintf q{git ls-files %s | grep %s}, build_git_exclude($filetype), $file;
my $filetype = $dev_files->get_filetype($file);
my $cmd = sprintf q{git ls-files %s | grep %s}, $dev_files->build_git_exclude($filetype), $file;
my $output = qx{$cmd};
chomp $output;
$output ? $file : ();
@ -69,14 +65,14 @@ if (@files) {
}
}
} else {
push @files, get_perl_files() if $perl_files;
push @files, get_js_files() if $js_files;
push @files, get_tt_files() if $tt_files;
push @files, $dev_files->ls_perl_files() if $perl_files;
push @files, $dev_files->ls_js_files() if $js_files;
push @files, $dev_files->ls_tt_files() if $tt_files;
unless (@files) {
push @files, get_perl_files();
push @files, get_js_files();
push @files, get_tt_files();
push @files, $dev_files->ls_perl_files();
push @files, $dev_files->ls_js_files();
push @files, $dev_files->ls_tt_files();
}
}
@ -124,7 +120,7 @@ if (@errors) {
sub tidy {
my ($file) = @_;
my $filetype = get_filetype($file);
my $filetype = $dev_files->get_filetype($file);
if ( $filetype eq 'pl' ) {
return tidy_perl($file);
@ -137,32 +133,6 @@ sub tidy {
}
}
sub build_git_exclude {
my ($filetype) = @_;
return join( " ", map( "':(exclude)$_'", @{ $exceptions->{$filetype} } ) );
}
sub get_perl_files {
my $cmd = sprintf q{git ls-files '*.pl' '*.PL' '*.pm' '*.t' svc opac/svc %s}, build_git_exclude('pl');
my @files = qx{$cmd};
chomp for @files;
return @files;
}
sub get_js_files {
my $cmd = sprintf q{git ls-files '*.js' '*.ts' '*.vue' %s}, build_git_exclude('js');
my @files = qx{$cmd};
chomp for @files;
return @files;
}
sub get_tt_files {
my $cmd = sprintf q{git ls-files '*.tt' '*.inc' %s}, build_git_exclude('tt');
my @files = qx{$cmd};
chomp for @files;
return @files;
}
sub tidy_perl {
my ($file) = @_;
my $cmd =
@ -221,19 +191,6 @@ sub tidy_tt {
return ( $success, $error_message, $full_buf, $stdout_buf, $stderr_buf );
}
sub get_filetype {
my ($file) = @_;
return 'pl' if $file =~ m{^svc} || $file =~ m{^opac/svc};
return 'pl' if $file =~ m{\.pl$} || $file =~ m{\.pm} || $file =~ m{\.t$};
return 'pl' if $file =~ m{\.PL$};
return 'js' if $file =~ m{\.js$} || $file =~ m{\.ts$} || $file =~ m{\.vue$};
return 'tt' if $file =~ m{\.inc$} || $file =~ m{\.tt$};
die sprintf 'Cannot guess filetype for %s', $file;
}
sub l {
say shift unless $silent;
}