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

(-)a/Koha/Devel/Files.pm (+142 lines)
Line 0 Link Here
1
package Koha::Devel::Files;
2
3
use Modern::Perl;
4
our ( @ISA, @EXPORT_OK );
5
6
=head1 NAME
7
8
Koha::Devel::Files - A utility module for managing and filtering file lists in the Koha codebase
9
10
=head1 SYNOPSIS
11
12
    use Koha::Devel::Files;
13
14
    my $file_manager = Koha::Devel::Files->new({ context => 'tidy' });
15
16
    my @perl_files = $file_manager->ls_perl_files($git_range);
17
    my @js_files   = $file_manager->ls_js_files();
18
    my @tt_files   = $file_manager->ls_tt_files();
19
20
    my $filetype = $file_manager->get_filetype($filename);
21
22
=head1 DESCRIPTION
23
24
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.
25
26
=head1 EXCEPTIONS
27
28
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.
29
30
=cut
31
32
my $exceptions = {
33
    pl => [qw(Koha/Schema/Result Koha/Schema.pm)],
34
    js => [
35
        qw(koha-tmpl/intranet-tmpl/lib koha-tmpl/intranet-tmpl/js/Gettext.js koha-tmpl/opac-tmpl/lib Koha/ILL/Backend/)
36
    ],
37
    tt => [qw(Koha/ILL/Backend/ *doc-head-open.inc misc/cronjobs/rss)],
38
};
39
40
=head1 METHODS
41
42
=cut
43
44
=head2 new
45
46
    my $file_manager = Koha::Devel::Files->new({ context => 'tidy' });
47
48
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.
49
50
=cut
51
52
sub new {
53
    my ($class) = @_;
54
    my $self = {};
55
    bless $self, $class;
56
    return $self;
57
}
58
59
=head2 build_git_exclude
60
61
    my $exclude_pattern = $file_manager->build_git_exclude($filetype);
62
63
Builds a Git exclude pattern for a given file type based on the context provided during object creation.
64
65
=cut
66
67
sub build_git_exclude {
68
    my ( $self, $filetype ) = @_;
69
    return join( " ", map( "':(exclude)$_'", @{ $exceptions->{$filetype} } ) );
70
}
71
72
=head2 ls_perl_files
73
74
    my @perl_files = $file_manager->ls_perl_files($git_range);
75
76
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.
77
78
=cut
79
80
sub ls_perl_files {
81
    my ($self) = @_;
82
    my $cmd    = sprintf q{git ls-files '*.pl' '*.PL' '*.pm' '*.t' svc opac/svc %s}, $self->build_git_exclude('pl');
83
    my @files  = qx{$cmd};
84
    chomp for @files;
85
    return @files;
86
}
87
88
=head2 ls_js_files
89
90
    my @js_files = $file_manager->ls_js_files();
91
92
Lists JavaScript and TypeScript files (with extensions .js, .ts, .vue) in the repository, excluding those specified in the exceptions.
93
94
=cut
95
96
sub ls_js_files {
97
    my ($self) = @_;
98
    my $cmd    = sprintf q{git ls-files '*.js' '*.ts' '*.vue' %s}, $self->build_git_exclude('js');
99
    my @files  = qx{$cmd};
100
    chomp for @files;
101
    return @files;
102
}
103
104
=head2 ls_tt_files
105
106
    my @tt_files = $file_manager->ls_tt_files();
107
108
Lists Template Toolkit files (with extensions .tt, .inc) in the repository, excluding those specified in the exceptions.
109
110
=cut
111
112
sub ls_tt_files {
113
    my ($self) = @_;
114
    my $cmd    = sprintf q{git ls-files '*.tt' '*.inc' %s}, $self->build_git_exclude('tt');
115
    my @files  = qx{$cmd};
116
    chomp for @files;
117
    return @files;
118
}
119
120
=head2 get_filetype
121
122
    my $filetype = $file_manager->get_filetype($filename);
123
124
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.
125
126
=cut
127
128
sub get_filetype {
129
    my ( $self, $file ) = @_;
130
    return 'pl' if $file =~ m{^svc}  || $file =~ m{^opac/svc};
131
    return 'pl' if $file =~ m{\.pl$} || $file =~ m{\.pm} || $file =~ m{\.t$};
132
    return 'pl' if $file =~ m{\.PL$};
133
134
    return 'js' if $file =~ m{\.js$} || $file =~ m{\.ts$} || $file =~ m{\.vue$};
135
136
    return 'tt' if $file =~ m{\.inc$} || $file =~ m{\.tt$};
137
138
    die sprintf 'Cannot guess filetype for %s', $file;
139
}
140
141
1;
142
(-)a/misc/devel/tidy.pl (-56 / +12 lines)
Lines 8-13 use File::Slurp qw( read_file write_file ); Link Here
8
use IPC::Cmd     qw( run );
8
use IPC::Cmd     qw( run );
9
use Parallel::ForkManager;
9
use Parallel::ForkManager;
10
10
11
use Koha::Devel::Files;
12
11
my ( $perl_files, $js_files, $tt_files, $nproc, $no_write, $silent, $help );
13
my ( $perl_files, $js_files, $tt_files, $nproc, $no_write, $silent, $help );
12
14
13
our $perltidyrc = '.perltidyrc';
15
our $perltidyrc = '.perltidyrc';
Lines 34-46 pod2usage("--no-write can only be passed with a single file") if $no_write && @f Link Here
34
pod2usage("--perl, --js and --tt can only be passed without any other files in parameter")
36
pod2usage("--perl, --js and --tt can only be passed without any other files in parameter")
35
    if @files && ( $perl_files || $js_files || $tt_files );
