Bugzilla – Attachment 148763 Details for
Bug 33341
Perl 5.36 doesn't consider some of our code cool
Home
|
New
|
Browse
|
Search
|
[?]
|
Reports
|
Help
|
New Account
|
Log In
[x]
|
Forgot Password
Login:
[x]
[patch]
Bug 33341: Address some perlcritic errors in 5.36
Bug-33341-Address-some-perlcritic-errors-in-536.patch (text/plain), 17.57 KB, created by
Tomás Cohen Arazi (tcohen)
on 2023-03-27 12:27:34 UTC
(
hide
)
Description:
Bug 33341: Address some perlcritic errors in 5.36
Filename:
MIME Type:
Creator:
Tomás Cohen Arazi (tcohen)
Created:
2023-03-27 12:27:34 UTC
Size:
17.57 KB
patch
obsolete
>From c43491e3082c8be9eea73c71ab50bff3d24736fb Mon Sep 17 00:00:00 2001 >From: Tomas Cohen Arazi <tomascohen@theke.io> >Date: Mon, 27 Mar 2023 14:17:31 +0200 >Subject: [PATCH] Bug 33341: Address some perlcritic errors in 5.36 > >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> >--- > C4/Installer.pm | 34 +++++++++++--------- > C4/Koha.pm | 6 ++-- > C4/Languages.pm | 21 +++++++----- > C4/Ris.pm | 2 +- > Koha/AuthUtils.pm | 7 ++-- > admin/auth_subfields_structure.pl | 25 +++++++------- > admin/marc_subfields_structure.pl | 9 +++--- > installer/install.pl | 9 +++--- > misc/maintenance/generate_MARC21Languages.pl | 2 +- > misc/translator/tmpl_process3.pl | 7 ++-- > misc/translator/xgettext.pl | 2 +- > tools/access_files.pl | 7 ++-- > tools/picture-upload.pl | 14 ++++---- > 13 files changed, 82 insertions(+), 63 deletions(-) > >diff --git a/C4/Installer.pm b/C4/Installer.pm >index ffab0ed76ac..863047e3bf8 100644 >--- a/C4/Installer.pm >+++ b/C4/Installer.pm >@@ -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 >diff --git a/C4/Koha.pm b/C4/Koha.pm >index 89376b0b4a7..7132910adf0 100644 >--- a/C4/Koha.pm >+++ b/C4/Koha.pm >@@ -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; > } > >diff --git a/C4/Languages.pm b/C4/Languages.pm >index c05c31bf9ef..1d45bd2d71c 100644 >--- a/C4/Languages.pm >+++ b/C4/Languages.pm >@@ -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 >diff --git a/C4/Ris.pm b/C4/Ris.pm >index 6585ac4239a..0010f9a467e 100644 >--- a/C4/Ris.pm >+++ b/C4/Ris.pm >@@ -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; >diff --git a/Koha/AuthUtils.pm b/Koha/AuthUtils.pm >index 6a8c009bb1e..1dd8b0a7db1 100644 >--- a/Koha/AuthUtils.pm >+++ b/Koha/AuthUtils.pm >@@ -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; > } > >diff --git a/admin/auth_subfields_structure.pl b/admin/auth_subfields_structure.pl >index 21985617523..e052d023baf 100755 >--- a/admin/auth_subfields_structure.pl >+++ b/admin/auth_subfields_structure.pl >@@ -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; >diff --git a/admin/marc_subfields_structure.pl b/admin/marc_subfields_structure.pl >index 2d10c41e575..8fe34624fd4 100755 >--- a/admin/marc_subfields_structure.pl >+++ b/admin/marc_subfields_structure.pl >@@ -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( >diff --git a/installer/install.pl b/installer/install.pl >index 063832569c8..f8de23e332c 100755 >--- a/installer/install.pl >+++ b/installer/install.pl >@@ -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) { >diff --git a/misc/maintenance/generate_MARC21Languages.pl b/misc/maintenance/generate_MARC21Languages.pl >index 8a70a4f4488..37888a66eb4 100755 >--- a/misc/maintenance/generate_MARC21Languages.pl >+++ b/misc/maintenance/generate_MARC21Languages.pl >@@ -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); >diff --git a/misc/translator/tmpl_process3.pl b/misc/translator/tmpl_process3.pl >index 8d270829f67..ddb02e79570 100755 >--- a/misc/translator/tmpl_process3.pl >+++ b/misc/translator/tmpl_process3.pl >@@ -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' >diff --git a/misc/translator/xgettext.pl b/misc/translator/xgettext.pl >index 1d7a5d7c1b8..9eec03646a3 100755 >--- a/misc/translator/xgettext.pl >+++ b/misc/translator/xgettext.pl >@@ -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) { >diff --git a/tools/access_files.pl b/tools/access_files.pl >index 8a1c1adc58d..85420bd6025 100755 >--- a/tools/access_files.pl >+++ b/tools/access_files.pl >@@ -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; >diff --git a/tools/picture-upload.pl b/tools/picture-upload.pl >index 839976890ce..1f4c62b5de9 100755 >--- a/tools/picture-upload.pl >+++ b/tools/picture-upload.pl >@@ -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 ); >-- >2.40.0
<b>You cannot view the attachment while viewing its details because your browser does not support IFRAMEs. <a href="attachment.cgi?id=148763">View the attachment on a separate page</a>.</b>
View Attachment As Diff
View Attachment As Raw
Actions:
View
|
Diff
|
Splinter Review
Attachments on
bug 33341
:
148763
|
148818