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 |
- |
|
|