Koha-community/Koha
13
7
Fork 0
Code Issues Releases Wiki Activity

Bug 33341: Address some perlcritic errors in 5.36

Browse source 
Some old-style code is making our tests fail when run in Debian Testing.

This patch addresses this.

To test:
1. Launch bookworm KTD:
   $ KOHA_IMAGE=master-bookworm ktd up -d
2. Run:
   $ ktd --shell
  k$ prove t/00-testcritic.t
=> FAIL: It fails!
3. Apply the patch
4. Repeat 2
=> SUCCESS: Tests now pass!
5. Sign off :-D

Signed-off-by: Tomas Cohen Arazi <tomascohen@theke.io>
Signed-off-by: Martin Renvoize <martin.renvoize@ptfs-europe.com>
Signed-off-by: Tomas Cohen Arazi <tomascohen@theke.io>
(cherry picked from commit 10d12f999f)
Signed-off-by: Matt Blenkinsop <matt.blenkinsop@ptfs-europe.com>
This commit is contained in:
Tomás Cohen Arazi 2023-03-27 14:17:31 +02:00 committed by Matt Blenkinsop
parent c9490945fc
commit c1c5420afa
13 changed files with 82 additions and 63 deletions
Show stats Download patch file Download diff file Expand all files Collapse all files

34
C4/Installer.pm
View file