37
    if @files && ( $perl_files || $js_files || $tt_files );
36
38
37
my $exceptions = {
39
my $dev_files = Koha::Devel::Files->new;
38
    pl => [qw(Koha/Schema/Result Koha/Schema.pm)],
39
    js => [
40
        qw(koha-tmpl/intranet-tmpl/lib koha-tmpl/intranet-tmpl/js/Gettext.js koha-tmpl/opac-tmpl/lib Koha/ILL/Backend/)
41
    ],
42
    tt => [qw(Koha/ILL/Backend/ *doc-head-open.inc misc/cronjobs/rss)],
43
};
44
40
45
my @original_files = @files;
41
my @original_files = @files;
46
if (@files) {
42
if (@files) {
Lines 48-55 if (@files) { Link Here
48
    # This is inefficient if the list of files is long but most of the time we will have only one
44
    # This is inefficient if the list of files is long but most of the time we will have only one
49
    @files = map {
45
    @files = map {
50
        my $file     = $_;
46
        my $file     = $_;
51
        my $filetype = get_filetype($file);
47
        my $filetype = $dev_files->get_filetype($file);
52
        my $cmd      = sprintf q{git ls-files %s | grep %s}, build_git_exclude($filetype), $file;
48
        my $cmd      = sprintf q{git ls-files %s | grep %s}, $dev_files->build_git_exclude($filetype), $file;
53
        my $output   = qx{$cmd};
49
        my $output   = qx{$cmd};
54
        chomp $output;
50
        chomp $output;
55
        $output ? $file : ();
51
        $output ? $file : ();
Lines 69-82 if (@files) { Link Here
69
        }
65
        }
70
    }
66
    }
71
} else {
67
} else {
72
    push @files, get_perl_files() if $perl_files;
68
    push @files, $dev_files->ls_perl_files() if $perl_files;
73
    push @files, get_js_files()   if $js_files;
69
    push @files, $dev_files->ls_js_files()   if $js_files;
74
    push @files, get_tt_files()   if $tt_files;
70
    push @files, $dev_files->ls_tt_files()   if $tt_files;
75
71
76
    unless (@files) {
72
    unless (@files) {
77
        push @files, get_perl_files();
73
        push @files, $dev_files->ls_perl_files();
78
        push @files, get_js_files();
74
        push @files, $dev_files->ls_js_files();
79
        push @files, get_tt_files();
75
        push @files, $dev_files->ls_tt_files();
80
    }
76
    }
81
}
77
}
82
78
Lines 124-130 if (@errors) { Link Here
124
sub tidy {
120
sub tidy {
125
    my ($file) = @_;
121
    my ($file) = @_;
126
122
127
    my $filetype = get_filetype($file);
123
    my $filetype = $dev_files->get_filetype($file);
128
124
129
    if ( $filetype eq 'pl' ) {
125
    if ( $filetype eq 'pl' ) {
130
        return tidy_perl($file);
126
        return tidy_perl($file);
Lines 137-168 sub tidy { Link Here
137
    }
133
    }
138
}
134
}
139
135
140
sub build_git_exclude {
141
    my ($filetype) = @_;
142
    return join( " ", map( "':(exclude)$_'", @{ $exceptions->{$filetype} } ) );
143
}
144
145
sub get_perl_files {
146
    my $cmd   = sprintf q{git ls-files '*.pl' '*.PL' '*.pm' '*.t' svc opac/svc %s}, build_git_exclude('pl');
147
    my @files = qx{$cmd};
148
    chomp for @files;
149
    return @files;
150
}
151
152
sub get_js_files {
153
    my $cmd   = sprintf q{git ls-files '*.js' '*.ts' '*.vue' %s}, build_git_exclude('js');
154
    my @files = qx{$cmd};
155
    chomp for @files;
156
    return @files;
157
}
158
159
sub get_tt_files {
160
    my $cmd   = sprintf q{git ls-files '*.tt' '*.inc' %s}, build_git_exclude('tt');
161
    my @files = qx{$cmd};
162
    chomp for @files;
163
    return @files;
164
}
165
166
sub tidy_perl {
136
sub tidy_perl {
167
    my ($file) = @_;
137
    my ($file) = @_;
168
    my $cmd =
138
    my $cmd =
Lines 221-239 sub tidy_tt { Link Here
221
    return ( $success, $error_message, $full_buf, $stdout_buf, $stderr_buf );
191
    return ( $success, $error_message, $full_buf, $stdout_buf, $stderr_buf );
222
}
192
}
223
193
224
sub get_filetype {
225
    my ($file) = @_;
226
    return 'pl' if $file =~ m{^svc}  || $file =~ m{^opac/svc};
227
    return 'pl' if $file =~ m{\.pl$} || $file =~ m{\.pm} || $file =~ m{\.t$};
228
    return 'pl' if $file =~ m{\.PL$};
229
230
    return 'js' if $file =~ m{\.js$} || $file =~ m{\.ts$} || $file =~ m{\.vue$};
231
232
    return 'tt' if $file =~ m{\.inc$} || $file =~ m{\.tt$};
233
234
    die sprintf 'Cannot guess filetype for %s', $file;
235
}
236
237
sub l {
194
sub l {
238
    say shift unless $silent;
195
    say shift unless $silent;
239
}
196
}
240
- 

Return to bug 39876