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>
Signed-off-by: Martin Renvoize <martin.renvoize@ptfs-europe.com>
Signed-off-by: Tomas Cohen Arazi <tomascohen@theke.io>

diff --git a/C4/Installer.pm b/C4/Installer.pm
index ffab0ed..863047e 100644 (file)
--- 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 89376b0..7132910 100644 (file)
--- 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 c05c31b..1d45bd2 100644 (file)
--- 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 6585ac4..0010f9a 100644 (file)
--- 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 6a8c009..1dd8b0a 100644 (file)
--- 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 2198561..e052d02 100755 (executable)
--- 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 2d10c41..8fe3462 100755 (executable)
--- 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 0638325..f8de23e 100755 (executable)
--- 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 8a70a4f..37888a6 100755 (executable)
--- 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 8d27082..ddb02e7 100755 (executable)
--- 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 1d7a5d7..9eec036 100755 (executable)
--- 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 8a1c1ad..85420bd 100755 (executable)
--- 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 8399768..1f4c62b 100755 (executable)
--- 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 );