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>
This commit is contained in:
Tomás Cohen Arazi 2023-03-27 14:17:31 +02:00
parent d8721bbc36
commit 10d12f999f
Signed by: tomascohen
GPG key ID: 0A272EA1B2F3C15F
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 $/;
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') {
warn "cannot open MARC frameworks directory $dir";
} else {
# if no translated MARC framework is available,
# default to English
$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;
}
}
my @listdir = sort grep { !/^\.|marcflavour/ && -d "$dir/$_" } readdir(MYDIR);
closedir MYDIR;
my @listdir = sort grep { !/^\.|marcflavour/ && -d "$dir/$_" } readdir($dir_h);
closedir $dir_h;
my @fwklist;
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) {
opendir( MYDIR, "$dir/$requirelevel" );
my @listname = grep { !/^\./ && -f "$dir/$requirelevel/$_" && $_ =~ m/\.(sql|yml)$/ } readdir(MYDIR);
closedir MYDIR;
my $dir_h;
opendir( $dir_h, "$dir/$requirelevel" );
my @listname = grep { !/^\./ && -f "$dir/$requirelevel/$_" && $_ =~ m/\.(sql|yml)$/ } readdir($dir_h);
closedir $dir_h;
my %cell;
my @frameworklist;
map {
@ -206,19 +208,20 @@ sub sample_data_sql_list {
undef $/;
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') {
warn "cannot open sample data directory $dir";
} else {
# if no sample data is available,
# default to English
$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;
}
}
my @listdir = sort grep { !/^\.|marcflavour/ && -d "$dir/$_" } readdir(MYDIR);
closedir MYDIR;
my @listdir = sort grep { !/^\.|marcflavour/ && -d "$dir/$_" } readdir($dir_h);
closedir $dir_h;
my @levellist;
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) {
opendir( MYDIR, "$dir/$requirelevel" );
my @listname = grep { !/^\./ && -f "$dir/$requirelevel/$_" && $_ =~ m/\.(sql|yml)$/ } readdir(MYDIR);
closedir MYDIR;
my $dir_h;
opendir( $dir_h, "$dir/$requirelevel" );
my @listname = grep { !/^\./ && -f "$dir/$requirelevel/$_" && $_ =~ m/\.(sql|yml)$/ } readdir($dir_h);
closedir $dir_h;
my %cell;
my @frameworklist;
map {
@ -847,7 +851,7 @@ sub run_atomic_updates {
my $code = read_file( $filepath );
my ( $out, $err ) = ('', '');
{
open my $oldout, ">&STDOUT";
open my $oldout, qw{>}, "&STDOUT";
close STDOUT;
open STDOUT,'>:encoding(utf8)', \$out;
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 {
$htdocs = C4::Context->config('opachtdocs');
}
opendir D, "$htdocs";
my @dirlist = readdir D;
my $dir_h;
opendir $dir_h, "$htdocs";
my @dirlist = readdir $dir_h;
foreach my $directory (@dirlist) {
next if $directory eq 'lib';
-d "$htdocs/$directory/en" and push @themes, $directory;
}
close $dir_h;
return @themes;
}

21
C4/Languages.pm
View file

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

2
C4/Ris.pm
View file

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

7
Koha/AuthUtils.pm
View file

@ -122,7 +122,8 @@ sub generate_salt {
$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";
# $bytes is the bytes just read
@ -132,7 +133,7 @@ sub generate_salt {
# keep reading until we have $length bytes in $strength
while( length($string) < $length ){
# 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)
next unless $return;
@ -143,7 +144,7 @@ sub generate_salt {
$string .= $bytes;
}
close SOURCE;
close $source_fh;
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
# on a standard install, /cgi-bin need to be added.
# test one, then the other
my $cgidir = C4::Context->config('intranetdir') ."/cgi-bin";
unless (opendir(DIR, "$cgidir/cataloguing/value_builder")) {
my $cgidir = C4::Context->config('intranetdir') . "/cgi-bin";
my $dir_h;
unless ( opendir( $dir_h, "$cgidir/cataloguing/value_builder" ) ) {
$cgidir = C4::Context->config('intranetdir');
opendir(DIR, "$cgidir/cataloguing/value_builder") || die "can't opendir $cgidir/value_builder: $!";
}
while (my $line = readdir(DIR)) {
if ( $line =~ /\.pl$/ &&
$line !~ /EXAMPLE\.pl$/ ) { # documentation purposes
push (@value_builder,$line);
}
}
@value_builder= sort {$a cmp $b} @value_builder;
closedir DIR;
opendir( $dir_h, "$cgidir/cataloguing/value_builder" ) || die "can't opendir $cgidir/value_builder: $!";
}
while ( my $line = readdir($dir_h) ) {
if ( $line =~ /\.pl$/
&& $line !~ /EXAMPLE\.pl$/ ) { # documentation purposes
push( @value_builder, $line );
}
}
@value_builder = sort { $a cmp $b } @value_builder;
closedir $dir_h;
my @loop_data;
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.
# test one, then the other
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');
opendir( DIR, "$cgidir/cataloguing/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$/ &&
$line !~ /EXAMPLE\.pl$/ ) { # documentation purposes
push( @value_builder, $line );
}
}
@value_builder= sort {$a cmp $b} @value_builder;
closedir DIR;
closedir $dir_h;
# build values list
my $mss = Koha::MarcSubfieldStructures->search(

9
installer/install.pl
View file

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

2
misc/maintenance/generate_MARC21Languages.pl
View file

@ -56,7 +56,7 @@ my $out_handle;
if (defined $outfile) {
open( $out_handle, ">", $outfile ) || croak("Cannot open output file");
} 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_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 $nomatch = join ('|', @nomatch); # do no use this files
my @it = ();
if (opendir(DIR, $dir)) {
my @dirent = readdir DIR; # because DIR is shared when recursing
closedir DIR;
my $dir_h;
if (opendir($dir_h, $dir)) {
my @dirent = readdir $dir_h; # because $dir_h is shared when recursing
closedir $dir_h;
for my $dirent (@dirent) {
my $path = "$dir/$dirent";
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";
} else {
print STDERR "$0: Outputting to STDOUT...\n" if $verbose_p;
open($OUTPUT, ">&STDOUT");
open($OUTPUT, q{>}, "&STDOUT");
}
if (defined $files_from) {

7
tools/access_files.pl
View file

@ -61,8 +61,9 @@ else {
#Get the files list
my @files_list;
foreach my $dir(@directories){
opendir(DIR, $dir);
foreach my $filename (readdir(DIR)) {
my $dir_h;
opendir($dir_h, $dir);
foreach my $filename (readdir($dir_h)) {
my $full_path = "$dir/$filename";
my $id = md5_hex($full_path);
next if ($filename =~ /^\./ or -d $full_path);
@ -84,7 +85,7 @@ else {
size => $st->size,
id => $id});
}
closedir(DIR);
closedir($dir_h);
}
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";
foreach my $recursive_dir (@directories) {
opendir RECDIR, $recursive_dir;
while ( my $entry = readdir RECDIR ) {
my $recdir_h;
opendir $recdir_h, $recursive_dir;
while ( my $entry = readdir $recdir_h ) {
push @directories, "$recursive_dir/$entry"
if ( -d "$recursive_dir/$entry" and $entry !~ /^\./ );
}
closedir RECDIR;
closedir $recdir_h;
}
foreach my $dir (@directories) {
$results = handle_dir( $dir, $filesuffix, $template );
@ -225,8 +226,9 @@ sub handle_dir {
my ( $file, $filename );
undef $cardnumber;
$logger->debug("Passed a zip file.");
opendir DIR, $dir;
while ( my $filename = readdir DIR ) {
my $dir_h;
opendir $dir_h, $dir;
while ( my $filename = readdir $dir_h ) {
$file = "$dir/$filename"
if ( $filename =~ m/datalink\.txt/i
|| $filename =~ m/idlink\.txt/i );
@ -262,7 +264,7 @@ sub handle_dir {
$source = "$dir/$filename";
%counts = handle_file( $cardnumber, $source, $template, %counts );
}
closedir DIR;
closedir $dir_h;
}
else {
%counts = handle_file( $cardnumber, $source, $template, %counts );