@ -123,19 +123,20 @@ sub marc_framework_sql_list {
undef $/; undef $/;
my $dir = C4::Context->config('intranetdir') . "/installer/data/$self->{dbms}/$lang/marcflavour/".lc($marcflavour); my $dir = C4::Context->config('intranetdir') . "/installer/data/$self->{dbms}/$lang/marcflavour/".lc($marcflavour);
unless (opendir( MYDIR, $dir )) { my $dir_h;
unless (opendir( $dir_h, $dir )) {
if ($lang eq 'en') { if ($lang eq 'en') {
warn "cannot open MARC frameworks directory $dir"; warn "cannot open MARC frameworks directory $dir";
} else { } else {
# if no translated MARC framework is available, # if no translated MARC framework is available,
# default to English # default to English
$dir = C4::Context->config('intranetdir') . "/installer/data/$self->{dbms}/en/marcflavour/".lc($marcflavour); $dir = C4::Context->config('intranetdir') . "/installer/data/$self->{dbms}/en/marcflavour/".lc($marcflavour);
opendir(MYDIR, $dir) or warn "cannot open English MARC frameworks directory $dir"; opendir($dir_h, $dir) or warn "cannot open English MARC frameworks directory $dir";
$defaulted_to_en = 1; $defaulted_to_en = 1;
} }
} }
my @listdir = sort grep { !/^\.|marcflavour/ && -d "$dir/$_" } readdir(MYDIR); my @listdir = sort grep { !/^\.|marcflavour/ && -d "$dir/$_" } readdir($dir_h);
closedir MYDIR; closedir $dir_h;
my @fwklist; my @fwklist;
my $request = $self->{'dbh'}->prepare("SELECT value FROM systempreferences WHERE variable='FrameworksLoaded'"); my $request = $self->{'dbh'}->prepare("SELECT value FROM systempreferences WHERE variable='FrameworksLoaded'");
@ -148,9 +149,10 @@ sub marc_framework_sql_list {
} }
foreach my $requirelevel (@listdir) { foreach my $requirelevel (@listdir) {
opendir( MYDIR, "$dir/$requirelevel" ); my $dir_h;
my @listname = grep { !/^\./ && -f "$dir/$requirelevel/$_" && $_ =~ m/\.(sql|yml)$/ } readdir(MYDIR); opendir( $dir_h, "$dir/$requirelevel" );
closedir MYDIR; my @listname = grep { !/^\./ && -f "$dir/$requirelevel/$_" && $_ =~ m/\.(sql|yml)$/ } readdir($dir_h);
closedir $dir_h;
my %cell; my %cell;
my @frameworklist; my @frameworklist;
map { map {
@ -206,19 +208,20 @@ sub sample_data_sql_list {
undef $/; undef $/;
my $dir = C4::Context->config('intranetdir') . "/installer/data/$self->{dbms}/$lang"; my $dir = C4::Context->config('intranetdir') . "/installer/data/$self->{dbms}/$lang";
unless (opendir( MYDIR, $dir )) { my $dir_h;
unless (opendir( $dir_h, $dir )) {
if ($lang eq 'en') { if ($lang eq 'en') {
warn "cannot open sample data directory $dir"; warn "cannot open sample data directory $dir";
} else { } else {
# if no sample data is available, # if no sample data is available,
# default to English # default to English
$dir = C4::Context->config('intranetdir') . "/installer/data/$self->{dbms}/en"; $dir = C4::Context->config('intranetdir') . "/installer/data/$self->{dbms}/en";
opendir(MYDIR, $dir) or warn "cannot open English sample data directory $dir"; opendir($dir_h, $dir) or warn "cannot open English sample data directory $dir";
$defaulted_to_en = 1; $defaulted_to_en = 1;
} }
} }
my @listdir = sort grep { !/^\.|marcflavour/ && -d "$dir/$_" } readdir(MYDIR); my @listdir = sort grep { !/^\.|marcflavour/ && -d "$dir/$_" } readdir($dir_h);
closedir MYDIR; closedir $dir_h;
my @levellist; my @levellist;
my $request = $self->{'dbh'}->prepare("SELECT value FROM systempreferences WHERE variable='FrameworksLoaded'"); my $request = $self->{'dbh'}->prepare("SELECT value FROM systempreferences WHERE variable='FrameworksLoaded'");
@ -231,9 +234,10 @@ sub sample_data_sql_list {
} }
foreach my $requirelevel (@listdir) { foreach my $requirelevel (@listdir) {
opendir( MYDIR, "$dir/$requirelevel" ); my $dir_h;
my @listname = grep { !/^\./ && -f "$dir/$requirelevel/$_" && $_ =~ m/\.(sql|yml)$/ } readdir(MYDIR); opendir( $dir_h, "$dir/$requirelevel" );
closedir MYDIR; my @listname = grep { !/^\./ && -f "$dir/$requirelevel/$_" && $_ =~ m/\.(sql|yml)$/ } readdir($dir_h);
closedir $dir_h;
my %cell; my %cell;
my @frameworklist; my @frameworklist;
map { map {
@ -847,7 +851,7 @@ sub run_atomic_updates {
my $code = read_file( $filepath ); my $code = read_file( $filepath );
my ( $out, $err ) = ('', ''); my ( $out, $err ) = ('', '');
{ {
open my $oldout, ">&STDOUT"; open my $oldout, qw{>}, "&STDOUT";
close STDOUT; close STDOUT;
open STDOUT,'>:encoding(utf8)', \$out; open STDOUT,'>:encoding(utf8)', \$out;
my $DBversion = Koha::version; # We need $DBversion and $dbh for the eval my $DBversion = Koha::version; # We need $DBversion and $dbh for the eval

6
C4/Koha.pm
View file

@ -301,12 +301,14 @@ sub getallthemes {
else { else {
$htdocs = C4::Context->config('opachtdocs'); $htdocs = C4::Context->config('opachtdocs');
} }
opendir D, "$htdocs"; my $dir_h;
my @dirlist = readdir D; opendir $dir_h, "$htdocs";
my @dirlist = readdir $dir_h;
foreach my $directory (@dirlist) { foreach my $directory (@dirlist) {
next if $directory eq 'lib'; next if $directory eq 'lib';
-d "$htdocs/$directory/en" and push @themes, $directory; -d "$htdocs/$directory/en" and push @themes, $directory;
} }
close $dir_h;
return @themes; return @themes;
} }

21
C4/Languages.pm
View file

@ -76,9 +76,10 @@ sub getFrameworkLanguages {
# find the available directory names # find the available directory names
my $dir=C4::Context->config('intranetdir')."/installer/data/"; my $dir=C4::Context->config('intranetdir')."/installer/data/";
opendir (MYDIR,$dir); my $dir_h;
my @listdir= grep { !/^\.|CVS/ && -d "$dir/$_"} readdir(MYDIR); opendir ($dir_h,$dir);
closedir MYDIR; my @listdir= grep { !/^\.|CVS/ && -d "$dir/$_"} readdir($dir_h);
closedir $dir_h;
# pull out all data for the dir names that exist # pull out all data for the dir names that exist
for my $dirname (@listdir) { for my $dirname (@listdir) {
@ -293,12 +294,14 @@ sub _get_themes {
else { else {
$htdocs = C4::Context->config('opachtdocs'); $htdocs = C4::Context->config('opachtdocs');
} }
opendir D, "$htdocs"; my $dir_h;
my @dirlist = readdir D; opendir $dir_h, "$htdocs";
my @dirlist = readdir $dir_h;
foreach my $directory (@dirlist) { foreach my $directory (@dirlist) {
# if there's an en dir, it's a valid theme # if there's an en dir, it's a valid theme
-d "$htdocs/$directory/en" and push @themes, $directory; -d "$htdocs/$directory/en" and push @themes, $directory;
} }
close $dir_h;
return @themes; return @themes;
} }
@ -313,8 +316,9 @@ sub _get_language_dirs {
$htdocs //= ''; $htdocs //= '';
$theme //= ''; $theme //= '';
my @lang_strings; my @lang_strings;
opendir D, "$htdocs/$theme"; my $dir_h;
for my $lang_string ( readdir D ) { opendir $dir_h, "$htdocs/$theme";
for my $lang_string ( readdir $dir_h ) {
next if $lang_string =~/^\./; next if $lang_string =~/^\./;
next if $lang_string eq 'all'; next if $lang_string eq 'all';
next if $lang_string =~/png$/; next if $lang_string =~/png$/;
@ -325,7 +329,8 @@ sub _get_language_dirs {
next if $lang_string =~/img|images|famfam|js|less|lib|sound|pdf/; next if $lang_string =~/img|images|famfam|js|less|lib|sound|pdf/;
push @lang_strings, $lang_string; push @lang_strings, $lang_string;
} }
return (@lang_strings); close $dir_h;
return (@lang_strings);
} }
=head2 _build_languages_arrayref =head2 _build_languages_arrayref

2
C4/Ris.pm
View file

@ -97,7 +97,7 @@ sub marc2ris {
my $intype = lc($marcflavour); my $intype = lc($marcflavour);
# Let's redirect stdout # Let's redirect stdout
open my $oldout, ">&STDOUT"; open my $oldout, qw{>}, "&STDOUT";
my $outvar; my $outvar;
close STDOUT; close STDOUT;
open STDOUT,'>:encoding(utf8)', \$outvar; open STDOUT,'>:encoding(utf8)', \$outvar;

7
Koha/AuthUtils.pm
View file

@ -122,7 +122,8 @@ sub generate_salt {
$source = '/dev/urandom'; # non-blocking $source = '/dev/urandom'; # non-blocking
} }
sysopen SOURCE, $source, O_RDONLY my $source_fh;
sysopen $source_fh, $source, O_RDONLY
or die "failed to open source '$source' in Koha::AuthUtils::generate_salt\n"; or die "failed to open source '$source' in Koha::AuthUtils::generate_salt\n";
# $bytes is the bytes just read # $bytes is the bytes just read
@ -132,7 +133,7 @@ sub generate_salt {
# keep reading until we have $length bytes in $strength # keep reading until we have $length bytes in $strength
while( length($string) < $length ){ while( length($string) < $length ){
# return the number of bytes read, 0 (EOF), or -1 (ERROR) # return the number of bytes read, 0 (EOF), or -1 (ERROR)
my $return = sysread SOURCE, $bytes, $length - length($string); my $return = sysread $source_fh, $bytes, $length - length($string);
# if no bytes were read, keep reading (if using /dev/random it is possible there was insufficient entropy so this may block) # if no bytes were read, keep reading (if using /dev/random it is possible there was insufficient entropy so this may block)
next unless $return; next unless $return;
@ -143,7 +144,7 @@ sub generate_salt {
$string .= $bytes; $string .= $bytes;
} }
close SOURCE; close $source_fh;
return $string; return $string;
} }

25
admin/auth_subfields_structure.pl
View file

@ -87,19 +87,20 @@ if ($op eq 'add_form') {
# 2 cases here : on CVS install, $cgidir does not need a /cgi-bin # 2 cases here : on CVS install, $cgidir does not need a /cgi-bin
# on a standard install, /cgi-bin need to be added. # on a standard install, /cgi-bin need to be added.
# test one, then the other # test one, then the other
my $cgidir = C4::Context->config('intranetdir') ."/cgi-bin"; my $cgidir = C4::Context->config('intranetdir') . "/cgi-bin";
unless (opendir(DIR, "$cgidir/cataloguing/value_builder")) { my $dir_h;
unless ( opendir( $dir_h, "$cgidir/cataloguing/value_builder" ) ) {
$cgidir = C4::Context->config('intranetdir'); $cgidir = C4::Context->config('intranetdir');
opendir(DIR, "$cgidir/cataloguing/value_builder") || die "can't opendir $cgidir/value_builder: $!"; opendir( $dir_h, "$cgidir/cataloguing/value_builder" ) || die "can't opendir $cgidir/value_builder: $!";
} }
while (my $line = readdir(DIR)) { while ( my $line = readdir($dir_h) ) {
if ( $line =~ /\.pl$/ && if ( $line =~ /\.pl$/
$line !~ /EXAMPLE\.pl$/ ) { # documentation purposes && $line !~ /EXAMPLE\.pl$/ ) { # documentation purposes
push (@value_builder,$line); push( @value_builder, $line );
} }
} }
@value_builder= sort {$a cmp $b} @value_builder; @value_builder = sort { $a cmp $b } @value_builder;
closedir DIR; closedir $dir_h;
my @loop_data; my @loop_data;
my $asses = Koha::Authority::Subfields->search({ tagfield => $tagfield, authtypecode => $authtypecode}, {order_by => 'display_order'})->unblessed; my $asses = Koha::Authority::Subfields->search({ tagfield => $tagfield, authtypecode => $authtypecode}, {order_by => 'display_order'})->unblessed;

9
admin/marc_subfields_structure.pl
View file

@ -111,19 +111,20 @@ if ( $op eq 'add_form' ) {
# on a standard install, /cgi-bin need to be added. # on a standard install, /cgi-bin need to be added.
# test one, then the other # test one, then the other
my $cgidir = C4::Context->config('intranetdir') . "/cgi-bin"; my $cgidir = C4::Context->config('intranetdir') . "/cgi-bin";
unless ( opendir( DIR, "$cgidir/cataloguing/value_builder" ) ) { my $dir_h;
unless ( opendir( $dir_h, "$cgidir/cataloguing/value_builder" ) ) {
$cgidir = C4::Context->config('intranetdir'); $cgidir = C4::Context->config('intranetdir');
opendir( DIR, "$cgidir/cataloguing/value_builder" ) opendir( $dir_h, "$cgidir/cataloguing/value_builder" )
|| die "can't opendir $cgidir/value_builder: $!"; || die "can't opendir $cgidir/value_builder: $!";
} }
while ( my $line = readdir(DIR) ) { while ( my $line = readdir($dir_h) ) {
if ( $line =~ /\.pl$/ && if ( $line =~ /\.pl$/ &&
$line !~ /EXAMPLE\.pl$/ ) { # documentation purposes $line !~ /EXAMPLE\.pl$/ ) { # documentation purposes
push( @value_builder, $line ); push( @value_builder, $line );
} }
} }
@value_builder= sort {$a cmp $b} @value_builder; @value_builder= sort {$a cmp $b} @value_builder;
closedir DIR; closedir $dir_h;
# build values list # build values list
my $mss = Koha::MarcSubfieldStructures->search( my $mss = Koha::MarcSubfieldStructures->search(

9
installer/install.pl
View file

@ -327,7 +327,8 @@ elsif ( $step && $step == 3 ) {
my $dir = my $dir =
C4::Context->config('intranetdir') C4::Context->config('intranetdir')
. "/installer/data/$info{dbms}/$langchoice/marcflavour"; . "/installer/data/$info{dbms}/$langchoice/marcflavour";
unless ( opendir( MYDIR, $dir ) ) { my $dir_h;
unless ( opendir( $dir_h, $dir ) ) {
if ( $langchoice eq 'en' ) { if ( $langchoice eq 'en' ) {
warn "cannot open MARC frameworks directory $dir"; warn "cannot open MARC frameworks directory $dir";
} }
@ -336,12 +337,12 @@ elsif ( $step && $step == 3 ) {
# default to English # default to English
$dir = C4::Context->config('intranetdir') $dir = C4::Context->config('intranetdir')
. "/installer/data/$info{dbms}/en/marcflavour"; . "/installer/data/$info{dbms}/en/marcflavour";
opendir( MYDIR, $dir ) opendir( $dir_h, $dir )
or warn "cannot open English MARC frameworks directory $dir"; or warn "cannot open English MARC frameworks directory $dir";
} }
} }
my @listdir = grep { !/^\./ && -d "$dir/$_" } readdir(MYDIR); my @listdir = grep { !/^\./ && -d "$dir/$_" } readdir($dir_h);
closedir MYDIR; closedir $dir_h;
my $marcflavour = C4::Context->preference("marcflavour"); my $marcflavour = C4::Context->preference("marcflavour");
my @flavourlist; my @flavourlist;
foreach my $marc (@listdir) { foreach my $marc (@listdir) {

2
misc/maintenance/generate_MARC21Languages.pl
View file

@ -56,7 +56,7 @@ my $out_handle;
if (defined $outfile) { if (defined $outfile) {
open( $out_handle, ">", $outfile ) || croak("Cannot open output file"); open( $out_handle, ">", $outfile ) || croak("Cannot open output file");
} else { } else {
open( $out_handle, ">&STDOUT" ) || croak("Couldn't duplicate STDOUT: $!"); open( $out_handle, q{>}, "&STDOUT" ) || croak("Couldn't duplicate STDOUT: $!");
} }
generate_header($out_handle); generate_header($out_handle);
generate_body($out_handle, $languages); generate_body($out_handle, $languages);

7
misc/translator/tmpl_process3.pl
View file

@ -157,9 +157,10 @@ sub listfiles {
my $match = join ('|', @match); # use only this files my $match = join ('|', @match); # use only this files
my $nomatch = join ('|', @nomatch); # do no use this files my $nomatch = join ('|', @nomatch); # do no use this files
my @it = (); my @it = ();
if (opendir(DIR, $dir)) { my $dir_h;
my @dirent = readdir DIR; # because DIR is shared when recursing if (opendir($dir_h, $dir)) {
closedir DIR; my @dirent = readdir $dir_h; # because $dir_h is shared when recursing
closedir $dir_h;
for my $dirent (@dirent) { for my $dirent (@dirent) {
my $path = "$dir/$dirent"; my $path = "$dir/$dirent";
if ($dirent =~ /^\./ || $dirent eq 'CVS' || $dirent eq 'RCS' if ($dirent =~ /^\./ || $dirent eq 'CVS' || $dirent eq 'RCS'

2
misc/translator/xgettext.pl
View file

@ -387,7 +387,7 @@ if (defined $output && $output ne '-') {
open($OUTPUT, '>:encoding(utf-8)', $output) || die "$output: $!\n"; open($OUTPUT, '>:encoding(utf-8)', $output) || die "$output: $!\n";
} else { } else {
print STDERR "$0: Outputting to STDOUT...\n" if $verbose_p; print STDERR "$0: Outputting to STDOUT...\n" if $verbose_p;
open($OUTPUT, ">&STDOUT"); open($OUTPUT, q{>}, "&STDOUT");
} }
if (defined $files_from) { if (defined $files_from) {

7
tools/access_files.pl
View file

@ -61,8 +61,9 @@ else {
#Get the files list #Get the files list
my @files_list; my @files_list;
foreach my $dir(@directories){ foreach my $dir(@directories){
opendir(DIR, $dir); my $dir_h;
foreach my $filename (readdir(DIR)) { opendir($dir_h, $dir);
foreach my $filename (readdir($dir_h)) {
my $full_path = "$dir/$filename"; my $full_path = "$dir/$filename";
my $id = md5_hex($full_path); my $id = md5_hex($full_path);
next if ($filename =~ /^\./ or -d $full_path); next if ($filename =~ /^\./ or -d $full_path);
@ -84,7 +85,7 @@ else {
size => $st->size, size => $st->size,
id => $id}); id => $id});
} }
closedir(DIR); closedir($dir_h);
} }
my %files_hash = map { $_->{id} => $_ } @files_list; my %files_hash = map { $_->{id} => $_ } @files_list;

14
tools/picture-upload.pl
View file

@ -145,12 +145,13 @@ if ( ( $op eq 'Upload' ) && ($uploadfile || $uploadfiletext) ) {
} }
push @directories, "$dirname"; push @directories, "$dirname";
foreach my $recursive_dir (@directories) { foreach my $recursive_dir (@directories) {
opendir RECDIR, $recursive_dir; my $recdir_h;
while ( my $entry = readdir RECDIR ) { opendir $recdir_h, $recursive_dir;
while ( my $entry = readdir $recdir_h ) {
push @directories, "$recursive_dir/$entry" push @directories, "$recursive_dir/$entry"
if ( -d "$recursive_dir/$entry" and $entry !~ /^\./ ); if ( -d "$recursive_dir/$entry" and $entry !~ /^\./ );
} }
closedir RECDIR; closedir $recdir_h;
} }
foreach my $dir (@directories) { foreach my $dir (@directories) {
$results = handle_dir( $dir, $filesuffix, $template ); $results = handle_dir( $dir, $filesuffix, $template );
@ -225,8 +226,9 @@ sub handle_dir {
my ( $file, $filename ); my ( $file, $filename );
undef $cardnumber; undef $cardnumber;
$logger->debug("Passed a zip file."); $logger->debug("Passed a zip file.");
opendir DIR, $dir; my $dir_h;
while ( my $filename = readdir DIR ) { opendir $dir_h, $dir;
while ( my $filename = readdir $dir_h ) {
$file = "$dir/$filename" $file = "$dir/$filename"
if ( $filename =~ m/datalink\.txt/i if ( $filename =~ m/datalink\.txt/i
|| $filename =~ m/idlink\.txt/i ); || $filename =~ m/idlink\.txt/i );
@ -262,7 +264,7 @@ sub handle_dir {
$source = "$dir/$filename"; $source = "$dir/$filename";
%counts = handle_file( $cardnumber, $source, $template, %counts ); %counts = handle_file( $cardnumber, $source, $template, %counts );
} }
closedir DIR; closedir $dir_h;
} }
else { else {
%counts = handle_file( $cardnumber, $source, $template, %counts ); %counts = handle_file( $cardnumber, $source, $template, %counts );