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