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

(-)a/Koha/Devel/Files.pm (+141 lines)
Line 0 Link Here
1
package Koha::Devel::Files;
2
3
our ( @ISA, @EXPORT_OK );
4
5
=head1 NAME
6
7
Koha::Devel::Files - A utility module for managing and filtering file lists in the Koha codebase
8
9
=head1 SYNOPSIS
10
11
    use Koha::Devel::Files;
12
13
    my $file_manager = Koha::Devel::Files->new({ context => 'tidy' });
14
15
    my @perl_files = $file_manager->ls_perl_files($git_range);
16
    my @js_files   = $file_manager->ls_js_files();
17
    my @tt_files   = $file_manager->ls_tt_files();
18
19
    my $filetype = $file_manager->get_filetype($filename);
20
21
=head1 DESCRIPTION
22
23
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.
24
25
=head1 EXCEPTIONS
26
27
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.
28
29
=cut
30
31
my $exceptions = {
32
    pl => [qw(Koha/Schema/Result Koha/Schema.pm)],
33
    js => [
34
        qw(koha-tmpl/intranet-tmpl/lib koha-tmpl/intranet-tmpl/js/Gettext.js koha-tmpl/opac-tmpl/lib Koha/ILL/Backend/)
35
    ],
36
    tt => [qw(Koha/ILL/Backend/ *doc-head-open.inc misc/cronjobs/rss)],
37
};
38
39
=head1 METHODS
40
41
=cut
42
43
=head2 new
44
45
    my $file_manager = Koha::Devel::Files->new({ context => 'tidy' });
46
47
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.
48
49
=cut
50
51
sub new {
52
    my ($class) = @_;
53
    my $self = {};
54
    bless $self, $class;
55
    return $self;
56
}
57
58
=head2 build_git_exclude
59
60
    my $exclude_pattern = $file_manager->build_git_exclude($filetype);
61
62
Builds a Git exclude pattern for a given file type based on the context provided during object creation.
63
64
=cut
65
66
sub build_git_exclude {
67
    my ( $self, $filetype ) = @_;
68
    return join( " ", map( "':(exclude)$_'", @{ $exceptions->{$filetype} } ) );
69
}
70
71
=head2 ls_perl_files
72
73
    my @perl_files = $file_manager->ls_perl_files($git_range);
74
75
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.
76
77
=cut
78
79
sub ls_perl_files {
80
    my ($self) = @_;
81
    my $cmd    = sprintf q{git ls-files '*.pl' '*.PL' '*.pm' '*.t' svc opac/svc %s}, $self->build_git_exclude('pl');
82
    my @files  = qx{$cmd};
83
    chomp for @files;
84
    return @files;
85
}
86
87
=head2 ls_js_files
88
89
    my @js_files = $file_manager->ls_js_files();
90
91
Lists JavaScript and TypeScript files (with extensions .js, .ts, .vue) in the repository, excluding those specified in the exceptions.
92
93
=cut
94
95
sub ls_js_files {
96
    my ($self) = @_;
97
    my $cmd    = sprintf q{git ls-files '*.js' '*.ts' '*.vue' %s}, $self->build_git_exclude('js');
98
    my @files  = qx{$cmd};
99
    chomp for @files;
100
    return @files;
101
}
102
103
=head2 ls_tt_files
104
105
    my @tt_files = $file_manager->ls_tt_files();
106
107
Lists Template Toolkit files (with extensions .tt, .inc) in the repository, excluding those specified in the exceptions.
108
109
=cut
110
111
sub ls_tt_files {
112
    my ($self) = @_;
113
    my $cmd    = sprintf q{git ls-files '*.tt' '*.inc' %s}, $self->build_git_exclude('tt');
114
    my @files  = qx{$cmd};
115
    chomp for @files;
116
    return @files;
117
}
118
119
=head2 get_filetype
120
121
    my $filetype = $file_manager->get_filetype($filename);
122
123
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.
124
125
=cut
126
127
sub get_filetype {
128
    my ( $self, $file ) = @_;
129
    return 'pl' if $file =~ m{^svc}  || $file =~ m{^opac/svc};
130
    return 'pl' if $file =~ m{\.pl$} || $file =~ m{\.pm} || $file =~ m{\.t$};
131
    return 'pl' if $file =~ m{\.PL$};
132
133
    return 'js' if $file =~ m{\.js$} || $file =~ m{\.ts$} || $file =~ m{\.vue$};
134
135
    return 'tt' if $file =~ m{\.inc$} || $file =~ m{\.tt$};
136
137
    die sprintf 'Cannot guess filetype for %s', $file;
138
}
139
140
1;
141
(-)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