From d9c4b390d7a4b2ff840e40fa67696dab35310af1 Mon Sep 17 00:00:00 2001 From: Julian Maurice Date: Fri, 21 Sep 2018 18:05:42 +0200 Subject: [PATCH] Bug 21395: Make perlcritic happy This patch adds a .perlcriticrc (copied from qa-test-tools) and fixes almost all perlcrictic violations according to this .perlcriticrc The remaining violations are silenced out by appending a '## no critic' to the offending lines. They can still be seen by using the --force option of perlcritic This patch also modify t/00-testcritic.t to check all Perl files using the new .perlcriticrc. I'm not sure if this test script is still useful as it is now equivalent to `perlcritic --quiet .` and it looks like it is much slower (approximatively 5 times slower on my machine) Test plan: 1. Run `perlcritic --quiet .` from the root directory. It should output nothing 2. Run `perlcritic --quiet --force .`. It should output 7 errors (6 StringyEval, 1 BarewordFileHandles) 3. Run `TEST_QA=1 prove t/00-testcritic.t` 4. Read the patch. Check that all changes make sense and do not introduce undesired behaviour --- t/perlcriticrc => .perlcriticrc | 2 + C4/Accounts.pm | 1 - C4/Acquisition.pm | 1 - C4/Auth_with_cas.pm | 18 ++--- C4/AuthoritiesMarc.pm | 1 - C4/Barcodes/ValueBuilder.pm | 2 + C4/Barcodes/annual.pm | 8 +- C4/Biblio.pm | 1 - C4/ClassSortRoutine.pm | 4 +- C4/ClassSplitRoutine/RegEx.pm | 2 +- C4/Context.pm | 2 - C4/CourseReserves.pm | 2 +- C4/Creators.pm | 2 + C4/Creators/Lib.pm | 2 +- C4/ImportBatch.pm | 12 +-- C4/InstallAuth.pm | 1 - C4/Items.pm | 1 - C4/Labels.pm | 2 + C4/Labels/Label.pm | 5 +- C4/Languages.pm | 4 +- C4/Letters.pm | 1 - C4/Matcher.pm | 2 +- C4/Members/Messaging.pm | 1 - C4/Patroncards.pm | 2 + C4/Patroncards/Patroncard.pm | 8 +- C4/Record.pm | 8 +- C4/Ris.pm | 1 - C4/Search.pm | 5 -- C4/Serials.pm | 21 ++--- C4/Templates.pm | 2 +- Makefile.PL | 6 +- docs/CAS/CASProxy/examples/koha_webservice.pl | 2 +- .../CASProxy/examples/proxy_cas_callback.pl | 6 +- docs/CAS/CASProxy/examples/proxy_cas_data.pl | 6 +- fix-perl-path.PL | 4 +- installer/data/mysql/labels_upgrade.pl | 2 + installer/data/mysql/patroncards_upgrade.pl | 2 + installer/data/mysql/update22to30.pl | 16 ++-- installer/data/mysql/updatedatabase.pl | 10 +-- installer/externalmodules.pl | 6 +- installer/install.pl | 2 +- misc/admin/koha-preferences | 1 + misc/batchRepairMissingBiblionumbers.pl | 1 - misc/batchdeletebiblios.pl | 2 +- misc/bin/connexion_import_daemon.pl | 1 + misc/check_sysprefs.pl | 6 +- misc/cronjobs/build_browser_and_cloud.pl | 2 +- misc/cronjobs/gather_print_notices.pl | 3 +- misc/cronjobs/holds/cancel_expired_holds.pl | 3 +- misc/cronjobs/longoverdue.pl | 6 +- misc/cronjobs/rss/rss.pl | 6 +- .../thirdparty/TalkingTech_itiva_inbound.pl | 1 + misc/cronjobs/update_totalissues.pl | 2 +- misc/exportauth.pl | 6 +- misc/link_bibs_to_authorities.pl | 2 +- misc/maintenance/cmp_sysprefs.pl | 2 +- .../fix_accountlines_rmdupfines_bug8253.pl | 1 - misc/maintenance/touch_all_biblios.pl | 10 ++- misc/maintenance/touch_all_items.pl | 10 ++- .../22_to_30/export_Authorities.pl | 5 +- .../22_to_30/export_Authorities_xml.pl | 5 +- .../22_to_30/move_marc_to_biblioitems.pl | 3 +- misc/migration_tools/buildCOUNTRY.pl | 2 +- misc/migration_tools/buildEDITORS.pl | 1 - misc/migration_tools/buildLANG.pl | 2 +- misc/migration_tools/bulkmarcimport.pl | 7 +- .../remove_unused_authorities.pl | 1 - misc/perlmodule_rm.pl | 2 +- misc/translator/LangInstaller.pm | 2 +- misc/translator/TmplTokenizer.pm | 56 ++++++------- misc/translator/VerboseWarnings.pm | 24 +++--- misc/translator/po2json | 14 ++-- misc/translator/tmpl_process3.pl | 81 +++++++++---------- misc/translator/xgettext.pl | 28 ++++--- opac/opac-MARCdetail.pl | 1 - opac/opac-alert-subscribe.pl | 1 - opac/opac-authorities-home.pl | 1 - opac/opac-authoritiesdetail.pl | 1 - opac/opac-basket.pl | 1 - opac/opac-search.pl | 5 -- opac/opac-serial-issues.pl | 2 - opac/opac-showreviews.pl | 1 - patroncards/create-pdf.pl | 10 +-- patroncards/image-manage.pl | 2 +- patroncards/print.pl | 12 +-- plugins/plugins-upload.pl | 2 +- reports/acquisitions_stats.pl | 1 - reports/bor_issues_top.pl | 26 +++--- reports/borrowers_out.pl | 7 +- reports/catalogue_out.pl | 2 - reports/catalogue_stats.pl | 5 -- reports/issues_avg_stats.pl | 5 -- reports/issues_stats.pl | 5 +- reports/reserves_stats.pl | 4 - rewrite-config.PL | 22 ++--- svc/holds | 1 - t/00-testcritic.t | 32 +------- t/Languages.t | 2 +- t/Prices.t | 4 +- t/SuggestionEngine.t | 2 +- t/db_dependent/Accounts.t | 1 - .../Acquisition/OrderFromSubscription.t | 3 +- t/db_dependent/Acquisition/OrderUsers.t | 1 - t/db_dependent/Barcodes.t | 4 +- t/db_dependent/Context.t | 2 - t/db_dependent/Hold.t | 2 +- t/db_dependent/LDAP/test_ldap_add.pl | 2 +- t/db_dependent/Record/Record.t | 32 ++++---- t/db_dependent/Search.t | 6 ++ t/db_dependent/Serials.t | 1 - t/db_dependent/Serials_2.t | 1 - t/db_dependent/XISBN.t | 1 - .../cronjobs/advance_notices_digest.t | 6 +- t/db_dependent/www/auth_values_input_www.t | 1 - t/dummy.t | 1 + tags/review.pl | 6 +- tools/batchMod.pl | 3 +- tools/export.pl | 2 - tools/import_borrowers.pl | 3 - tools/letter.pl | 2 +- tools/modborrowers.pl | 3 +- tools/overduerules.pl | 2 - tools/picture-upload.pl | 14 ++-- tools/upload-cover-image.pl | 6 +- xt/author/show-template-structure.pl | 6 +- xt/author/translatable-templates.t | 2 +- xt/find-license-problems.t | 5 +- xt/fix-old-fsf-address | 8 +- xt/single_quotes.t | 2 +- 129 files changed, 342 insertions(+), 427 deletions(-) rename t/perlcriticrc => .perlcriticrc (89%) diff --git a/t/perlcriticrc b/.perlcriticrc similarity index 89% rename from t/perlcriticrc rename to .perlcriticrc index bf0c9e4750..9a4dcf4f02 100644 --- a/t/perlcriticrc +++ b/.perlcriticrc @@ -10,3 +10,5 @@ equivalent_modules = Modern::Perl [TestingAndDebugging::RequireUseWarnings] equivalent_modules = Modern::Perl + +[-Modules::RequireBarewordIncludes] diff --git a/C4/Accounts.pm b/C4/Accounts.pm index 92365eabf5..bf8076d804 100644 --- a/C4/Accounts.pm +++ b/C4/Accounts.pm @@ -148,7 +148,6 @@ sub manualinvoice { my $manager_id = C4::Context->userenv ? C4::Context->userenv->{'number'} : undef; my $dbh = C4::Context->dbh; - my $insert; my $amountleft = $amount; my $branchcode = C4::Context->userenv ? C4::Context->userenv->{'branch'} : undef; diff --git a/C4/Acquisition.pm b/C4/Acquisition.pm index da0a9b4d78..20977d01f0 100644 --- a/C4/Acquisition.pm +++ b/C4/Acquisition.pm @@ -2275,7 +2275,6 @@ sub GetHistory { my $ordernumbers = $params{ordernumbers} || []; my $additional_fields = $params{additional_fields} // []; - my @order_loop; my $total_qty = 0; my $total_qtyreceived = 0; my $total_price = 0; diff --git a/C4/Auth_with_cas.pm b/C4/Auth_with_cas.pm index 8cc8cde8ac..ecfe7ccf69 100644 --- a/C4/Auth_with_cas.pm +++ b/C4/Auth_with_cas.pm @@ -257,19 +257,19 @@ sub logout_if_required { my $params = C4::Auth::_get_session_params(); my $success = CGI::Session->find( $params->{dsn}, sub {delete_cas_session(@_, $ticket)}, $params->{dsn_args} ); - sub delete_cas_session { - my $session = shift; - my $ticket = shift; - if ($session->param('cas_ticket') && $session->param('cas_ticket') eq $ticket ) { - $session->delete; - $session->flush; - } - } - print $query->header; exit; } +sub delete_cas_session { + my $session = shift; + my $ticket = shift; + if ($session->param('cas_ticket') && $session->param('cas_ticket') eq $ticket ) { + $session->delete; + $session->flush; + } +} + 1; __END__ diff --git a/C4/AuthoritiesMarc.pm b/C4/AuthoritiesMarc.pm index 9d059a0266..41b5505300 100644 --- a/C4/AuthoritiesMarc.pm +++ b/C4/AuthoritiesMarc.pm @@ -117,7 +117,6 @@ sub SearchAuthorities { # the marclist may contain "mainentry". In this case, search the tag_to_report, that depends on # the authtypecode. Then, search on $a of this tag_to_report # also store main entry MARC tag, to extract it at end of search - my $mainentrytag; ##first set the authtype search and may be multiple authorities if ($authtypecode) { my $n=0; diff --git a/C4/Barcodes/ValueBuilder.pm b/C4/Barcodes/ValueBuilder.pm index ef9f28e057..479a4360f8 100644 --- a/C4/Barcodes/ValueBuilder.pm +++ b/C4/Barcodes/ValueBuilder.pm @@ -19,6 +19,8 @@ # along with Koha; if not, see . package C4::Barcodes::ValueBuilder::incremental; + +use Modern::Perl; use C4::Context; my $DEBUG = 0; diff --git a/C4/Barcodes/annual.pm b/C4/Barcodes/annual.pm index 1c8a432677..00853929f9 100644 --- a/C4/Barcodes/annual.pm +++ b/C4/Barcodes/annual.pm @@ -36,7 +36,7 @@ BEGIN { $width = 4; } -sub db_max ($;$) { +sub db_max { my $self = shift; my $query = "SELECT substring_index(barcode,'-',-1) AS chunk,barcode FROM items WHERE barcode LIKE ? ORDER BY chunk DESC LIMIT 1"; # FIXME: unreasonably expensive query on large datasets (I think removal of group by does this?) @@ -64,7 +64,7 @@ sub initial () { return substr(output_pref({ dt => dt_from_string, dateformat => 'iso', dateonly => 1 }), 0, 4 ) .'-'. sprintf('%'."$width.$width".'d', 1); } -sub parse ($;$) { +sub parse { my $self = shift; my $barcode = (@_) ? shift : $self->value; unless ($barcode =~ /(\d{4}-)(\d+)$/) { # non-greedy match in first part @@ -74,12 +74,12 @@ sub parse ($;$) { $debug and warn "Barcode '$barcode' parses into: '$1', '$2', ''"; return ($1,$2,''); # the third part is in anticipation of barcodes that include checkdigits } -sub width ($;$) { +sub width { my $self = shift; (@_) and $width = shift; # hitting the class variable. return $width; } -sub process_head($$;$$) { # (self,head,whole,specific) +sub process_head { my ($self,$head,$whole,$specific) = @_; $specific and return $head; # if this is built off an existing barcode, just return the head unchanged. return substr(output_pref({ dt => dt_from_string, dateformat => 'iso', dateonly => 1 }), 0, 4 ) . '-'; # else get new YYYY- diff --git a/C4/Biblio.pm b/C4/Biblio.pm index 9eb3696a54..c304e1f071 100644 --- a/C4/Biblio.pm +++ b/C4/Biblio.pm @@ -2146,7 +2146,6 @@ sub TransformHtmlToXml { # MARC::Record->new_from_xml will fail (and Koha will die) my $unimarc_and_100_exist = 0; $unimarc_and_100_exist = 1 if $auth_type eq 'ITEM'; # if we rebuild an item, no need of a 100 field - my $prevvalue; my $prevtag = -1; my $first = 1; my $j = -1; diff --git a/C4/ClassSortRoutine.pm b/C4/ClassSortRoutine.pm index d5fd8a092e..77826cff1b 100644 --- a/C4/ClassSortRoutine.pm +++ b/C4/ClassSortRoutine.pm @@ -52,8 +52,8 @@ my @sort_routines = GetSortRoutineNames(); foreach my $sort_routine (@sort_routines) { if (eval "require C4::ClassSortRoutine::$sort_routine") { my $ref; - eval "\$ref = \\\&C4::ClassSortRoutine::${sort_routine}::get_class_sort_key"; - if (eval "\$ref->(\"a\", \"b\")") { + $ref = \&{"C4::ClassSortRoutine::${sort_routine}::get_class_sort_key"}; + if (eval { $ref->("a", "b") }) { $loaded_routines{$sort_routine} = $ref; } else { $loaded_routines{$sort_routine} = \&_get_class_sort_key; diff --git a/C4/ClassSplitRoutine/RegEx.pm b/C4/ClassSplitRoutine/RegEx.pm index 64e676299d..0c65a753fa 100644 --- a/C4/ClassSplitRoutine/RegEx.pm +++ b/C4/ClassSplitRoutine/RegEx.pm @@ -43,7 +43,7 @@ sub split_callnumber { my ($cn_item, $regexs) = @_; for my $regex ( @$regexs ) { - eval "\$cn_item =~ $regex"; + eval "\$cn_item =~ $regex"; ## no critic (StringyEval) } my @lines = split "\n", $cn_item; diff --git a/C4/Context.pm b/C4/Context.pm index 6f7baeaf2d..8c621e8576 100644 --- a/C4/Context.pm +++ b/C4/Context.pm @@ -248,7 +248,6 @@ sub new { } my $conf_cache = Koha::Caches->get_instance('config'); - my $config_from_cache; if ( $conf_cache->cache ) { $self = $conf_cache->get_from_cache('koha_conf'); } @@ -695,7 +694,6 @@ sub dbh { my $self = shift; my $params = shift; - my $sth; unless ( $params->{new} ) { return Koha::Database->schema->storage->dbh; diff --git a/C4/CourseReserves.pm b/C4/CourseReserves.pm index 06101db1d3..debb94283c 100644 --- a/C4/CourseReserves.pm +++ b/C4/CourseReserves.pm @@ -84,7 +84,7 @@ sub GetCourse { warn whoami() . "( $course_id )" if $DEBUG; my $course = Koha::Courses->find( $course_id ); - return undef unless $course; + return unless $course; $course = $course->unblessed; my $dbh = C4::Context->dbh; diff --git a/C4/Creators.pm b/C4/Creators.pm index f73a6fc2f5..27043227f2 100644 --- a/C4/Creators.pm +++ b/C4/Creators.pm @@ -17,6 +17,8 @@ package C4::Creators; # You should have received a copy of the GNU General Public License # along with Koha; if not, see . +use Modern::Perl; + BEGIN { use vars qw(@EXPORT @ISA); @ISA = qw(Exporter); diff --git a/C4/Creators/Lib.pm b/C4/Creators/Lib.pm index c16a2c81a6..7d769ea9ac 100644 --- a/C4/Creators/Lib.pm +++ b/C4/Creators/Lib.pm @@ -527,7 +527,7 @@ be passed off as a template parameter and used to build an html table. sub html_table { my $headers = shift; my $data = shift; - return undef if scalar(@$data) == 0; # no need to generate a table if there is not data to display + return if scalar(@$data) == 0; # no need to generate a table if there is not data to display my $table = []; my $fields = []; my @table_columns = (); diff --git a/C4/ImportBatch.pm b/C4/ImportBatch.pm index 739f9f6786..70aa7aa607 100644 --- a/C4/ImportBatch.pm +++ b/C4/ImportBatch.pm @@ -1502,10 +1502,10 @@ sub RecordsFromISO2709File { my $marc_type = C4::Context->preference('marcflavour'); $marc_type .= 'AUTH' if ($marc_type eq 'UNIMARC' && $record_type eq 'auth'); - open IN, "<$input_file" or die "$0: cannot open input file $input_file: $!\n"; + open my $fh, '<', $input_file or die "$0: cannot open input file $input_file: $!\n"; my @marc_records; $/ = "\035"; - while () { + while (<$fh>) { s/^\s+//; s/\s+$//; next unless $_; # skip if record has only whitespace, as might occur @@ -1517,7 +1517,7 @@ sub RecordsFromISO2709File { "Unexpected charset $charset_guessed, expecting $encoding"; } } - close IN; + close $fh; return ( \@errors, \@marc_records ); } @@ -1560,15 +1560,15 @@ sub RecordsFromMarcPlugin { return \@return if !$input_file || !$plugin_class; # Read input file - open IN, "<$input_file" or die "$0: cannot open input file $input_file: $!\n"; + open my $fh, '<', $input_file or die "$0: cannot open input file $input_file: $!\n"; $/ = "\035"; - while () { + while (<$fh>) { s/^\s+//; s/\s+$//; next unless $_; $text .= $_; } - close IN; + close $fh; # Convert to large MARC blob with plugin $text = Koha::Plugins::Handler->run({ diff --git a/C4/InstallAuth.pm b/C4/InstallAuth.pm index 987045df50..0bdbe064fc 100644 --- a/C4/InstallAuth.pm +++ b/C4/InstallAuth.pm @@ -270,7 +270,6 @@ sub checkauth { $loggedin = 1; $userid = $session->param('cardnumber'); } - my ( $ip, $lasttime ); if ($logout) { diff --git a/C4/Items.pm b/C4/Items.pm index bbc5a7cd1f..6b78b9f4ac 100644 --- a/C4/Items.pm +++ b/C4/Items.pm @@ -224,7 +224,6 @@ Additional information appropriate to the error condition. sub AddItemBatchFromMarc { my ($record, $biblionumber, $biblioitemnumber, $frameworkcode) = @_; - my $error; my @itemnumbers = (); my @errors = (); my $dbh = C4::Context->dbh; diff --git a/C4/Labels.pm b/C4/Labels.pm index 428be02536..3e05b4af74 100644 --- a/C4/Labels.pm +++ b/C4/Labels.pm @@ -1,5 +1,7 @@ package C4::Labels; +use Modern::Perl; + BEGIN { use C4::Labels::Batch; diff --git a/C4/Labels/Label.pm b/C4/Labels/Label.pm index 25ede0d64f..3b71c946e8 100644 --- a/C4/Labels/Label.pm +++ b/C4/Labels/Label.pm @@ -163,7 +163,6 @@ sub _get_barcode_data { } elsif ( $f =~ /^([0-9a-z]{3})(\w)(\W?).*?/ ) { my ($field,$subf,$ws) = ($1,$2,$3); - my $subf_data; my ($itemtag, $itemsubfieldcode) = &GetMarcFromKohaField( "items.itemnumber" ); my @marcfield = $record->field($field); if(@marcfield) { @@ -313,8 +312,8 @@ sub create_label { my $label_text = ''; my ($text_llx, $text_lly, $line_spacer, $barcode_llx, $barcode_lly, $barcode_width, $barcode_y_scale_factor); { - no strict 'refs'; - ($text_llx, $text_lly, $line_spacer, $barcode_llx, $barcode_lly, $barcode_width, $barcode_y_scale_factor) = &{"_$self->{'printing_type'}"}($self); # an obfuscated call to the correct printing type sub + my $sub = \&{'_' . $self->{printing_type}}; + ($text_llx, $text_lly, $line_spacer, $barcode_llx, $barcode_lly, $barcode_width, $barcode_y_scale_factor) = $sub->($self); # an obfuscated call to the correct printing type sub } if ($self->{'printing_type'} =~ /BIB/) { $label_text = draw_label_text( $self, diff --git a/C4/Languages.pm b/C4/Languages.pm index fad761dfb2..6aa1201c55 100644 --- a/C4/Languages.pm +++ b/C4/Languages.pm @@ -344,8 +344,6 @@ sub _build_languages_arrayref { my @languages_loop; # the final reference to an array of hashrefs my @enabled_languages = @$enabled_languages; # how many languages are enabled, if one, take note, some contexts won't need to display it - my %seen_languages; # the language tags we've seen - my %found_languages; my $language_groups; my $track_language_groups; my $current_language_regex = regex_lang_subtags($current_language); @@ -585,7 +583,7 @@ sub accept_language { } # No primary matches. Secondary? (ie, en-us requested and en supported) return $secondaryMatch if $secondaryMatch; - return undef; # else, we got nothing. + return; # else, we got nothing. } =head2 getlanguage diff --git a/C4/Letters.pm b/C4/Letters.pm index 1036c461f3..ae98e09e38 100644 --- a/C4/Letters.pm +++ b/C4/Letters.pm @@ -313,7 +313,6 @@ sub SendAlerts { or warn( "No biblionumber for '$subscriptionid'" ), return; - my %letter; # find the list of subscribers to notify my $subscription = Koha::Subscriptions->find( $subscriptionid ); my $subscribers = $subscription->subscribers; diff --git a/C4/Matcher.pm b/C4/Matcher.pm index b7389d7bc6..6644ec6a53 100644 --- a/C4/Matcher.pm +++ b/C4/Matcher.pm @@ -165,7 +165,7 @@ sub fetch { $sth->execute($id); my $row = $sth->fetchrow_hashref; $sth->finish(); - return undef unless defined $row; + return unless defined $row; my $self = {}; $self->{'id'} = $row->{'matcher_id'}; diff --git a/C4/Members/Messaging.pm b/C4/Members/Messaging.pm index 2270c3742e..5e51a39a0e 100644 --- a/C4/Members/Messaging.pm +++ b/C4/Members/Messaging.pm @@ -88,7 +88,6 @@ END_SQL my $sth = C4::Context->dbh->prepare($sql); $sth->execute(@bind_params); my $return; - my %transports; # helps build a list of unique message_transport_types ROW: while ( my $row = $sth->fetchrow_hashref() ) { next ROW unless $row->{'message_attribute_id'}; $return->{'days_in_advance'} = $row->{'days_in_advance'} if defined $row->{'days_in_advance'}; diff --git a/C4/Patroncards.pm b/C4/Patroncards.pm index 348a783674..98fb59c28b 100644 --- a/C4/Patroncards.pm +++ b/C4/Patroncards.pm @@ -1,5 +1,7 @@ package C4::Patroncards; +use Modern::Perl; + BEGIN { use vars qw(@EXPORT @ISA); @ISA = qw(Exporter); diff --git a/C4/Patroncards/Patroncard.pm b/C4/Patroncards/Patroncard.pm index 963aac8acf..12a5ce36a3 100644 --- a/C4/Patroncards/Patroncard.pm +++ b/C4/Patroncards/Patroncard.pm @@ -227,11 +227,13 @@ sub draw_text { $parse_line = $2; } my $borrower_attributes = get_borrower_attributes($self->{'borrower_number'},@fields); - grep{ # substitute data for db fields - if ($_ =~ m/<([A-Za-z0-9_]+)>/) { + @orig_line = map { # substitute data for db fields + my $l = $_; + if ($l =~ m/<([A-Za-z0-9_]+)>/) { my $field = $1; - $_ =~ s/$_/$borrower_attributes->{$field}/; + $l =~ s/$l/$borrower_attributes->{$field}/; } + $l; } @orig_line; $line = join(' ',@orig_line); } diff --git a/C4/Record.pm b/C4/Record.pm index 1e13e987c2..f4a75818dd 100644 --- a/C4/Record.pm +++ b/C4/Record.pm @@ -375,7 +375,6 @@ sub marc2endnote { Year => $marc_rec_obj->publication_date, Abstract => $abstract, }; - my $endnote; my $style = new Biblio::EndnoteStyle(); my $template; $template.= "DB - DB\n" if C4::Context->preference("LibraryName"); @@ -420,7 +419,7 @@ sub marc2csv { } # Preprocessing - eval $preprocess if ($preprocess); + eval $preprocess if ($preprocess); ## no critic (StringyEval) my $firstpass = 1; if ( @$itemnumbers ) { @@ -438,7 +437,7 @@ sub marc2csv { } # Postprocessing - eval $postprocess if ($postprocess); + eval $postprocess if ($postprocess); ## no critic (StringyEval) return $output; } @@ -575,7 +574,6 @@ sub marcrecord2csv { if ( $content =~ m|\[\%.*\%\]| ) { my $tt = Template->new(); my $template = $content; - my $vars; # Replace 00X and 0XX with X or XX $content =~ s|fields.00(\d)|fields.$1|g; $content =~ s|fields.0(\d{2})|fields.$1|g; @@ -624,7 +622,7 @@ sub marcrecord2csv { # Field processing my $marcfield = $tag->{fieldtag}; # This line fixes a retrocompatibility concern # The "processing" could be based on the $marcfield variable. - eval $fieldprocessing if ($fieldprocessing); + eval $fieldprocessing if ($fieldprocessing); ## no critic (StringyEval) push @loop_values, $value; } diff --git a/C4/Ris.pm b/C4/Ris.pm index f244bf694d..de8dccc43c 100644 --- a/C4/Ris.pm +++ b/C4/Ris.pm @@ -90,7 +90,6 @@ C<$record> - a MARC::Record object sub marc2ris { my ($record) = @_; - my $output; my $marcflavour = C4::Context->preference("marcflavour"); my $intype = lc($marcflavour); diff --git a/C4/Search.pm b/C4/Search.pm index a10e50f2b6..2bf7ba4ed9 100644 --- a/C4/Search.pm +++ b/C4/Search.pm @@ -87,9 +87,6 @@ sub FindDuplicate { my $result = TransformMarcToKoha( $record, '' ); my $sth; my $query; - my $search; - my $type; - my ( $biblionumber, $title ); # search duplicate on ISBN, easy and fast.. # ... normalize first @@ -309,7 +306,6 @@ sub getRecords { $offset = 0 if $offset < 0; # Initialize variables for the ZOOM connection and results object - my $zconn; my @zconns; my @results; my $results_hashref = (); @@ -428,7 +424,6 @@ sub getRecords { } for ( my $j = $offset ; $j < $times ; $j++ ) { - my $records_hash; my $record; ## Check if it's an index scan diff --git a/C4/Serials.pm b/C4/Serials.pm index b5d57b4fba..35983d67db 100644 --- a/C4/Serials.pm +++ b/C4/Serials.pm @@ -324,10 +324,13 @@ sub GetFullSubscription { my $sth = $dbh->prepare($query); $sth->execute($subscriptionid); my $subscriptions = $sth->fetchall_arrayref( {} ); - my $cannotedit = not can_edit_subscription( $subscriptions->[0] ) if scalar @$subscriptions; - for my $subscription ( @$subscriptions ) { - $subscription->{cannotedit} = $cannotedit; + if (scalar @$subscriptions) { + my $cannotedit = not can_edit_subscription( $subscriptions->[0] ); + for my $subscription ( @$subscriptions ) { + $subscription->{cannotedit} = $cannotedit; + } } + return $subscriptions; } @@ -347,9 +350,6 @@ sub PrepareSerialsData { my $year; my @res; my $startdate; - my $aqbooksellername; - my $bibliotitle; - my @loopissues; my $first; my $previousnote = ""; @@ -482,10 +482,13 @@ sub GetFullSubscriptionsFromBiblionumber { my $sth = $dbh->prepare($query); $sth->execute($biblionumber); my $subscriptions = $sth->fetchall_arrayref( {} ); - my $cannotedit = not can_edit_subscription( $subscriptions->[0] ) if scalar @$subscriptions; - for my $subscription ( @$subscriptions ) { - $subscription->{cannotedit} = $cannotedit; + if (scalar @$subscriptions) { + my $cannotedit = not can_edit_subscription( $subscriptions->[0] ); + for my $subscription ( @$subscriptions ) { + $subscription->{cannotedit} = $cannotedit; + } } + return $subscriptions; } diff --git a/C4/Templates.pm b/C4/Templates.pm index 343a374199..bad3275959 100644 --- a/C4/Templates.pm +++ b/C4/Templates.pm @@ -118,7 +118,7 @@ sub output { $vars = { %$vars, %{ $self->{VARS} } }; my $data; - binmode( STDOUT, ":utf8" ); + binmode( STDOUT, ":encoding(UTF-8)" ); $template->process( $self->filename, $vars, \$data ) || die "Template process failed: ", $template->error(); return $data; diff --git a/Makefile.PL b/Makefile.PL index 4c52f0e04e..1617e17ff7 100644 --- a/Makefile.PL +++ b/Makefile.PL @@ -888,8 +888,8 @@ sub get_install_log_values { my $install_log = shift; my $values = shift; - open LOG, "<$install_log" or die "Cannot open install log $install_log: $!\n"; - while () { + open my $log, '<', $install_log or die "Cannot open install log $install_log: $!\n"; + while (<$log>) { chomp; next if /^#/ or /^\s*$/; next if /^=/; @@ -898,7 +898,7 @@ sub get_install_log_values { my ($key, $value) = split /=/, $_, 2; $values->{$key} = $value; } - close LOG; + close $log; print <<_EXPLAIN_INSTALL_LOG_; Reading values from install log $install_log. You diff --git a/docs/CAS/CASProxy/examples/koha_webservice.pl b/docs/CAS/CASProxy/examples/koha_webservice.pl index dbaa19ef2e..c0b5abe206 100755 --- a/docs/CAS/CASProxy/examples/koha_webservice.pl +++ b/docs/CAS/CASProxy/examples/koha_webservice.pl @@ -33,7 +33,7 @@ The Proxy Ticket, needed for check_api_auth, that will try to make the CAS Serve use utf8; use Modern::Perl; -binmode(STDOUT, ":utf8"); +binmode(STDOUT, ":encoding(UTF-8)"); use C4::Auth qw(check_api_auth); use C4::Output; diff --git a/docs/CAS/CASProxy/examples/proxy_cas_callback.pl b/docs/CAS/CASProxy/examples/proxy_cas_callback.pl index 4ee46b5c2d..fdda4274f0 100755 --- a/docs/CAS/CASProxy/examples/proxy_cas_callback.pl +++ b/docs/CAS/CASProxy/examples/proxy_cas_callback.pl @@ -49,9 +49,9 @@ if ($cgi->param('pgtId')) { # Now we store the pgtIou and the pgtId in the application vars (in our case a storable object in a file), # so that the page requesting the webservice can retrieve the pgtId matching it's PgtIou - open FILE, ">", "casSession.tmp" or die "Unable to open file"; - nstore_fd({$pgtIou => $pgtId}, \*FILE); - close FILE; + open my $fh, ">", "casSession.tmp" or die "Unable to open file"; + nstore_fd({$pgtIou => $pgtId}, $fh); + close $fh; } else { warn "Failed to get a Proxy Ticket\n"; diff --git a/docs/CAS/CASProxy/examples/proxy_cas_data.pl b/docs/CAS/CASProxy/examples/proxy_cas_data.pl index 34f4ce07d1..70ea24cfe6 100755 --- a/docs/CAS/CASProxy/examples/proxy_cas_data.pl +++ b/docs/CAS/CASProxy/examples/proxy_cas_data.pl @@ -54,10 +54,10 @@ if ($cgi->param('PGTIOU')) { # At this point, we must retrieve the PgtId by matching the PgtIou we # just received and the PgtIou given by the CAS Server to the callback URL # The callback page stored it in the application vars (in our case a storable object in a file) - open FILE, "casSession.tmp" or die "Unable to open file"; - my $hashref = fd_retrieve(\*FILE); + open my $fh, '<', "casSession.tmp" or die "Unable to open file"; + my $hashref = fd_retrieve($fh); my $pgtId = %{$hashref->{$cgi->param('PGTIOU')}}; - close FILE; + close $fh; # Now that we have a PgtId, we can ask the cas server for a proxy ticket... my $rp = $cas->proxy( $pgtId, $target_service ); diff --git a/fix-perl-path.PL b/fix-perl-path.PL index c36381d783..2adfa35faa 100644 --- a/fix-perl-path.PL +++ b/fix-perl-path.PL @@ -77,8 +77,8 @@ sub fixshebang{ # to make it writable. Note that stat and chmod # (the Perl functions) should work on Win32 my $old_perm; - $old_perm = (stat $pathfile)[2] & 07777; - my $new_perm = $old_perm | 0200; + $old_perm = (stat $pathfile)[2] & oct(7777); + my $new_perm = $old_perm | oct(200); chmod $new_perm, $pathfile; # tie the file -- note that we're explicitly setting the line (record) diff --git a/installer/data/mysql/labels_upgrade.pl b/installer/data/mysql/labels_upgrade.pl index 859a7d9e80..bb891b459c 100755 --- a/installer/data/mysql/labels_upgrade.pl +++ b/installer/data/mysql/labels_upgrade.pl @@ -17,6 +17,8 @@ # You should have received a copy of the GNU General Public License # along with Koha; if not, see . +use Modern::Perl; + use C4::Context; my $sth = C4::Context->dbh; diff --git a/installer/data/mysql/patroncards_upgrade.pl b/installer/data/mysql/patroncards_upgrade.pl index fde702e1f4..2975c5c0dd 100755 --- a/installer/data/mysql/patroncards_upgrade.pl +++ b/installer/data/mysql/patroncards_upgrade.pl @@ -17,6 +17,8 @@ # You should have received a copy of the GNU General Public License # along with Koha; if not, see . +use Modern::Perl; + use C4::Context; my $sth = C4::Context->dbh; diff --git a/installer/data/mysql/update22to30.pl b/installer/data/mysql/update22to30.pl index d38f080bcc..6a8a1ecd11 100755 --- a/installer/data/mysql/update22to30.pl +++ b/installer/data/mysql/update22to30.pl @@ -35,7 +35,6 @@ my ( $table, $column, $type, $null, $key, $default, $extra, - $prefitem, # preference item in systempreferences table ); my $silent; @@ -3048,7 +3047,7 @@ my $DBversion = "3.00.00.000"; ], ); - foreach $table ( keys %required_prereq_fields ) { + foreach my $table ( keys %required_prereq_fields ) { print "Check table $table\n" if $debug and not $silent; $sth = $dbh->prepare("show columns from $table"); $sth->execute(); @@ -3157,7 +3156,7 @@ my $DBversion = "3.00.00.000"; # Now add any missing tables - foreach $table ( keys %requiretables ) { + foreach my $table ( keys %requiretables ) { unless ( $existingtables{$table} ) { print "Adding $table table...\n" unless $silent; my $sth = $dbh->prepare("create table $table $requiretables{$table} ENGINE=InnoDB DEFAULT CHARSET=utf8"); @@ -3172,7 +3171,7 @@ my $DBversion = "3.00.00.000"; #--------------------------------- # Columns - foreach $table ( keys %requirefields ) { + foreach my $table ( keys %requirefields ) { print "Check table $table\n" if $debug and not $silent; $sth = $dbh->prepare("show columns from $table"); $sth->execute(); @@ -3181,7 +3180,7 @@ my $DBversion = "3.00.00.000"; { $types{$column} = $type; } # while - foreach $column ( keys %{ $requirefields{$table} } ) { + foreach my $column ( keys %{ $requirefields{$table} } ) { print " Check column $column [$types{$column}]\n" if $debug and not $silent; if ( !$types{$column} ) { @@ -3200,7 +3199,7 @@ my $DBversion = "3.00.00.000"; } # foreach column } # foreach table - foreach $table ( sort keys %fielddefinitions ) { + foreach my $table ( sort keys %fielddefinitions ) { print "Check table $table\n" if $debug; $sth = $dbh->prepare("show columns from $table"); $sth->execute(); @@ -3454,7 +3453,7 @@ my $DBversion = "3.00.00.000"; } } # now drop useless tables - foreach $table ( @TableToDelete ) { + foreach my $table ( @TableToDelete ) { if ( $existingtables{$table} ) { print "Dropping unused table $table\n" if $debug and not $silent; $dbh->do("drop table $table"); @@ -3499,9 +3498,8 @@ my $DBversion = "3.00.00.000"; } # at last, remove useless fields - foreach $table ( keys %uselessfields ) { + foreach my $table ( keys %uselessfields ) { my @fields = split (/,/,$uselessfields{$table}); - my $fields; my $exists; foreach my $fieldtodrop (@fields) { $fieldtodrop =~ s/\t//g; diff --git a/installer/data/mysql/updatedatabase.pl b/installer/data/mysql/updatedatabase.pl index 7ac1149c09..4214ba7b50 100755 --- a/installer/data/mysql/updatedatabase.pl +++ b/installer/data/mysql/updatedatabase.pl @@ -53,14 +53,10 @@ use File::Slurp; my $debug = 0; my ( - $sth, $sti, + $sth, $query, - %existingtables, # tables already in database - %types, $table, - $column, - $type, $null, $key, $default, $extra, - $prefitem, # preference item in systempreferences table + $type, ); my $schema = Koha::Database->new()->schema(); @@ -21850,7 +21846,7 @@ foreach my $file ( sort readdir $dirh ) { my $rv = $installer->load_sql( $update_dir . $file ) ? 0 : 1; } elsif ( $file =~ /\.perl$/ ) { my $code = read_file( $update_dir . $file ); - eval $code; + eval $code; ## no critic (StringyEval) say "Atomic update generated errors: $@" if $@; } } diff --git a/installer/externalmodules.pl b/installer/externalmodules.pl index 0d338abf46..f836ccf023 100755 --- a/installer/externalmodules.pl +++ b/installer/externalmodules.pl @@ -12,9 +12,9 @@ qx(grep -r "^ *use" $dir | grep -v "C4\|strict\|vars" >/tmp/modulesKoha.log); $dir=C4::Context->config('opacdir'); qx(grep -r "^ *use" $dir | grep -v "C4\|strict\|vars" >>/tmp/modulesKoha.log); -open FILE, "< /tmp/modulesKoha.log" ||die "unable to open file /tmp/modulesKoha.log"; +open my $fh, '<', '/tmp/modulesKoha.log' ||die "unable to open file /tmp/modulesKoha.log"; my %modulehash; -while (my $line=){ +while (my $line=<$fh>){ if ( $line=~m#(.*)\:\s*use\s+([A-Z][^\s;]+)# ){ my ($file,$module)=($1,$2); my @filename = split /\//, $file; @@ -23,5 +23,5 @@ while (my $line=){ } print "external modules used in Koha ARE :\n"; map {print "* $_ \t in files ",join (",",@{$modulehash{$_}}),"\n" } sort keys %modulehash; -close FILE; +close $fh; unlink "/tmp/modulesKoha.log"; diff --git a/installer/install.pl b/installer/install.pl index 5bd3806872..041438160a 100755 --- a/installer/install.pl +++ b/installer/install.pl @@ -403,7 +403,7 @@ elsif ( $step && $step == 3 ) { close $fh; if (@report) { $template->param( update_report => - [ map { local $_ = $_; $_ =~ s/\t/  /g; { line => $_ } } split( /\n/, join( '', @report ) ) ] + [ map { { line => $_ =~ s/\t/  /gr } } split( /\n/, join( '', @report ) ) ] ); $template->param( has_update_succeeds => 1 ); } diff --git a/misc/admin/koha-preferences b/misc/admin/koha-preferences index 34e34b8b56..ad19a395a2 100755 --- a/misc/admin/koha-preferences +++ b/misc/admin/koha-preferences @@ -18,6 +18,7 @@ # along with Koha; if not, see . # +use Modern::Perl; use Koha::Script; use C4::Boolean; use C4::Context; diff --git a/misc/batchRepairMissingBiblionumbers.pl b/misc/batchRepairMissingBiblionumbers.pl index 695c45291c..3a7dbe5d69 100755 --- a/misc/batchRepairMissingBiblionumbers.pl +++ b/misc/batchRepairMissingBiblionumbers.pl @@ -18,7 +18,6 @@ use C4::Biblio; my $dbh = C4::Context->dbh; -my %kohafields; my $sth=$dbh->prepare("SELECT biblio.biblionumber, biblioitemnumber, frameworkcode FROM biblio JOIN biblioitems USING (biblionumber)"); $sth->execute(); diff --git a/misc/batchdeletebiblios.pl b/misc/batchdeletebiblios.pl index bf4b60f203..3ae5cd9683 100755 --- a/misc/batchdeletebiblios.pl +++ b/misc/batchdeletebiblios.pl @@ -8,7 +8,7 @@ use IO::File; use Koha::Script; use C4::Biblio; -my ($help, $files); +my $help; GetOptions( 'h|help' => \$help, ); diff --git a/misc/bin/connexion_import_daemon.pl b/misc/bin/connexion_import_daemon.pl index bc40cb4e96..22407eb2a8 100755 --- a/misc/bin/connexion_import_daemon.pl +++ b/misc/bin/connexion_import_daemon.pl @@ -132,6 +132,7 @@ sub parse_config { die "Invalid config line $line: $_" unless defined $v; $param{$p} = $v; } + close($conf_fh); $self->{koha} = delete( $param{koha} ) or die "No koha base url in config file"; diff --git a/misc/check_sysprefs.pl b/misc/check_sysprefs.pl index ce2e19e455..942d8f27c4 100755 --- a/misc/check_sysprefs.pl +++ b/misc/check_sysprefs.pl @@ -22,8 +22,8 @@ sub check_sys_pref { if ( !-d _ ) { my $name = $File::Find::name; if ( $name =~ /(\.pl|\.pm)$/ ) { - open( FILE, "$_" ) || die "can't open $name"; - while ( my $inp = ) { + open( my $fh, '<', $_ ) || die "can't open $name"; + while ( my $inp = <$fh> ) { if ( $inp =~ /C4::Context->preference\((.*?)\)/ ) { my $variable = $1; $variable =~ s /\'|\"//g; @@ -37,7 +37,7 @@ sub check_sys_pref { "$name has a reference to $variable, this does not exist in the database\n"; } } - close FILE; + close $fh; } } $sth->finish(); diff --git a/misc/cronjobs/build_browser_and_cloud.pl b/misc/cronjobs/build_browser_and_cloud.pl index d180bcbea1..ccf3ddfa2f 100755 --- a/misc/cronjobs/build_browser_and_cloud.pl +++ b/misc/cronjobs/build_browser_and_cloud.pl @@ -22,7 +22,7 @@ use Getopt::Long; use C4::Log; my ( $input_marc_file, $number) = ('',0); -my ($version, $confirm,$test_parameter,$field,$batch,$max_digits,$cloud_tag); +my ($version, $confirm,$field,$batch,$max_digits,$cloud_tag); GetOptions( 'c' => \$confirm, 'h' => \$version, diff --git a/misc/cronjobs/gather_print_notices.pl b/misc/cronjobs/gather_print_notices.pl index 51ef7cd352..10cf6304e5 100755 --- a/misc/cronjobs/gather_print_notices.pl +++ b/misc/cronjobs/gather_print_notices.pl @@ -25,7 +25,6 @@ use Koha::Util::OpenDocument; use MIME::Lite; my ( - $stylesheet, $help, $split, $html, @@ -231,7 +230,7 @@ sub generate_csv { open my $OUTPUT, '>encoding(utf-8)', $filepath or die "Could not open $filepath: $!"; - my ( @csv_lines, $headers ); + my $headers; foreach my $message ( @$messages ) { my @lines = split /\n/, $message->{content}; chomp for @lines; diff --git a/misc/cronjobs/holds/cancel_expired_holds.pl b/misc/cronjobs/holds/cancel_expired_holds.pl index 9ef50dee2a..463c6b2ba5 100755 --- a/misc/cronjobs/holds/cancel_expired_holds.pl +++ b/misc/cronjobs/holds/cancel_expired_holds.pl @@ -17,8 +17,7 @@ # You should have received a copy of the GNU General Public License # along with Koha; if not, see . -#use strict; -#use warnings; FIXME - Bug 2505 +use Modern::Perl; BEGIN { # find Koha's Perl modules diff --git a/misc/cronjobs/longoverdue.pl b/misc/cronjobs/longoverdue.pl index 3cdeb85335..09955ade9c 100755 --- a/misc/cronjobs/longoverdue.pl +++ b/misc/cronjobs/longoverdue.pl @@ -275,7 +275,7 @@ cronlogaction(); # In my opinion, this line is safe SQL to have outside the API. --atz our $bounds_sth = C4::Context->dbh->prepare("SELECT DATE_SUB(CURDATE(), INTERVAL ? DAY)"); -sub bounds ($) { +sub bounds { $bounds_sth->execute(shift); return $bounds_sth->fetchrow; } @@ -408,10 +408,10 @@ foreach my $startrange (sort keys %$lost) { $endrange = $startrange; } -sub summarize ($$) { +sub summarize { my $arg = shift; # ref to array my $got_items = shift || 0; # print "count" line for items - my @report = @$arg or return undef; + my @report = @$arg or return; my $i = 0; for my $range (@report) { printf "\nRange %s\nDue %3s - %3s days ago (%s to %s), lost => %s\n", ++$i, diff --git a/misc/cronjobs/rss/rss.pl b/misc/cronjobs/rss/rss.pl index 603dba647a..e703d07a79 100755 --- a/misc/cronjobs/rss/rss.pl +++ b/misc/cronjobs/rss/rss.pl @@ -74,8 +74,8 @@ sub getConf { my %return; my $inSection = 0; - open( FILE, $file ) or die "can't open $file"; - while () { + open( my $fh, '<', $file ) or die "can't open $file"; + while (<$fh>) { if ($inSection) { my @line = split( /=/, $_, 2 ); unless ( $line[1] ) { @@ -91,7 +91,7 @@ sub getConf { if ( $_ eq "$section\n" ) { $inSection = 1 } } } - close FILE; + close $fh; return %return; } diff --git a/misc/cronjobs/thirdparty/TalkingTech_itiva_inbound.pl b/misc/cronjobs/thirdparty/TalkingTech_itiva_inbound.pl index 5584ddd675..f00d9d6a34 100755 --- a/misc/cronjobs/thirdparty/TalkingTech_itiva_inbound.pl +++ b/misc/cronjobs/thirdparty/TalkingTech_itiva_inbound.pl @@ -77,6 +77,7 @@ if ( defined $infile ) { $updated += $result; $total++; } + close($IN); } else { die pod2usage( -verbose => 1 ); diff --git a/misc/cronjobs/update_totalissues.pl b/misc/cronjobs/update_totalissues.pl index 6421779d16..f1b621b344 100755 --- a/misc/cronjobs/update_totalissues.pl +++ b/misc/cronjobs/update_totalissues.pl @@ -72,7 +72,7 @@ my $result = GetOptions( 'h|help' => \$want_help ); -binmode( STDOUT, ":utf8" ); +binmode( STDOUT, ":encoding(UTF-8)" ); if ( defined $since && defined $interval ) { print "The --since and --interval options are mutually exclusive.\n\n"; diff --git a/misc/exportauth.pl b/misc/exportauth.pl index 2f5e3dd710..c036b17063 100755 --- a/misc/exportauth.pl +++ b/misc/exportauth.pl @@ -17,7 +17,7 @@ use C4::Context; use C4::Biblio; use C4::Auth; my $outfile = $ARGV[0]; -open(OUT,">$outfile") or die $!; +open(my $fh, '>', $outfile) or die $!; my $dbh=C4::Context->dbh; #$dbh->do("set character_set_client='latin5'"); $dbh->do("set character_set_connection='utf8'"); @@ -25,6 +25,6 @@ $dbh->do("set character_set_connection='utf8'"); my $sth=$dbh->prepare("select marc from auth_header order by authid"); $sth->execute(); while (my ($marc) = $sth->fetchrow) { - print OUT $marc; + print $fh $marc; } -close(OUT); +close($fh); diff --git a/misc/link_bibs_to_authorities.pl b/misc/link_bibs_to_authorities.pl index 1fd75a51e1..9044292185 100755 --- a/misc/link_bibs_to_authorities.pl +++ b/misc/link_bibs_to_authorities.pl @@ -47,7 +47,7 @@ my $result = GetOptions( 'h|help' => \$want_help ); -binmode( STDOUT, ":utf8" ); +binmode( STDOUT, ":encoding(UTF-8)" ); if ( not $result or $want_help ) { usage(); diff --git a/misc/maintenance/cmp_sysprefs.pl b/misc/maintenance/cmp_sysprefs.pl index 250333f0e3..90b21a7c02 100755 --- a/misc/maintenance/cmp_sysprefs.pl +++ b/misc/maintenance/cmp_sysprefs.pl @@ -34,7 +34,7 @@ use Koha::Script; use C4::Context; my $dbh = C4::Context->dbh; -my ( $help, $cmd, $filename, $override, $compare_add, $compare_del, $compare_upd, $ignore_opt, $partial ); +my ( $help, $cmd, $filename, $compare_add, $compare_del, $compare_upd, $ignore_opt, $partial ); GetOptions( 'help' => \$help, 'cmd:s' => \$cmd, diff --git a/misc/maintenance/fix_accountlines_rmdupfines_bug8253.pl b/misc/maintenance/fix_accountlines_rmdupfines_bug8253.pl index c73ae8d343..4a72e1a0f2 100755 --- a/misc/maintenance/fix_accountlines_rmdupfines_bug8253.pl +++ b/misc/maintenance/fix_accountlines_rmdupfines_bug8253.pl @@ -76,7 +76,6 @@ $query = "SELECT * FROM accountlines WHERE description LIKE ? AND description NOT LIKE ?"; $sth = $dbh->prepare($query); -my @fines; foreach my $keeper (@$results) { warn "WORKING ON KEEPER: " . Data::Dumper::Dumper( $keeper ); diff --git a/misc/maintenance/touch_all_biblios.pl b/misc/maintenance/touch_all_biblios.pl index f0630b74fe..8d65f21eed 100755 --- a/misc/maintenance/touch_all_biblios.pl +++ b/misc/maintenance/touch_all_biblios.pl @@ -69,10 +69,11 @@ if ($whereclause) { } # output log or STDOUT +my $fh; if (defined $outfile) { - open (OUT, ">$outfile") || die ("Cannot open output file"); + open ($fh, '>', $outfile) || die ("Cannot open output file"); } else { - open(OUT, ">&STDOUT") || die ("Couldn't duplicate STDOUT: $!"); + open($fh, '>&', \*STDOUT) || die ("Couldn't duplicate STDOUT: $!"); } my $sth1 = $dbh->prepare("SELECT biblionumber, frameworkcode FROM biblio $whereclause"); @@ -86,15 +87,16 @@ while (my ($biblionumber, $frameworkcode) = $sth1->fetchrow_array){ if ($modok) { $goodcount++; - print OUT "Touched biblio $biblionumber\n" if (defined $verbose); + print $fh "Touched biblio $biblionumber\n" if (defined $verbose); } else { $badcount++; - print OUT "ERROR WITH BIBLIO $biblionumber !!!!\n"; + print $fh "ERROR WITH BIBLIO $biblionumber !!!!\n"; } $totalcount++; } +close($fh); # Benchmarking my $endtime = time(); diff --git a/misc/maintenance/touch_all_items.pl b/misc/maintenance/touch_all_items.pl index c6bcf473cb..648190502e 100755 --- a/misc/maintenance/touch_all_items.pl +++ b/misc/maintenance/touch_all_items.pl @@ -70,10 +70,11 @@ if ($whereclause) { } # output log or STDOUT +my $fh; if (defined $outfile) { - open (OUT, ">$outfile") || die ("Cannot open output file"); + open ($fh, '>', $outfile) || die ("Cannot open output file"); } else { - open(OUT, ">&STDOUT") || die ("Couldn't duplicate STDOUT: $!"); + open($fh, '>&', \*STDOUT) || die ("Couldn't duplicate STDOUT: $!"); } # FIXME Would be better to call Koha::Items->search here @@ -88,15 +89,16 @@ while (my ($biblionumber, $itemnumber, $itemcallnumber) = $sth_fetch->fetchrow_a if ($modok) { $goodcount++; - print OUT "Touched item $itemnumber\n" if (defined $verbose); + print $fh "Touched item $itemnumber\n" if (defined $verbose); } else { $badcount++; - print OUT "ERROR WITH ITEM $itemnumber !!!!\n"; + print $fh "ERROR WITH ITEM $itemnumber !!!!\n"; } $totalcount++; } +close($fh); # Benchmarking my $endtime = time(); diff --git a/misc/migration_tools/22_to_30/export_Authorities.pl b/misc/migration_tools/22_to_30/export_Authorities.pl index aeed3f2fa0..956805a2d9 100755 --- a/misc/migration_tools/22_to_30/export_Authorities.pl +++ b/misc/migration_tools/22_to_30/export_Authorities.pl @@ -1,6 +1,5 @@ #!/usr/bin/perl -#use strict; -#use warnings; FIXME - Bug 2505 +use Modern::Perl; BEGIN { # find Koha's Perl modules # test carefully before changing this @@ -32,7 +31,7 @@ while (my ($authid,$authtypecode)=$rq->fetchrow){ if (C4::Context->preference('marcflavour') eq "UNIMARC"){ $record->leader(' nac 22 1u 4500'); - my $string=$1 if $time=~m/([0-9\-]+)/; + my $string= ($time=~m/([0-9\-]+)/) ? $1 : undef $string=~s/\-//g; $string = sprintf("%-*s",26, $string); substr($string,9,6,"frey50"); diff --git a/misc/migration_tools/22_to_30/export_Authorities_xml.pl b/misc/migration_tools/22_to_30/export_Authorities_xml.pl index 42d2e5c0ae..c8a5aa9d63 100755 --- a/misc/migration_tools/22_to_30/export_Authorities_xml.pl +++ b/misc/migration_tools/22_to_30/export_Authorities_xml.pl @@ -1,6 +1,5 @@ #!/usr/bin/perl -#use strict; -#use warnings; FIXME - Bug 2505 +use Modern::Perl; BEGIN { # find Koha's Perl modules # test carefully before changing this @@ -31,7 +30,7 @@ open my $fileoutput, '>:encoding(UTF-8)', "./$filename/$authid.xml" or die "unab # if (C4::Context->preference('marcflavour') eq "UNIMARC"){ $record->leader(' nac 22 1u 4500'); - my $string=$1 if $time=~m/([0-9\-]+)/; + my $string = ($time=~m/([0-9\-]+)/) ? $1 : undef $string=~s/\-//g; $string = sprintf("%-*s",26, $string); substr($string,9,6,"frey50"); diff --git a/misc/migration_tools/22_to_30/move_marc_to_biblioitems.pl b/misc/migration_tools/22_to_30/move_marc_to_biblioitems.pl index 3635dbc386..38ea2897c2 100755 --- a/misc/migration_tools/22_to_30/move_marc_to_biblioitems.pl +++ b/misc/migration_tools/22_to_30/move_marc_to_biblioitems.pl @@ -1,6 +1,5 @@ #!/usr/bin/perl -#use strict; -#use warnings; FIXME - Bug 2505 +use Modern::Perl; # script to shift marc to biblioitems # scraped from updatedatabase for dev week by chris@katipo.co.nz BEGIN { diff --git a/misc/migration_tools/buildCOUNTRY.pl b/misc/migration_tools/buildCOUNTRY.pl index daca8e5a9c..af0bf216f2 100755 --- a/misc/migration_tools/buildCOUNTRY.pl +++ b/misc/migration_tools/buildCOUNTRY.pl @@ -14,7 +14,7 @@ use Time::HiRes qw(gettimeofday); use Getopt::Long; my ( $fields, $number,$language) = ('',0); -my ($version, $verbose, $test_parameter, $field,$delete,$subfields); +my ($version, $verbose, $test_parameter, $delete); GetOptions( 'h' => \$version, 'd' => \$delete, diff --git a/misc/migration_tools/buildEDITORS.pl b/misc/migration_tools/buildEDITORS.pl index 37ece96089..bb11d45881 100755 --- a/misc/migration_tools/buildEDITORS.pl +++ b/misc/migration_tools/buildEDITORS.pl @@ -67,7 +67,6 @@ my $starttime = gettimeofday; my $sth = $dbh->prepare("select bibid from marc_biblio"); $sth->execute; my $i=1; -my %alreadydone; my $counter; my %hash; while (my ($bibid) = $sth->fetchrow) { diff --git a/misc/migration_tools/buildLANG.pl b/misc/migration_tools/buildLANG.pl index 5e0a5ab684..b1174ab8d3 100755 --- a/misc/migration_tools/buildLANG.pl +++ b/misc/migration_tools/buildLANG.pl @@ -14,7 +14,7 @@ use Time::HiRes qw(gettimeofday); use Getopt::Long; my ( $fields, $number,$language) = ('',0); -my ($version, $verbose, $test_parameter, $field,$delete,$subfields); +my ($version, $verbose, $test_parameter, $delete); GetOptions( 'h' => \$version, 'd' => \$delete, diff --git a/misc/migration_tools/bulkmarcimport.pl b/misc/migration_tools/bulkmarcimport.pl index 6ab4b3fcf4..3e4e9bb1af 100755 --- a/misc/migration_tools/bulkmarcimport.pl +++ b/misc/migration_tools/bulkmarcimport.pl @@ -147,8 +147,9 @@ if($marc_mod_template ne '') { my $dbh = C4::Context->dbh; my $heading_fields=get_heading_fields(); +my $idmapfh; if (defined $idmapfl) { - open(IDMAP,">$idmapfl") or die "cannot open $idmapfl \n"; + open($idmapfh, '>', $idmapfl) or die "cannot open $idmapfl \n"; } if ((not defined $sourcesubfield) && (not defined $sourcetag)){ @@ -441,11 +442,11 @@ RECORD: while ( ) { if ($sourcetag < "010"){ if ($record->field($sourcetag)){ my $source = $record->field($sourcetag)->data(); - printf(IDMAP "%s|%s\n",$source,$biblionumber); + printf($idmapfh "%s|%s\n",$source,$biblionumber); } } else { my $source=$record->subfield($sourcetag,$sourcesubfield); - printf(IDMAP "%s|%s\n",$source,$biblionumber); + printf($idmapfh "%s|%s\n",$source,$biblionumber); } } # create biblio, unless we already have it ( either match or isbn ) diff --git a/misc/migration_tools/remove_unused_authorities.pl b/misc/migration_tools/remove_unused_authorities.pl index 2e5c0971f3..ece2b0f992 100755 --- a/misc/migration_tools/remove_unused_authorities.pl +++ b/misc/migration_tools/remove_unused_authorities.pl @@ -71,7 +71,6 @@ unless ($nb > 0) { } my $dbh=C4::Context->dbh; -my @results; # prepare the request to retrieve all authorities of the requested types my $rqsql = q{ SELECT authid,authtypecode FROM auth_header }; $rqsql .= q{ WHERE authtypecode IN (}.join(',',map{ '?' }@authtypes).')' if @authtypes; diff --git a/misc/perlmodule_rm.pl b/misc/perlmodule_rm.pl index 4dc3b64ff6..f5735ac4d2 100755 --- a/misc/perlmodule_rm.pl +++ b/misc/perlmodule_rm.pl @@ -2,7 +2,7 @@ # Remove a perl module -use warnings; +use Modern::Perl; use ExtUtils::Packlist; use ExtUtils::Installed; diff --git a/misc/translator/LangInstaller.pm b/misc/translator/LangInstaller.pm index 7b5e23648b..8c372003a8 100644 --- a/misc/translator/LangInstaller.pm +++ b/misc/translator/LangInstaller.pm @@ -1087,7 +1087,7 @@ sub get_all_langs { opendir( my $dh, $self->{path_po} ); my @files = grep { $_ =~ /-pref.(po|po.gz)$/ } readdir $dh; - @files = map { $_ =~ s/-pref.(po|po.gz)$//; $_ } @files; + @files = map { $_ =~ s/-pref.(po|po.gz)$//r } @files; } diff --git a/misc/translator/TmplTokenizer.pm b/misc/translator/TmplTokenizer.pm index b092ba61d7..3719878a71 100644 --- a/misc/translator/TmplTokenizer.pm +++ b/misc/translator/TmplTokenizer.pm @@ -138,7 +138,7 @@ BEGIN { sub parenleft () { '(' } sub parenright () { ')' } -sub _split_js ($) { +sub _split_js { my ($s0) = @_; my @it = (); while (length $s0) { @@ -190,7 +190,7 @@ sub STATE_STRING_LITERAL () { 3 } # XXX This is a crazy hack. I don't want to write an ECMAScript parser. # XXX A scanner is one thing; a parser another thing. -sub _identify_js_translatables (@) { +sub _identify_js_translatables { my @input = @_; my @output = (); # We mark a JavaScript translatable string as in C, i.e., _("literal") @@ -227,7 +227,7 @@ sub _identify_js_translatables (@) { ############################################################################### -sub string_canon ($) { +sub string_canon { my $s = shift; # Fold all whitespace into single blanks $s =~ s/\s+/ /g; @@ -236,7 +236,7 @@ sub string_canon ($) { } # safer version used internally, preserves new lines -sub string_canon_safe ($) { +sub string_canon_safe { my $s = shift; # fold tabs and spaces into single spaces $s =~ s/[\ \t]+/ /gs; @@ -252,7 +252,7 @@ sub _quote_cformat{ sub _formalize_string_cformat{ my $s = shift; - return _quote_cformat( string_canon_safe $s ); + return _quote_cformat( string_canon_safe($s) ); } sub _formalize{ @@ -314,7 +314,7 @@ sub next_token { return $self->_parametrize_internal(@parts); } else { - return undef; + return; } } # if cformat mode is off, dont bother parametrizing, just return them as they come @@ -337,7 +337,7 @@ sub next_token { push @tail, $3; $s0 = $2; } - push @head, _split_js $s0; + push @head, _split_js($s0); $next->set_js_data(_identify_js_translatables(@head, @tail) ); return $next unless @parts; $self->{_parser}->unshift_token($next); @@ -359,7 +359,7 @@ sub next_token { # function taken from old version # used by tmpl_process3 -sub parametrize ($$$$) { +sub parametrize { my($fmt_0, $cformat_p, $t, $f) = @_; my $it = ''; if ($cformat_p) { @@ -379,13 +379,13 @@ sub parametrize ($$$$) { ; } elsif (defined $params[$i - 1]) { my $param = $params[$i - 1]; - warn_normal "$fmt_0: $&: Expected a TMPL_VAR, but found a " - . $param->type->to_string . "\n", undef + warn_normal("$fmt_0: $&: Expected a TMPL_VAR, but found a " + . $param->type->to_string . "\n", undef) if $param->type != C4::TmplTokenType::DIRECTIVE; - warn_normal "$fmt_0: $&: Unsupported " - . "field width or precision\n", undef + warn_normal("$fmt_0: $&: Unsupported " + . "field width or precision\n", undef) if defined $width || defined $prec; - warn_normal "$fmt_0: $&: Parameter $i not known", undef + warn_normal("$fmt_0: $&: Parameter $i not known", undef) unless defined $param; $it .= defined $f? &$f( $param ): $param->string; } @@ -396,27 +396,27 @@ sub parametrize ($$$$) { my $param = $params[$i - 1]; if (!defined $param) { - warn_normal "$fmt_0: $&: Parameter $i not known", undef; + warn_normal("$fmt_0: $&: Parameter $i not known", undef); } else { if ($param->type == C4::TmplTokenType::TAG && $param->string =~ /^attributes? lc($param->attributes->{'type'}->[1]): undef; if ($conv eq 'S') { - warn_normal "$fmt_0: $&: Expected type=text, " - . "but found type=$type", undef + warn_normal("$fmt_0: $&: Expected type=text, " + . "but found type=$type", undef) unless $type eq 'text'; } elsif ($conv eq 'p') { - warn_normal "$fmt_0: $&: Expected type=radio, " - . "but found type=$type", undef + warn_normal("$fmt_0: $&: Expected type=radio, " + . "but found type=$type", undef) unless $type eq 'radio'; } } else { - warn_normal "$&: Expected an INPUT, but found a " - . $param->type->to_string . "\n", undef + warn_normal("$&: Expected an INPUT, but found a " + . $param->type->to_string . "\n", undef) } - warn_normal "$fmt_0: $&: Unsupported " - . "field width or precision\n", undef + warn_normal("$fmt_0: $&: Unsupported " + . "field width or precision\n", undef) if defined $width || defined $prec; $it .= defined $f? &$f( $param ): $param->string; } @@ -439,7 +439,7 @@ sub parametrize ($$$$) { my $i = $1; $fmt = $'; my $anchor = $anchors[$i - 1]; - warn_normal "$&: Anchor $1 not found for msgid \"$fmt_0\"", undef #FIXME + warn_normal("$&: Anchor $1 not found for msgid \"$fmt_0\"", undef) #FIXME unless defined $anchor; $it .= $anchor->string; } else { @@ -452,12 +452,12 @@ sub parametrize ($$$$) { # Other simple functions (These are not methods) -sub blank_p ($) { +sub blank_p { my($s) = @_; return $s =~ /^(?:\s|\ $re_end_entity|$re_tmpl_var|$re_xsl)*$/osi; } -sub trim ($) { +sub trim { my($s0) = @_; my $l0 = length $s0; my $s = $s0; @@ -466,7 +466,7 @@ sub trim ($) { return wantarray? (substr($s0, 0, $l1), $s, substr($s0, $l0 - $l2)): $s; } -sub quote_po ($) { +sub quote_po { my($s) = @_; # Locale::PO->quote is buggy, it doesn't quote newlines :-/ $s =~ s/([\\"])/\\$1/gs; @@ -475,7 +475,7 @@ sub quote_po ($) { return "\"$s\""; } -sub charset_canon ($) { +sub charset_canon { my($charset) = @_; $charset = uc($charset); $charset = "$1-$2" if $charset =~ /^(ISO|UTF)(\d.*)/i; @@ -508,7 +508,7 @@ use vars qw( @latin1_utf8 ); "\303\270", "\303\271", "\303\272", "\303\273", "\303\274", "\303\275", "\303\276", "\303\277" ); -sub charset_convert ($$$) { +sub charset_convert { my($s, $charset_in, $charset_out) = @_; if ($s !~ /[\200-\377]/s) { # FIXME: don't worry about iso2022 for now ; diff --git a/misc/translator/VerboseWarnings.pm b/misc/translator/VerboseWarnings.pm index 08ee09c22e..8d6d1cf0e8 100644 --- a/misc/translator/VerboseWarnings.pm +++ b/misc/translator/VerboseWarnings.pm @@ -40,32 +40,32 @@ verbose warnings. use vars qw( $appName $input $input_abbr $pedantic_p $pedantic_tag $quiet); use vars qw( $warned $erred ); -sub set_application_name ($) { +sub set_application_name { my($s) = @_; $appName = $& if !defined $appName && $s =~ /[^\/]+$/; } -sub application_name () { +sub application_name { return $appName; } -sub set_input_file_name ($) { +sub set_input_file_name { my($s) = @_; $input = $s; $input_abbr = $& if defined $s && $s =~ /[^\/]+$/; } -sub set_pedantic_mode ($) { +sub set_pedantic_mode { my($p) = @_; $pedantic_p = $p; $pedantic_tag = $pedantic_p? '': ' (negligible)'; } -sub pedantic_p () { +sub pedantic_p { return $pedantic_p; } -sub construct_warn_prefix ($$) { +sub construct_warn_prefix { my($prefix, $lc) = @_; die "construct_warn_prefix called before set_application_name" unless defined $appName; @@ -80,20 +80,20 @@ sub construct_warn_prefix ($$) { return "$appName: $prefix: " . (defined $lc? "$input_abbr: line $lc: ": defined $input_abbr? "$input_abbr: ": ''); } -sub warn_additional ($$) { +sub warn_additional { my($msg, $lc) = @_; my $prefix = construct_warn_prefix('Warning', $lc); $msg .= "\n" unless $msg =~ /\n$/s; warn "$prefix$msg"; } -sub warn_normal ($$) { +sub warn_normal { my($msg, $lc) = @_; $warned += 1; warn_additional($msg, $lc); } -sub warn_pedantic ($$$) { +sub warn_pedantic { my($msg, $lc, $flag) = @_; my $prefix = construct_warn_prefix("Warning$pedantic_tag", $lc); $msg .= "\n" unless $msg =~ /\n$/s; @@ -106,20 +106,20 @@ sub warn_pedantic ($$$) { $warned += 1; } -sub error_additional ($$) { +sub error_additional { my($msg, $lc) = @_; my $prefix = construct_warn_prefix('ERROR', $lc); $msg .= "\n" unless $msg =~ /\n$/s; warn "$prefix$msg"; } -sub error_normal ($$) { +sub error_normal { my($msg, $lc) = @_; $erred += 1; error_additional($msg, $lc); } -sub warned () { +sub warned { return $warned; # number of times warned } diff --git a/misc/translator/po2json b/misc/translator/po2json index 2f534bead3..44cab9029e 100755 --- a/misc/translator/po2json +++ b/misc/translator/po2json @@ -37,7 +37,7 @@ sub usage { sub main { - my ($src_fh, $src); + my $src; my $pretty = 0; if ($ARGV[0] =~ /^--?p$/) { @@ -124,7 +124,8 @@ sub main # on a normal msgid } else { my $qmsgctxt = $po->msgctxt; - my $msgctxt = $po->dequote($qmsgctxt) if $qmsgctxt; + my $msgctxt; + $msgctxt = $po->dequote($qmsgctxt) if $qmsgctxt; # build the new msgid key my $msg_ctxt_id = defined($msgctxt) ? join($gettext_context_glue, ($msgctxt, $msgid1)) : $msgid1; @@ -134,7 +135,8 @@ sub main # msgid plural side my $qmsgid_plural = $po->msgid_plural; - my $msgid2 = $po->dequote( $qmsgid_plural ) if $qmsgid_plural; + my $msgid2; + $msgid2 = $po->dequote( $qmsgid_plural ) if $qmsgid_plural; push(@trans, $msgid2); # translated string @@ -145,14 +147,16 @@ sub main for (my $i=0; $i<$plural_form_count; $i++) { my $qstr = ref($plurals) ? $$plurals{$i} : undef; - my $str = $po->dequote( $qstr ) if $qstr; + my $str; + $str = $po->dequote( $qstr ) if $qstr; push(@trans, $str); } # singular } else { my $qmsgstr = $po->msgstr; - my $msgstr = $po->dequote( $qmsgstr ) if $qmsgstr; + my $msgstr; + $msgstr = $po->dequote( $qmsgstr ) if $qmsgstr; push(@trans, $msgstr); } diff --git a/misc/translator/tmpl_process3.pl b/misc/translator/tmpl_process3.pl index 68c58f0cc6..9ec7c8b1dc 100755 --- a/misc/translator/tmpl_process3.pl +++ b/misc/translator/tmpl_process3.pl @@ -35,7 +35,7 @@ use vars qw( $charset_in $charset_out ); ############################################################################### -sub find_translation ($) { +sub find_translation { my($s) = @_; my $key = $s; if ($s =~ /\S/s) { @@ -56,13 +56,13 @@ sub find_translation ($) { } } -sub text_replace_tag ($$) { +sub text_replace_tag { my($t, $attr) = @_; my $it; my @ttvar; # value [tag=input], meta - my $tag = lc($1) if $t =~ /^<(\S+)/s; + my $tag = ($t =~ /^<(\S+)/s) ? lc($1) : undef; my $translated_p = 0; for my $a ('alt', 'content', 'title', 'value', 'label', 'placeholder') { if ($attr->{$a}) { @@ -117,10 +117,10 @@ sub text_replace_tag ($$) { return $it; } -sub text_replace (**) { +sub text_replace { my($h, $output) = @_; for (;;) { - my $s = TmplTokenizer::next_token $h; + my $s = TmplTokenizer::next_token($h); last unless defined $s; my($kind, $t, $attr) = ($s->type, $s->string, $s->attributes); if ($kind eq C4::TmplTokenType::TEXT) { @@ -138,7 +138,7 @@ sub text_replace (**) { for my $t (@{$s->js_data}) { # FIXME for this whole block if ($t->[0]) { - printf $output "%s%s%s", $t->[2], find_translation $t->[3], + printf $output "%s%s%s", $t->[2], find_translation($t->[3]), $t->[2]; } else { print $output $t->[1]; @@ -178,14 +178,14 @@ sub listfiles { } } } else { - warn_normal "$dir: $!", undef; + warn_normal("$dir: $!", undef); } return @it; } ############################################################################### -sub mkdir_recursive ($) { +sub mkdir_recursive { my($dir) = @_; local($`, $&, $', $1); $dir = $` if $dir ne /^\/+$/ && $dir =~ /\/+$/; @@ -194,13 +194,13 @@ sub mkdir_recursive ($) { if (!-d $dir) { print STDERR "Making directory $dir...\n" unless $quiet; # creates with rwxrwxr-x permissions - mkdir($dir, 0775) || warn_normal "$dir: $!", undef; + mkdir($dir, 0775) || warn_normal("$dir: $!", undef); } } ############################################################################### -sub usage ($) { +sub usage { my($exitcode) = @_; my $h = $exitcode? *STDERR: *STDOUT; print $h < \$quiet, 'pedantic-warnings|pedantic' => sub { $pedantic_p = 1 }, 'help' => \&usage, -) || usage_error; +) || usage_error(); -VerboseWarnings::set_application_name $0; -VerboseWarnings::set_pedantic_mode $pedantic_p; +VerboseWarnings::set_application_name($0); +VerboseWarnings::set_pedantic_mode($pedantic_p); # keep the buggy Locale::PO quiet if it says stupid things $SIG{__WARN__} = sub { @@ -307,7 +307,7 @@ $href = Locale::PO->load_file_ashash($str_file); # guess the charsets. HTML::Templates defaults to iso-8859-1 if (defined $href) { die "$str_file: PO file is corrupted, or not a PO file\n" unless defined $href->{'""'}; - $charset_out = TmplTokenizer::charset_canon $2 if $href->{'""'}->msgstr =~ /\bcharset=(["']?)([^;\s"'\\]+)\1/; + $charset_out = TmplTokenizer::charset_canon($2) if $href->{'""'}->msgstr =~ /\bcharset=(["']?)([^;\s"'\\]+)\1/; $charset_in = $charset_out; # for my $msgid (keys %$href) { # if ($msgid =~ /\bcharset=(["']?)([^;\s"'\\]+)\1/) { @@ -326,22 +326,22 @@ if (defined $href) { next if $id_count == $str_count || $msg->{msgstr} eq '""' || grep { /fuzzy/ } @{$msg->{_flags}}; - warn_normal + warn_normal( "unconsistent %s count: ($id_count/$str_count):\n" . " line: " . $msg->{loaded_line_number} . "\n" . " msgid: " . $msg->{msgid} . "\n" . - " msgstr: " . $msg->{msgstr} . "\n", undef; + " msgstr: " . $msg->{msgstr} . "\n", undef); } } # set our charset in to UTF-8 if (!defined $charset_in) { - $charset_in = TmplTokenizer::charset_canon 'UTF-8'; + $charset_in = TmplTokenizer::charset_canon('UTF-8'); warn "Warning: Can't determine original templates' charset, defaulting to $charset_in\n" unless ( $quiet ); } # set our charset out to UTF-8 if (!defined $charset_out) { - $charset_out = TmplTokenizer::charset_canon 'UTF-8'; + $charset_out = TmplTokenizer::charset_canon('UTF-8'); warn "Warning: Charset Out defaulting to $charset_out\n" unless ( $quiet ); } my $xgettext = './xgettext.pl'; # actual text extractor script @@ -376,23 +376,22 @@ if ($action eq 'create') { # FIXME: msgmerge(1) is a Unix dependency # FIXME: need to check the return value unless (-f $str_file) { - local(*INPUT, *OUTPUT); - open(INPUT, "<$tmpfile2"); - open(OUTPUT, ">$str_file"); - while () { - print OUTPUT; + open(my $infh, '<', $tmpfile2); + open(my $outfh, '>', $str_file); + while (<$infh>) { + print $outfh; last if /^\n/s; } - close INPUT; - close OUTPUT; + close $infh; + close $outfh; } $st = system("msgmerge ".($quiet?'-q':'')." -s $str_file $tmpfile2 -o - | msgattrib --no-obsolete -o $str_file"); } else { - error_normal "Text extraction failed: $xgettext: $!\n", undef; - error_additional "Will not run msgmerge\n", undef; + error_normal("Text extraction failed: $xgettext: $!\n", undef); + error_additional("Will not run msgmerge\n", undef); } - unlink $tmpfile1 || warn_normal "$tmpfile1: unlink failed: $!\n", undef; - unlink $tmpfile2 || warn_normal "$tmpfile2: unlink failed: $!\n", undef; + unlink $tmpfile1 || warn_normal("$tmpfile1: unlink failed: $!\n", undef); + unlink $tmpfile2 || warn_normal("$tmpfile2: unlink failed: $!\n", undef); } elsif ($action eq 'update') { my($tmph1, $tmpfile1) = tmpnam(); @@ -421,11 +420,11 @@ if ($action eq 'create') { $st = system("msgmerge ".($quiet?'-q':'')." -s $str_file $tmpfile2 -o - | msgattrib --no-obsolete -o $str_file"); } } else { - error_normal "Text extraction failed: $xgettext: $!\n", undef; - error_additional "Will not run msgmerge\n", undef; + error_normal("Text extraction failed: $xgettext: $!\n", undef); + error_additional("Will not run msgmerge\n", undef); } - unlink $tmpfile1 || warn_normal "$tmpfile1: unlink failed: $!\n", undef; - unlink $tmpfile2 || warn_normal "$tmpfile2: unlink failed: $!\n", undef; + unlink $tmpfile1 || warn_normal("$tmpfile1: unlink failed: $!\n", undef); + unlink $tmpfile2 || warn_normal("$tmpfile2: unlink failed: $!\n", undef); } elsif ($action eq 'install') { if(!defined($out_dir)) { @@ -448,8 +447,8 @@ if ($action eq 'create') { -d $out_dir || die "$out_dir: The directory does not exist\n"; # Try to open the file, because Locale::PO doesn't check :-/ - open(INPUT, "<$str_file") || die "$str_file: $!\n"; - close INPUT; + open(my $fh, '<', $str_file) || die "$str_file: $!\n"; + close $fh; # creates the new tmpl file using the new translation for my $input (@in_files) { @@ -457,17 +456,17 @@ if ($action eq 'create') { unless substr($input, 0, length($in_dir) + 1) eq "$in_dir/"; my $target = $out_dir . substr($input, length($in_dir)); - my $targetdir = $` if $target =~ /[^\/]+$/s; + my $targetdir = ($target =~ /[^\/]+$/s) ? $` : undef; if (!defined $type || $input =~ /\.(?:$type)$/) { my $h = TmplTokenizer->new( $input ); $h->set_allow_cformat( 1 ); - VerboseWarnings::set_input_file_name $input; + VerboseWarnings::set_input_file_name($input); mkdir_recursive($targetdir) unless -d $targetdir; print STDERR "Creating $target...\n" unless $quiet; - open( OUTPUT, ">$target" ) || die "$target: $!\n"; - text_replace( $h, *OUTPUT ); - close OUTPUT; + open( my $fh, '>', $target ) || die "$target: $!\n"; + text_replace( $h, $fh ); + close $fh; } else { # just copying the file mkdir_recursive($targetdir) unless -d $targetdir; diff --git a/misc/translator/xgettext.pl b/misc/translator/xgettext.pl index f7b42e589a..b8525331f8 100755 --- a/misc/translator/xgettext.pl +++ b/misc/translator/xgettext.pl @@ -101,7 +101,7 @@ sub string_list { sub text_extract { my($h) = @_; for (;;) { - my $s = TmplTokenizer::next_token $h; + my $s = TmplTokenizer::next_token($h); last unless defined $s; my($kind, $t, $attr) = ($s->type, $s->string, $s->attributes); if ($kind eq C4::TmplTokenType::TEXT) { @@ -123,7 +123,7 @@ sub text_extract { next if $a eq 'value' && ($tag ne 'input' || (ref $attr->{'type'} && $attr->{'type'}->[1] =~ /^(?:hidden|radio|checkbox)$/)); # FIXME my($key, $val, $val_orig, $order) = @{$attr->{$a}}; #FIXME - $val = TmplTokenizer::trim $val; + $val = TmplTokenizer::trim($val); # for selected attributes replace '[%..%]' with '%s' globally if ( $a =~ /title|value|alt|content|placeholder/ ) { $val =~ s/\[\%.*?\%\]/\%s/g; @@ -154,7 +154,7 @@ sub generate_strings_list { sub generate_po_file { # We don't emit the Plural-Forms header; it's meaningless for us my $pot_charset = (defined $charset_out? $charset_out: 'CHARSET'); - $pot_charset = TmplTokenizer::charset_canon $pot_charset; + $pot_charset = TmplTokenizer::charset_canon($pot_charset); # Time stamps aren't exactly right semantically. I don't know how to fix it. my $time = POSIX::strftime('%Y-%m-%d %H:%M%z', localtime(time)); my $time_pot = $time; @@ -243,9 +243,11 @@ EOF $cformat_p = 1 if $token->type == C4::TmplTokenType::TEXT_PARAMETRIZED; } printf $OUTPUT "#, c-format\n" if $cformat_p; - printf $OUTPUT "msgid %s\n", TmplTokenizer::quote_po - TmplTokenizer::string_canon - TmplTokenizer::charset_convert $t, $charset_in, $charset_out; + printf $OUTPUT "msgid %s\n", TmplTokenizer::quote_po( + TmplTokenizer::string_canon( + TmplTokenizer::charset_convert($t, $charset_in, $charset_out) + ) + ); printf $OUTPUT "msgstr %s\n\n", (defined $translation{$t}? TmplTokenizer::quote_po( $translation{$t} ): "\"\""); } @@ -255,7 +257,7 @@ EOF sub convert_translation_file { open(my $INPUT, '<', $convert_from) || die "$convert_from: $!\n"; - VerboseWarnings::set_input_file_name $convert_from; + VerboseWarnings::set_input_file_name($convert_from); while (<$INPUT>) { chomp; my($msgid, $msgstr) = split(/\t/); @@ -272,13 +274,13 @@ sub convert_translation_file { $translation{$msgid} = $msgstr unless $msgstr eq '*****'; if ($msgid =~ /\bcharset=(["']?)([^;\s"']+)\1/s) { - my $candidate = TmplTokenizer::charset_canon $2; + my $candidate = TmplTokenizer::charset_canon($2); die "Conflicting charsets in msgid: $candidate vs $charset_in\n" if defined $charset_in && $charset_in ne $candidate; $charset_in = $candidate; } if ($msgstr =~ /\bcharset=(["']?)([^;\s"']+)\1/s) { - my $candidate = TmplTokenizer::charset_canon $2; + my $candidate = TmplTokenizer::charset_canon($2); die "Conflicting charsets in msgid: $candidate vs $charset_out\n" if defined $charset_out && $charset_out ne $candidate; $charset_out = $candidate; @@ -286,7 +288,7 @@ sub convert_translation_file { } # The following assumption is correct; that's what HTML::Template assumes if (!defined $charset_in) { - $charset_in = $charset_out = TmplTokenizer::charset_canon 'utf-8'; + $charset_in = $charset_out = TmplTokenizer::charset_canon('utf-8'); warn "Warning: Can't determine original templates' charset, defaulting to $charset_in\n"; } } @@ -354,8 +356,8 @@ GetOptions( 'help' => sub { usage(0) }, ) || usage_error; -VerboseWarnings::set_application_name $0; -VerboseWarnings::set_pedantic_mode $pedantic_p; +VerboseWarnings::set_application_name($0); +VerboseWarnings::set_pedantic_mode($pedantic_p); usage_error('Missing mandatory option -f') unless defined $files_from || defined $convert_from; @@ -380,7 +382,7 @@ if (defined $files_from) { my $input = /^\//? $_: "$directory/$_"; my $h = TmplTokenizer->new( $input ); $h->set_allow_cformat( 1 ); - VerboseWarnings::set_input_file_name $input; + VerboseWarnings::set_input_file_name($input); print STDERR "$0: Processing file \"$input\"\n" if $verbose_p; text_extract( $h ); } diff --git a/opac/opac-MARCdetail.pl b/opac/opac-MARCdetail.pl index b835f1bdea..39cb10eecf 100755 --- a/opac/opac-MARCdetail.pl +++ b/opac/opac-MARCdetail.pl @@ -155,7 +155,6 @@ if (C4::Context->preference("RequestOnOpac")) { # fill arrays my @loop_data = (); -my $tag; # loop through each tab 0 through 9 for ( my $tabloop = 0 ; $tabloop <= 9 ; $tabloop++ ) { diff --git a/opac/opac-alert-subscribe.pl b/opac/opac-alert-subscribe.pl index 098e42fb0e..66d2bf9807 100755 --- a/opac/opac-alert-subscribe.pl +++ b/opac/opac-alert-subscribe.pl @@ -32,7 +32,6 @@ my $query = new CGI; my $op = $query->param('op') || ''; my $dbh = C4::Context->dbh; -my $sth; my ( $template, $loggedinuser, $cookie ); my $subscriptionid = $query->param('subscriptionid'); my $referer = $query->param('referer') || 'detail'; diff --git a/opac/opac-authorities-home.pl b/opac/opac-authorities-home.pl index 85f1dd7b17..059cbb44c5 100755 --- a/opac/opac-authorities-home.pl +++ b/opac/opac-authorities-home.pl @@ -56,7 +56,6 @@ if ( $op eq "do_search" ) { my @value = $query->multi_param('value'); $value[0] ||= q||; - my @tags; my $builder = Koha::SearchEngine::QueryBuilder->new( { index => $Koha::SearchEngine::AUTHORITIES_INDEX } ); my $searcher = Koha::SearchEngine::Search->new( diff --git a/opac/opac-authoritiesdetail.pl b/opac/opac-authoritiesdetail.pl index 08d0369225..b35df75b8d 100755 --- a/opac/opac-authoritiesdetail.pl +++ b/opac/opac-authoritiesdetail.pl @@ -114,7 +114,6 @@ if ($show_marc) { # fill arrays my @loop_data = (); - my $tag; # loop through each tag my @fields = $record->fields(); diff --git a/opac/opac-basket.pl b/opac/opac-basket.pl index 6a454bedf0..9744e12c9d 100755 --- a/opac/opac-basket.pl +++ b/opac/opac-basket.pl @@ -119,7 +119,6 @@ foreach my $biblionumber ( @bibs ) { { map { $_->{authorised_value} => $_->{opac_description} } Koha::AuthorisedValues->get_descriptions_by_koha_field( { frameworkcode => $dat->{frameworkcode}, kohafield => 'items.location' } ) }; # COinS format FIXME: for books Only - my $coins_format; my $fmt = substr $record->leader(), 6,2; my $fmts; $fmts->{'am'} = 'book'; diff --git a/opac/opac-search.pl b/opac/opac-search.pl index 01887f283a..4590003aa2 100755 --- a/opac/opac-search.pl +++ b/opac/opac-search.pl @@ -534,8 +534,6 @@ my $hits; # Define some global variables my ($error,$query,$simple_query,$query_cgi,$query_desc,$limit,$limit_cgi,$limit_desc,$query_type); -my @results; - my $suppress = 0; if (C4::Context->preference('OpacSuppression')) { # OPAC suppression by IP address @@ -604,9 +602,7 @@ $template->param ( OPACResultsSidebar => C4::Context->preference('OPACResultsSid ## II. DO THE SEARCH AND GET THE RESULTS my $total = 0; # the total results for the whole set my $facets; # this object stores the faceted results that display on the left-hand of the results page -my @results_array; my $results_hashref; -my @coins; if ($tag) { $query_cgi = "tag=" . uri_escape_utf8( $tag ) . "&" . $query_cgi; @@ -967,7 +963,6 @@ for (my $i=0;$i<@servers;$i++) { # FIXME: can add support for other targets as needed here $template->param( outer_sup_results_loop => \@sup_results_array); } #/end of the for loop -#$template->param(FEDERATED_RESULTS => \@results_array); for my $facet ( @$facets ) { for my $entry ( @{ $facet->{facets} } ) { diff --git a/opac/opac-serial-issues.pl b/opac/opac-serial-issues.pl index 88f86646e1..cf095c1c41 100755 --- a/opac/opac-serial-issues.pl +++ b/opac/opac-serial-issues.pl @@ -34,8 +34,6 @@ my $dbh = C4::Context->dbh; my $selectview = $query->param('selectview'); $selectview = C4::Context->preference("SubscriptionHistory") unless $selectview; -my $sth; - # my $id; my ( $template, $loggedinuser, $cookie ); my $biblionumber = $query->param('biblionumber'); diff --git a/opac/opac-showreviews.pl b/opac/opac-showreviews.pl index 09363cc1a5..3f0fef1381 100755 --- a/opac/opac-showreviews.pl +++ b/opac/opac-showreviews.pl @@ -85,7 +85,6 @@ my $reviews = Koha::Reviews->search( my $marcflavour = C4::Context->preference("marcflavour"); my $hits = Koha::Reviews->search({ approved => 1 })->count; my $i = 0; -my $latest_comment_date; for my $result (@$reviews){ my $biblionumber = $result->{biblionumber}; my $biblio = Koha::Biblios->find( $biblionumber ); diff --git a/patroncards/create-pdf.pl b/patroncards/create-pdf.pl index 154377ce0e..c38ce43306 100755 --- a/patroncards/create-pdf.pl +++ b/patroncards/create-pdf.pl @@ -44,13 +44,13 @@ my ( $template, $loggedinuser, $cookie ) = get_template_and_user({ flagsrequired => { tools => 'label_creator' }, debug => 1, }); -my $batch_id = $cgi->param('batch_id') if $cgi->param('batch_id'); +my $batch_id = $cgi->param('batch_id') || undef; my $template_id = $cgi->param('template_id') || undef; my $layout_id = $cgi->param('layout_id') || undef; my $layout_back_id = $cgi->param('layout_back_id') || undef; my $start_card = $cgi->param('start_card') || 1; -my @label_ids = $cgi->multi_param('label_id') if $cgi->param('label_id'); -my @borrower_numbers = $cgi->multi_param('borrower_number') if $cgi->param('borrower_number'); +my @label_ids = $cgi->multi_param('label_id'); +my @borrower_numbers = $cgi->multi_param('borrower_number'); my $patronlist_id = $cgi->param('patronlist_id'); my $items = undef; # items = cards @@ -70,7 +70,7 @@ $pdf = C4::Creators::PDF->new(InitVars => 0); my $batch = C4::Patroncards::Batch->retrieve(batch_id => $batch_id); my $pc_template = C4::Patroncards::Template->retrieve(template_id => $template_id, profile_id => 1); my $layout = C4::Patroncards::Layout->retrieve(layout_id => $layout_id); -my $layout_back = C4::Patroncards::Layout->retrieve(layout_id => $layout_back_id) if ( $layout_back_id ); +my $layout_back = $layout_back_id ? C4::Patroncards::Layout->retrieve(layout_id => $layout_back_id) : undef; $| = 1; @@ -111,7 +111,7 @@ else { } my $layout_xml = XMLin($layout->get_attr('layout_xml'), ForceArray => 1); -my $layout_back_xml = XMLin($layout_back->get_attr('layout_xml'), ForceArray => 1) if ( defined $layout_back ); +my $layout_back_xml = defined $layout_back ? XMLin($layout_back->get_attr('layout_xml'), ForceArray => 1) : undef; if ($layout_xml->{'page_side'} eq 'B') { # rearrange items on backside of page to swap columns my $even = 1; diff --git a/patroncards/image-manage.pl b/patroncards/image-manage.pl index e5c4729686..7504b76de2 100755 --- a/patroncards/image-manage.pl +++ b/patroncards/image-manage.pl @@ -28,7 +28,7 @@ my $file_name = $cgi->param('uploadfile') || ''; my $image_name = $cgi->param('image_name') || $file_name; my $upload_file = $cgi->upload('uploadfile') || ''; my $op = $cgi->param('op') || 'none'; -my @image_ids = $cgi->multi_param('image_id') if $cgi->param('image_id'); +my @image_ids = $cgi->multi_param('image_id'); my $source_file = "$file_name"; # otherwise we end up with what amounts to a pointer to a filehandle rather than a user-friendly filename diff --git a/patroncards/print.pl b/patroncards/print.pl index 8992038fec..4ade2c1995 100755 --- a/patroncards/print.pl +++ b/patroncards/print.pl @@ -40,14 +40,14 @@ my ( $template, $loggedinuser, $cookie ) = get_template_and_user( ); my $op = $cgi->param('op') || 'none'; -my @label_ids = $cgi->multi_param('label_id') if $cgi->param('label_id'); # this will handle individual card printing; we use label_id to maintain consistency with the column names in the creator_batches table -my @batch_ids = $cgi->multi_param('batch_id') if $cgi->param('batch_id'); +my @label_ids = $cgi->multi_param('label_id'); # this will handle individual card printing; we use label_id to maintain consistency with the column names in the creator_batches table +my @batch_ids = $cgi->multi_param('batch_id'); my $patronlist_id = $cgi->param('patronlist_id') || undef; my $layout_id = $cgi->param('layout_id') || undef; my $layout_back_id = $cgi->param('layout_back_id') || undef; my $template_id = $cgi->param('template_id') || undef; my $start_card = $cgi->param('start_card') || 1; -my @borrower_numbers = $cgi->multi_param('borrower_number') if $cgi->param('borrower_number'); +my @borrower_numbers = $cgi->multi_param('borrower_number'); my $output_format = $cgi->param('output_format') || 'pdf'; my $referer = $cgi->param('referer') || undef; @@ -123,9 +123,9 @@ elsif ($op eq 'none') { # setup select menus for selecting layout and template for this run... $referer = $ENV{'HTTP_REFERER'}; $referer =~ s/^.*?:\/\/.*?(\/.*)$/$1/m; - @batch_ids = grep{$_ = {batch_id => $_}} @batch_ids; - @label_ids = grep{$_ = {label_id => $_}} @label_ids; - @borrower_numbers = grep{$_ = {borrower_number => $_}} @borrower_numbers; + @batch_ids = map { {batch_id => $_} } @batch_ids; + @label_ids = map { {label_id => $_} } @label_ids; + @borrower_numbers = map { {borrower_number => $_} } @borrower_numbers; $templates = get_all_templates( { fields => [qw( template_id template_code ) ], filters => { creator => "Patroncards" } }); $layouts = get_all_layouts({ fields => [ qw( layout_id layout_name ) ], filters => { creator => "Patroncards" } }); $output_formats = get_output_formats(); diff --git a/plugins/plugins-upload.pl b/plugins/plugins-upload.pl index c4e8a204d0..6ad52abccf 100755 --- a/plugins/plugins-upload.pl +++ b/plugins/plugins-upload.pl @@ -50,7 +50,7 @@ my $uploadfile = $input->upload('uploadfile'); my $uploadlocation = $input->param('uploadlocation'); my $op = $input->param('op') || q{}; -my ( $total, $handled, @counts, $tempfile, $tfh ); +my ( $tempfile, $tfh ); my %errors; diff --git a/reports/acquisitions_stats.pl b/reports/acquisitions_stats.pl index d7dea6a85f..eb56a05b31 100755 --- a/reports/acquisitions_stats.pl +++ b/reports/acquisitions_stats.pl @@ -426,7 +426,6 @@ sub calculate { } my $i = 0; - my @totalcol; my $hilighted = -1; #Initialization of cell values..... diff --git a/reports/bor_issues_top.pl b/reports/bor_issues_top.pl index 84a46a36a2..e2f6989f71 100755 --- a/reports/bor_issues_top.pl +++ b/reports/bor_issues_top.pl @@ -41,7 +41,7 @@ plugin that shows a stats on borrowers =cut -$debug and open DEBUG, ">/tmp/bor_issues_top.debug.log"; +$debug and open my $debugfh, '>', '/tmp/bor_issues_top.debug.log'; my $input = new CGI; my $fullreportname = "reports/bor_issues_top.tt"; @@ -104,7 +104,6 @@ if ($do_it) { } my $dbh = C4::Context->dbh; -my @values; # here each element returned by map is a hashref, get it? my @mime = ( map { {type =>$_} } (split /[;:]/, 'CSV') ); # FIXME translation @@ -125,7 +124,6 @@ sub calculate { my ($limit, $column, $filters) = @_; my @loopcol; - my @loopline; my @looprow; my %globalline; my %columns; @@ -226,25 +224,25 @@ sub calculate { $strsth2 .=" GROUP BY $colfield"; $strsth2 .=" ORDER BY $colorder"; - $debug and print DEBUG "bor_issues_top (old_issues) SQL: $strsth2\n"; + $debug and print $debugfh "bor_issues_top (old_issues) SQL: $strsth2\n"; my $sth2 = $dbh->prepare($strsth2); $sth2->execute; - print DEBUG "rows: ", $sth2->rows, "\n"; + print $debugfh "rows: ", $sth2->rows, "\n"; while (my @row = $sth2->fetchrow) { $columns{($row[0] ||'NULL')}++; push @loopcol, { coltitle => $row[0] || 'NULL' }; } $strsth2 =~ s/old_issues/issues/g; - $debug and print DEBUG "bor_issues_top (issues) SQL: $strsth2\n"; + $debug and print $debugfh "bor_issues_top (issues) SQL: $strsth2\n"; $sth2 = $dbh->prepare($strsth2); $sth2->execute; - $debug and print DEBUG "rows: ", $sth2->rows, "\n"; + $debug and print $debugfh "rows: ", $sth2->rows, "\n"; while (my @row = $sth2->fetchrow) { $columns{($row[0] ||'NULL')}++; push @loopcol, { coltitle => $row[0] || 'NULL' }; } - $debug and print DEBUG "full array: ", Dumper(\%columns), "\n"; + $debug and print $debugfh "full array: ", Dumper(\%columns), "\n"; }else{ $columns{''} = 1; } @@ -281,10 +279,10 @@ sub calculate { $strcalc .= ",$colfield " if ($colfield); $strcalc .= " LIMIT $limit" if ($limit); - $debug and print DEBUG "(old_issues) SQL : $strcalc\n"; + $debug and print $debugfh "(old_issues) SQL : $strcalc\n"; my $dbcalc = $dbh->prepare($strcalc); $dbcalc->execute; - $debug and print DEBUG "rows: ", $dbcalc->rows, "\n"; + $debug and print $debugfh "rows: ", $dbcalc->rows, "\n"; my %patrons = (); # DATA STRUCTURE is going to look like this: # (2253=> {name=>"John Doe", @@ -303,10 +301,10 @@ sub calculate { use Data::Dumper; $strcalc =~ s/old_issues/issues/g; - $debug and print DEBUG "(issues) SQL : $strcalc\n"; + $debug and print $debugfh "(issues) SQL : $strcalc\n"; $dbcalc = $dbh->prepare($strcalc); $dbcalc->execute; - $debug and print DEBUG "rows: ", $dbcalc->rows, "\n"; + $debug and print $debugfh "rows: ", $dbcalc->rows, "\n"; while (my @data = $dbcalc->fetchrow) { my ($row, $rank, $id, $col) = @data; $col = "zzEMPTY" if (!defined($col)); @@ -325,7 +323,7 @@ sub calculate { $patrons{$id}->{total} += $count; } } - $debug and print DEBUG "\n\npatrons: ", Dumper(\%patrons); + $debug and print $debugfh "\n\npatrons: ", Dumper(\%patrons); my $i = 1; my @cols_in_order = sort keys %columns; # if you want to order the columns, do something here @@ -371,6 +369,6 @@ sub calculate { return [\%globalline]; # reference to a 1 element array: that element is a hashref } -$debug and close DEBUG; +$debug and close $debugfh; 1; __END__ diff --git a/reports/borrowers_out.pl b/reports/borrowers_out.pl index 762a0d4d09..31ba73aa8b 100755 --- a/reports/borrowers_out.pl +++ b/reports/borrowers_out.pl @@ -110,11 +110,7 @@ if ($do_it) { # Displaying choices } else { my $dbh = C4::Context->dbh; - my @values; - my %labels; - my %select; - my $req; - + my $CGIextChoice = ( 'CSV' ); # FIXME translation my $CGIsepChoice = GetDelimiterChoices; @@ -133,7 +129,6 @@ sub calculate { my @mainloop; my @loopfooter; my @loopcol; - my @loopline; my @looprow; my %globalline; my $grantotal =0; diff --git a/reports/catalogue_out.pl b/reports/catalogue_out.pl index 3b0fdd8f74..7713b14d1b 100755 --- a/reports/catalogue_out.pl +++ b/reports/catalogue_out.pl @@ -66,8 +66,6 @@ output_html_with_http_headers $input, $cookie, $template->output; sub calculate { my ( $limit, $column, $filters ) = @_; - my @loopline; - my @looprow; my %globalline; my %columns = (); my $dbh = C4::Context->dbh; diff --git a/reports/catalogue_stats.pl b/reports/catalogue_stats.pl index b7bd98a024..536a76b266 100755 --- a/reports/catalogue_stats.pl +++ b/reports/catalogue_stats.pl @@ -114,11 +114,7 @@ if ($do_it) { } } else { my $dbh = C4::Context->dbh; - my @values; - my %labels; my $count=0; - my $req; - my @select; my $itemtypes = Koha::ItemTypes->search_with_localization; @@ -397,7 +393,6 @@ sub calculate { } my $i = 0; - my @totalcol; my $hilighted = -1; #Initialization of cell values..... diff --git a/reports/issues_avg_stats.pl b/reports/issues_avg_stats.pl index cea969e5b0..baa4e69e1b 100755 --- a/reports/issues_avg_stats.pl +++ b/reports/issues_avg_stats.pl @@ -389,7 +389,6 @@ sub calculate { # warn "fin des titres colonnes"; my $i=0; - my @totalcol; my $hilighted=-1; #Initialization of cell values..... @@ -442,12 +441,8 @@ sub calculate { $dbcalc->execute; # warn "filling table"; my $issues_count=0; - my $previous_row; - my $previous_col; my $loanlength; - my $err; my $emptycol; - my $weightrow; while (my @data = $dbcalc->fetchrow) { my ($row, $col, $issuedate, $returndate, $weight)=@data; diff --git a/reports/issues_stats.pl b/reports/issues_stats.pl index 16a8f77bfc..fac2b5883e 100755 --- a/reports/issues_stats.pl +++ b/reports/issues_stats.pl @@ -148,9 +148,6 @@ if ($do_it) { my $dbh = C4::Context->dbh; -my @values; -my %labels; -my %select; # location list my @locations; @@ -525,7 +522,7 @@ sub calculate { or ( $colsource eq 'items' ) || @$filters[5] || @$filters[6] || @$filters[7] || @$filters[8] || @$filters[9] || @$filters[10] || @$filters[11] || @$filters[12] || @$filters[13] ); $strcalc .= "WHERE 1=1 "; - @$filters = map { defined($_) and s/\*/%/g; $_ } @$filters; + @$filters = map { my $f = $_; defined($f) and $f =~ s/\*/%/g; $f } @$filters; $strcalc .= " AND statistics.datetime >= '" . @$filters[0] . "'" if ( @$filters[0] ); $strcalc .= " AND statistics.datetime <= '" . @$filters[1] . " 23:59:59'" if ( @$filters[1] ); $strcalc .= " AND borrowers.categorycode LIKE '" . @$filters[2] . "'" if ( @$filters[2] ); diff --git a/reports/reserves_stats.pl b/reports/reserves_stats.pl index b6afa0fe2c..c034d46339 100755 --- a/reports/reserves_stats.pl +++ b/reports/reserves_stats.pl @@ -126,9 +126,6 @@ if ($do_it) { } my $dbh = C4::Context->dbh; -my @values; -my %labels; -my %select; my $itemtypes = Koha::ItemTypes->search_with_localization; @@ -260,7 +257,6 @@ sub calculate { push @loopfilter, {crit=>'SQL =', sql=>1, filter=>$strcalc}; @sqlparams=(@sqlparams,@sqlorparams); $dbcalc->execute(@sqlparams); - my ($emptycol,$emptyrow); my $data = $dbcalc->fetchall_hashref([qw(line col)]); my %cols_hash; foreach my $row (keys %$data){ diff --git a/rewrite-config.PL b/rewrite-config.PL index 1fec27c3d5..3047f8d2f6 100644 --- a/rewrite-config.PL +++ b/rewrite-config.PL @@ -19,6 +19,7 @@ # # 2007/11/12 Added DB_PORT and changed other keywords to reflect multi-dbms support. -fbcit +use Modern::Perl; use Sys::Hostname; use Socket; @@ -158,7 +159,7 @@ $prefix = $ENV{'INSTALL_BASE'} || "/usr"; ); # Override configuration from the environment -foreach $key (keys %configuration) { +foreach my $key (keys %configuration) { if (defined($ENV{$key})) { $configuration{$key} = $ENV{$key}; } @@ -180,21 +181,22 @@ $file =~ s/__.*?__/exists $configuration{$&} ? $configuration{$&} : $&/seg; # to make it writable. Note that stat and chmod # (the Perl functions) should work on Win32 my $old_perm; -$old_perm = (stat $fname)[2] & 07777; -my $new_perm = $old_perm | 0200; +$old_perm = (stat $fname)[2] & oct(7777); +my $new_perm = $old_perm | oct(200); chmod $new_perm, $fname; -open(OUTPUT,">$fname") || die "Can't open $fname for write: $!"; -print OUTPUT $file; -close(OUTPUT); +open(my $output, ">", $fname) || die "Can't open $fname for write: $!"; +print $output $file; +close($output); chmod $old_perm, $fname; # Idea taken from perlfaq5 -sub read_file($) { - local(*INPUT,$/); - open(INPUT,$_[0]) || die "Can't open $_[0] for read"; - my $file = ; +sub read_file { + local $/; + open(my $fh , '<', $_[0]) || die "Can't open $_[0] for read"; + my $file = <$fh>; + close $fh; return $file; } diff --git a/svc/holds b/svc/holds index af1b033063..37254b6407 100755 --- a/svc/holds +++ b/svc/holds @@ -66,7 +66,6 @@ my $holds_rs = Koha::Holds->search( } ); -my $borrower; my @holds; while ( my $h = $holds_rs->next() ) { my $item = $h->item(); diff --git a/t/00-testcritic.t b/t/00-testcritic.t index 8a7f5d2e5f..4c7f44132a 100755 --- a/t/00-testcritic.t +++ b/t/00-testcritic.t @@ -1,39 +1,13 @@ #!/usr/bin/env perl # This script can be used to run perlcritic on perl files in koha -# It calls its own custom perlcriticrc # The script is purely optional requiring Test::Perl::Critic to be installed # and the environment variable TEST_QA to be set -# At present only the directories in @dirs will pass the tests in 'Gentle' mode use Modern::Perl; -use File::Spec; use Test::More; use English qw(-no_match_vars); -my @dirs = qw( - acqui - admin - authorities - basket - catalogue - cataloguing - circ - debian - errors - labels - members - offline_circ - reserve - reviews - rotating_collections - serials - sms - virtualshelves - Koha - C4/SIP -); - if ( not $ENV{TEST_QA} ) { my $msg = 'Author test. Set $ENV{TEST_QA} to a true value to run'; plan( skip_all => $msg ); @@ -46,7 +20,5 @@ if ( $EVAL_ERROR ) { plan( skip_all => $msg ); } -my $rcfile = File::Spec->catfile( 't', 'perlcriticrc' ); -Test::Perl::Critic->import( -profile => $rcfile); -all_critic_ok(@dirs); - +Test::Perl::Critic->import( -profile => '.perlcriticrc'); +all_critic_ok('.'); diff --git a/t/Languages.t b/t/Languages.t index edd2a5ad1a..14b84135bb 100644 --- a/t/Languages.t +++ b/t/Languages.t @@ -37,7 +37,7 @@ $module_context->mock( preference => sub { my ($self, $pref) = @_; if ($return_undef) { - return undef; + return; } elsif ($pref =~ /language/) { return join ',', @languages; } else { diff --git a/t/Prices.t b/t/Prices.t index 740bfe5e11..6a74135211 100644 --- a/t/Prices.t +++ b/t/Prices.t @@ -42,8 +42,8 @@ fixtures_ok [ my $bookseller_module = Test::MockModule->new('Koha::Acquisition::Bookseller'); -my ( $basketno_0_0, $basketno_1_1, $basketno_1_0, $basketno_0_1 ); -my ( $invoiceid_0_0, $invoiceid_1_1, $invoiceid_1_0, $invoiceid_0_1 ); +my ( $basketno_0_0, $basketno_1_1 ); +my ( $invoiceid_0_0, $invoiceid_1_1 ); my $today; for my $currency_format ( qw( US FR ) ) { diff --git a/t/SuggestionEngine.t b/t/SuggestionEngine.t index eed6fe8525..c8c981fa60 100755 --- a/t/SuggestionEngine.t +++ b/t/SuggestionEngine.t @@ -13,7 +13,7 @@ BEGIN { my $plugindir = File::Spec->rel2abs('Koha/SuggestionEngine/Plugin'); opendir(my $dh, $plugindir); -my @installed_plugins = map { ( /\.pm$/ && -f "$plugindir/$_" && s/\.pm$// ) ? "Koha::SuggestionEngine::Plugin::$_" : () } readdir($dh); +my @installed_plugins = map { my $p = $_; ( $p =~ /\.pm$/ && -f "$plugindir/$p" && $p =~ s/\.pm$// ) ? "Koha::SuggestionEngine::Plugin::$p" : () } readdir($dh); my @available_plugins = Koha::SuggestionEngine::AvailablePlugins(); foreach my $plugin (@installed_plugins) { diff --git a/t/db_dependent/Accounts.t b/t/db_dependent/Accounts.t index 8074a142de..56665ae7cf 100644 --- a/t/db_dependent/Accounts.t +++ b/t/db_dependent/Accounts.t @@ -61,7 +61,6 @@ $dbh->do(q|DELETE FROM issues|); $dbh->do(q|DELETE FROM borrowers|); my $branchcode = $library->{branchcode}; -my $borrower_number; my $context = new Test::MockModule('C4::Context'); $context->mock( 'userenv', sub { diff --git a/t/db_dependent/Acquisition/OrderFromSubscription.t b/t/db_dependent/Acquisition/OrderFromSubscription.t index 218ddf7927..fb85b52ed1 100644 --- a/t/db_dependent/Acquisition/OrderFromSubscription.t +++ b/t/db_dependent/Acquisition/OrderFromSubscription.t @@ -30,7 +30,6 @@ my $bookseller = Koha::Acquisition::Bookseller->new( )->store; my ($biblionumber, $biblioitemnumber) = AddBiblio(MARC::Record->new, ''); -my $budgetid; my $bpid = AddBudgetPeriod({ budget_period_startdate => '2015-01-01', budget_period_enddate => '2015-12-31', @@ -55,7 +54,7 @@ my $subscriptionid = NewSubscription( ); die unless $subscriptionid; -my ($basket, $basketno); +my $basketno; ok($basketno = NewBasket($bookseller->id, 1), "NewBasket( " . $bookseller->id . ", 1 ) returns $basketno"); my $cost = 42.00; diff --git a/t/db_dependent/Acquisition/OrderUsers.t b/t/db_dependent/Acquisition/OrderUsers.t index 9d88734d95..f4ffcb2652 100644 --- a/t/db_dependent/Acquisition/OrderUsers.t +++ b/t/db_dependent/Acquisition/OrderUsers.t @@ -41,7 +41,6 @@ my $budgetid = C4::Budgets::AddBudget( ); my $budget = C4::Budgets::GetBudget($budgetid); -my @ordernumbers; my ( $biblionumber, $biblioitemnumber ) = C4::Biblio::AddBiblio( MARC::Record->new, '' ); my $order = Koha::Acquisition::Order->new( diff --git a/t/db_dependent/Barcodes.t b/t/db_dependent/Barcodes.t index 97c6e3e2df..f00f8b5789 100755 --- a/t/db_dependent/Barcodes.t +++ b/t/db_dependent/Barcodes.t @@ -149,7 +149,7 @@ my %thash = ( EAN13 => ['0000000695152','892685001928'], ); -my ($obj1,$obj2,$format,$value,$initial,$serial,$re,$next,$previous,$temp); +my ($obj1,$obj2,$format,$value,$initial,$serial,$next,$previous,$temp); my @formats = sort keys %thash; foreach (@formats) { my $pre = sprintf '(%-12s)', $_; @@ -214,7 +214,7 @@ foreach (@formats) { } } -foreach $format (@formats) { +foreach my $format (@formats) { my $pre = sprintf '(%-12s)', $format; foreach my $testval (@{$thash{ $format }}) { if ($format eq 'hbyymmincr') { diff --git a/t/db_dependent/Context.t b/t/db_dependent/Context.t index cb7c94f5fc..532f6cae70 100755 --- a/t/db_dependent/Context.t +++ b/t/db_dependent/Context.t @@ -68,8 +68,6 @@ ok($config = $koha->{config}, 'Getting $koha->{config} '); # Testing syspref caching use Test::DBIx::Class; -my $history; - my $schema = Koha::Database->new()->schema(); $schema->storage->debug(1); my $trace_read; diff --git a/t/db_dependent/Hold.t b/t/db_dependent/Hold.t index 674f58ae3e..dc588ded2b 100755 --- a/t/db_dependent/Hold.t +++ b/t/db_dependent/Hold.t @@ -78,7 +78,7 @@ my $hold = Koha::Hold->new( $hold->store(); my $b1_cal = C4::Calendar->new( branchcode => $branches[1]->{branchcode} ); -$b1_cal->insert_single_holiday( day => 02, month => 01, year => 2017, title => "Morty Day", description => "Rick" ); #Add a holiday +$b1_cal->insert_single_holiday( day => 2, month => 1, year => 2017, title => "Morty Day", description => "Rick" ); #Add a holiday my $today = dt_from_string; is( $hold->age(), $today->delta_days( dt_from_string( '2017-01-01' ) )->in_units( 'days') , "Age of hold is days from reservedate to now if calendar ignored"); is( $hold->age(1), $today->delta_days( dt_from_string( '2017-01-01' ) )->in_units( 'days' ) - 1 , "Age of hold is days from reservedate to now minus 1 if calendar used"); diff --git a/t/db_dependent/LDAP/test_ldap_add.pl b/t/db_dependent/LDAP/test_ldap_add.pl index 1a67748f0c..c64186d253 100755 --- a/t/db_dependent/LDAP/test_ldap_add.pl +++ b/t/db_dependent/LDAP/test_ldap_add.pl @@ -46,7 +46,7 @@ sub hashup { } sub recursive_breakdown { - my $dse = shift or return undef; + my $dse = shift or return; if (ref($dse) =~ /HASH/) { return join "\n", map {"$_\t=> " . recursive_breakdown($dse->{$_})} keys %$dse; } elsif (ref($dse) =~ /ARRAY/) { diff --git a/t/db_dependent/Record/Record.t b/t/db_dependent/Record/Record.t index 0bbfb03568..6fb335fa22 100755 --- a/t/db_dependent/Record/Record.t +++ b/t/db_dependent/Record/Record.t @@ -45,48 +45,48 @@ $ ./Record_test.pl ok (1, 'module compiled'); # open some files for testing -open MARC21MARC8,WHEREAMI."/marc21_marc8.dat" or die $!; +open my $MARC21MARC8, '<', WHEREAMI."/marc21_marc8.dat" or die $!; my $marc21_marc8; # = scalar (MARC21MARC8); -foreach my $line () { +foreach my $line (<$MARC21MARC8>) { $marc21_marc8 .= $line; } $marc21_marc8 =~ s/\n$//; -close MARC21MARC8; +close $MARC21MARC8; -open (MARC21UTF8,"<:utf8",WHEREAMI."/marc21_utf8.dat") or die $!; +open (my $MARC21UTF8, '<:encoding(UTF-8)', WHEREAMI."/marc21_utf8.dat") or die $!; my $marc21_utf8; -foreach my $line () { +foreach my $line (<$MARC21UTF8>) { $marc21_utf8 .= $line; } $marc21_utf8 =~ s/\n$//; -close MARC21UTF8; +close $MARC21UTF8; -open MARC21MARC8COMBCHARS,WHEREAMI."/marc21_marc8_combining_chars.dat" or die $!; +open(my $MARC21MARC8COMBCHARS, '<', WHEREAMI."/marc21_marc8_combining_chars.dat" or die $!; my $marc21_marc8_combining_chars; -foreach my $line() { +foreach my $line(<$MARC21MARC8COMBCHARS>) { $marc21_marc8_combining_chars.=$line; } $marc21_marc8_combining_chars =~ s/\n$//; #FIXME: why is a newline ending up here? -close MARC21MARC8COMBCHARS; +close $MARC21MARC8COMBCHARS; -open (MARC21UTF8COMBCHARS,"<:utf8",WHEREAMI."/marc21_utf8_combining_chars.dat") or die $!; +open (my $MARC21UTF8COMBCHARS, '<:encoding(UTF-8)', WHEREAMI."/marc21_utf8_combining_chars.dat") or die $!; my $marc21_utf8_combining_chars; -foreach my $line() { +foreach my $line(<$MARC21UTF8COMBCHARS>) { $marc21_utf8_combining_chars.=$line; } -close MARC21UTF8COMBCHARS; +close $MARC21UTF8COMBCHARS; -open (MARCXMLUTF8,"<:utf8",WHEREAMI."/marcxml_utf8.xml") or die $!; +open (my $MARCXMLUTF8, '<:encoding(UTF-8)', WHEREAMI."/marcxml_utf8.xml") or die $!; my $marcxml_utf8; -foreach my $line () { +foreach my $line (<$MARCXMLUTF8>) { $marcxml_utf8 .= $line; } -close MARCXMLUTF8; +close $MARCXMLUTF8; $marcxml_utf8 =~ s/\n//g; ## The Tests: -my $error; my $marc; my $marcxml; my $dcxml; # some scalars to store values +my $error; my $marc; my $marcxml; # some scalars to store values ## MARC to MARCXML print "\n1. Checking conversion of simple ISO-2709 (MARC21) records to MARCXML\n"; ok (($error,$marcxml) = marc2marcxml($marc21_marc8,'UTF-8','MARC21'), 'marc2marcxml - from MARC-8 to UTF-8 (MARC21)'); diff --git a/t/db_dependent/Search.t b/t/db_dependent/Search.t index 34d4e338ea..c4d7e73689 100644 --- a/t/db_dependent/Search.t +++ b/t/db_dependent/Search.t @@ -94,6 +94,12 @@ END { cleanup(); } +sub matchesExplodedTerms { + my ($message, $query, @terms) = @_; + my $match = '(' . join ('|', map { " \@attr 1=Subject \@attr 4=1 \"$_\"" } @terms) . "){" . scalar(@terms) . "}"; + like($query, qr/$match/, $message); +} + our $QueryStemming = 0; our $QueryAutoTruncate = 0; our $QueryWeightFields = 0; diff --git a/t/db_dependent/Serials.t b/t/db_dependent/Serials.t index 53bfed49e1..53c697e2d0 100755 --- a/t/db_dependent/Serials.t +++ b/t/db_dependent/Serials.t @@ -47,7 +47,6 @@ my $bookseller = Koha::Acquisition::Bookseller->new( my ($biblionumber, $biblioitemnumber) = AddBiblio(MARC::Record->new, ''); -my $budgetid; my $bpid = AddBudgetPeriod({ budget_period_startdate => '2015-01-01', budget_period_enddate => '2015-12-31', diff --git a/t/db_dependent/Serials_2.t b/t/db_dependent/Serials_2.t index ba91219b72..caf3d432b1 100644 --- a/t/db_dependent/Serials_2.t +++ b/t/db_dependent/Serials_2.t @@ -38,7 +38,6 @@ my ( $biblionumber, $biblioitemnumber ) = C4::Biblio::AddBiblio($record, ''); my $my_branch = $library1->{branchcode}; my $another_branch = $library2->{branchcode}; -my $budgetid; my $bpid = AddBudgetPeriod({ budget_period_startdate => '2015-01-01', budget_period_enddate => '2015-12-31', diff --git a/t/db_dependent/XISBN.t b/t/db_dependent/XISBN.t index d83419fb70..4cc939d28a 100755 --- a/t/db_dependent/XISBN.t +++ b/t/db_dependent/XISBN.t @@ -27,7 +27,6 @@ my $search_module = new Test::MockModule("Koha::SearchEngine::${engine}::Search" $search_module->mock('simple_search_compat', \&Mock_simple_search_compat ); -my $errors; my $context = C4::Context->new; my ( $biblionumber_tag, $biblionumber_subfield ) = diff --git a/t/db_dependent/cronjobs/advance_notices_digest.t b/t/db_dependent/cronjobs/advance_notices_digest.t index 7a61fe27ba..96024f6997 100644 --- a/t/db_dependent/cronjobs/advance_notices_digest.t +++ b/t/db_dependent/cronjobs/advance_notices_digest.t @@ -177,14 +177,10 @@ sub run_script { my $script = shift; local @ARGV = @_; - ## no critic - # We simulate script execution by evaluating the script code in the context # of this unit test. - eval $script; #Violates 'ProhibitStringyEval' - - ## use critic + eval $script; ## no critic (StringyEval) die $@ if $@; } diff --git a/t/db_dependent/www/auth_values_input_www.t b/t/db_dependent/www/auth_values_input_www.t index c4f10fc538..d5aa09765a 100644 --- a/t/db_dependent/www/auth_values_input_www.t +++ b/t/db_dependent/www/auth_values_input_www.t @@ -57,7 +57,6 @@ my $dbh = C4::Context->dbh; $intranet =~ s#/$##; my $agent = Test::WWW::Mechanize->new( autocheck => 1 ); -my $jsonresponse; my ($category, $expected_base, $add_form_link_exists, $delete_form_link_exists); # -------------------------------------------------- LOGIN diff --git a/t/dummy.t b/t/dummy.t index fcc57c3b3f..3eb62d4679 100755 --- a/t/dummy.t +++ b/t/dummy.t @@ -1,3 +1,4 @@ # Dummy test until Test::Harness or similar # is used by the other tests to check deps. +use Modern::Perl; print "1..1\nok 1\n"; diff --git a/tags/review.pl b/tags/review.pl index 43718fc408..a91435c1f4 100755 --- a/tags/review.pl +++ b/tags/review.pl @@ -36,7 +36,7 @@ use C4::Tags qw(get_tags get_approval_rows approval_counts whitelist blacklist i my $script_name = "/cgi-bin/koha/tags/review.pl"; my $needed_flags = { tools => 'moderate_tags' }; # FIXME: replace when more specific permission is created. -sub ajax_auth_cgi ($) { # returns CGI object +sub ajax_auth_cgi { # returns CGI object my $needed_flags = shift; my %cookies = CGI::Cookie->fetch; my $input = CGI->new; @@ -122,8 +122,8 @@ foreach (keys %$counts) { $template->param($_ => $counts->{$_}); } -sub pagination_calc ($;$) { - my $query = shift or return undef; +sub pagination_calc { + my $query = shift or return; my $hardlimit = (@_) ? shift : 100; # hardcoded, could be another syspref my $pagesize = $query->param('limit' ) || $hardlimit; my $page = $query->param('page' ) || 1; diff --git a/tools/batchMod.pl b/tools/batchMod.pl index 8b13257e5d..7a3ca2c021 100755 --- a/tools/batchMod.pl +++ b/tools/batchMod.pl @@ -82,7 +82,6 @@ $restrictededition = 0 if ($restrictededition != 0 && C4::Context->IsSuperLibrar $template->param(del => $del); -my $itemrecord; my $nextop=""; my @errors; # store errors found while checking data BEFORE saving item. my $items_display_hashref; @@ -391,7 +390,7 @@ foreach my $tag (sort keys %{$tagslib}) { $subfield_data{marc_lib} ="{$tag}->{$subfield}->{lib}."\">".$tagslib->{$tag}->{$subfield}->{lib}.""; $subfield_data{mandatory} = $tagslib->{$tag}->{$subfield}->{mandatory}; $subfield_data{repeatable} = $tagslib->{$tag}->{$subfield}->{repeatable}; - my ($x,$value); + my $value; if ( $use_default_values) { $value = $tagslib->{$tag}->{$subfield}->{defaultvalue}; # get today date & replace YYYY, MM, DD if provided in the default value diff --git a/tools/export.pl b/tools/export.pl index 97ff255da0..5ef531ae90 100755 --- a/tools/export.pl +++ b/tools/export.pl @@ -93,8 +93,6 @@ if ( $op eq "export" ) { my @biblionumbers = $query->multi_param("biblionumbers"); my @itemnumbers = $query->multi_param("itemnumbers"); my $strip_items_not_from_libraries = $query->param('strip_items_not_from_libraries'); - my @sql_params; - my $sql_query; my $libraries = Koha::Libraries->search_filtered->unblessed; my $only_export_items_for_branches = $strip_items_not_from_libraries ? \@branch : undef; diff --git a/tools/import_borrowers.pl b/tools/import_borrowers.pl index f2b72c2477..1b5e44f1ea 100755 --- a/tools/import_borrowers.pl +++ b/tools/import_borrowers.pl @@ -58,7 +58,6 @@ use Text::CSV; use CGI qw ( -utf8 ); -my ( @errors, @feedback ); my $extended = C4::Context->preference('ExtendedPatronAttributes'); my @columnkeys = map { $_ ne 'borrowernumber' ? $_ : () } Koha::Patrons->columns(); @@ -67,8 +66,6 @@ push( @columnkeys, qw( relationship guarantor_id guarantor_firstname guarantor_ my $input = CGI->new(); -#push @feedback, {feedback=>1, name=>'backend', value=>$csv->backend, backend=>$csv->backend}; #XXX - my ( $template, $loggedinuser, $cookie ) = get_template_and_user( { template_name => "tools/import_borrowers.tt", diff --git a/tools/letter.pl b/tools/letter.pl index 6044243c09..a0e2d373e4 100755 --- a/tools/letter.pl +++ b/tools/letter.pl @@ -191,7 +191,7 @@ sub add_form { code => $code, ); my $first_flag_name = 1; - my ( $lang, @templates ); + my $lang; # The letter name is contained into each mtt row. # So we can only sent the first one to the template. for my $letter ( @$letters ) { diff --git a/tools/modborrowers.pl b/tools/modborrowers.pl index 6c53a23912..8043532145 100755 --- a/tools/modborrowers.pl +++ b/tools/modborrowers.pl @@ -63,10 +63,9 @@ if ( $op eq 'show' ) { my $patron_list_id = $input->param('patron_list_id'); my @borrowers; my @cardnumbers; - my ( @notfoundcardnumbers, @from_another_group_of_libraries ); + my @notfoundcardnumbers; # Get cardnumbers from a file or the input area - my @contentlist; if ($filefh) { while ( my $content = <$filefh> ) { $content =~ s/[\r\n]*$//g; diff --git a/tools/overduerules.pl b/tools/overduerules.pl index da028152c2..ecfac84795 100755 --- a/tools/overduerules.pl +++ b/tools/overduerules.pl @@ -215,8 +215,6 @@ my $letters = C4::Letters::GetLettersAvailableForALibrary( } ); -my @line_loop; - my $message_transport_types = C4::Letters::GetMessageTransportTypes(); my ( @first, @second, @third ); for my $patron_category (@patron_categories) { diff --git a/tools/picture-upload.pl b/tools/picture-upload.pl index e349f5a432..c114a86a32 100755 --- a/tools/picture-upload.pl +++ b/tools/picture-upload.pl @@ -219,7 +219,8 @@ sub handle_dir { if ( $filename =~ m/datalink\.txt/i || $filename =~ m/idlink\.txt/i ); } - unless ( open( FILE, $file ) ) { + my $fh; + unless ( open( $fh, '<', $file ) ) { warn "Opening $dir/$file failed!"; $direrrors{'OPNLINK'} = $file; # This error is fatal to the import of this directory contents @@ -227,7 +228,7 @@ sub handle_dir { return \%direrrors; } - while ( my $line = ) { + while ( my $line = <$fh> ) { $debug and warn "Reading contents of $file"; chomp $line; $debug and warn "Examining line: $line"; @@ -247,7 +248,7 @@ sub handle_dir { $source = "$dir/$filename"; %counts = handle_file( $cardnumber, $source, $template, %counts ); } - close FILE; + close $fh; closedir DIR; } else { @@ -290,9 +291,9 @@ sub handle_file { return %count; } my ( $srcimage, $image ); - if ( open( IMG, "$source" ) ) { - $srcimage = GD::Image->new(*IMG); - close(IMG); + if ( open( my $fh, '<', $source ) ) { + $srcimage = GD::Image->new($fh); + close($fh); if ( defined $srcimage ) { my $imgfile; my $mimetype = 'image/png'; @@ -343,7 +344,6 @@ sub handle_file { undef $srcimage; # This object can get big... } $debug and warn "Image is of mimetype $mimetype"; - my $dberror; if ($mimetype) { my $patron = Koha::Patrons->find({ cardnumber => $cardnumber }); if ( $patron ) { diff --git a/tools/upload-cover-image.pl b/tools/upload-cover-image.pl index ff89afb1d6..1d2922c112 100755 --- a/tools/upload-cover-image.pl +++ b/tools/upload-cover-image.pl @@ -132,8 +132,8 @@ if ($fileID) { else { next; } - if ( open( FILE, $file ) ) { - while ( my $line = ) { + if ( open( my $fh, '<', $file ) ) { + while ( my $line = <$fh> ) { my $delim = ( $line =~ /\t/ ) ? "\t" : ( $line =~ /,/ ) ? "," @@ -171,7 +171,7 @@ if ($fileID) { undef $srcimage; } } - close(FILE); + close($fh); } else { $error = 'OPNLINK'; diff --git a/xt/author/show-template-structure.pl b/xt/author/show-template-structure.pl index 6c234875bc..ad496db474 100755 --- a/xt/author/show-template-structure.pl +++ b/xt/author/show-template-structure.pl @@ -56,7 +56,7 @@ Output is sent to STDOUT. scalar(@ARGV) == 1 or die "Usage: $0 template-file\n"; my $file = $ARGV[0]; -open IN, $file or die "Failed to open template file $file: $!\n"; +open my $fh, '<', $file or die "Failed to open template file $file: $!\n"; my %valid_tmpl_tags = ( tmpl_var => 1, @@ -87,7 +87,7 @@ sub emit { print " " x ( $level - 1 ), shift; } -while () { +while (<$fh>) { $lineno++; # look for TMPL_IF, TMPL_ELSE, TMPL_UNLESS, and TMPL_LOOPs in HTML comments @@ -147,7 +147,7 @@ while () { } } -close IN; +close $fh; # anything left in the stack? if (scalar @tag_stack > 0) { diff --git a/xt/author/translatable-templates.t b/xt/author/translatable-templates.t index b3ef5ff445..bc4cd1501f 100644 --- a/xt/author/translatable-templates.t +++ b/xt/author/translatable-templates.t @@ -69,7 +69,7 @@ sub test_string_extraction { my $command = "PERL5LIB=\$PERL5LIB:$misc_translator_dir ./tmpl_process3.pl create -i $template_dir -s $po_dir/$module.po -r --pedantic-warnings"; - open (NULL, ">", File::Spec->devnull); + open (NULL, ">", File::Spec->devnull); ## no critic (BarewordFileHandles) print NULL "foo"; # avoid warning; my $pid = open3(gensym, ">&NULL", \*PH, $command); my @warnings; diff --git a/xt/find-license-problems.t b/xt/find-license-problems.t index de89e931ca..50e607edea 100755 --- a/xt/find-license-problems.t +++ b/xt/find-license-problems.t @@ -42,10 +42,10 @@ sub wanted { find({ wanted => \&wanted, no_chdir => 1 }, File::Spec->curdir()); foreach my $name (@files) { - open( FILE, $name ) || die "cannot open file $name $!"; + open( my $fh, '<', $name ) || die "cannot open file $name $!"; my ( $hascopyright, $hasgpl, $hasv3, $hasorlater, $haslinktolicense, $hasfranklinst, $is_not_us ) = (0)x7; - while ( my $line = ) { + while ( my $line = <$fh> ) { $hascopyright = 1 if ( $line =~ /^(#|--)?\s*Copyright.*\d\d/ ); $hasgpl = 1 if ( $line =~ /GNU General Public License/ ); $hasv3 = 1 if ( $line =~ /either version 3/ ); @@ -56,6 +56,7 @@ foreach my $name (@files) { $hasfranklinst = 1 if ( $line =~ /51 Franklin Street/ ); $is_not_us = 1 if $line =~ m|This file is part of the Zebra server|; } + close $fh; next unless $hascopyright; next if $is_not_us; is( $hasgpl diff --git a/xt/fix-old-fsf-address b/xt/fix-old-fsf-address index 38b692b160..b0c7c001b6 100755 --- a/xt/fix-old-fsf-address +++ b/xt/fix-old-fsf-address @@ -112,19 +112,19 @@ sub dashcomment { sub readfile { my ($filename) = @_; - open(FILE, $filename) || die("Can't open $filename for reading"); + open(my $fh, '<', $filename) || die("Can't open $filename for reading"); my @lines; - while (my $line = ) { + while (my $line = <$fh>) { push @lines, $line; } - close(FILE); + close($fh); return join '', @lines; } sub try_to_fix { my ($data, @patterns) = @_; - return undef; + return; } diff --git a/xt/single_quotes.t b/xt/single_quotes.t index 4c6a9e8cd0..402b51cc64 100755 --- a/xt/single_quotes.t +++ b/xt/single_quotes.t @@ -42,7 +42,7 @@ close $dh; my @files; find( sub { - open my $fh, $_ or die "Could not open $_: $!"; + open my $fh, '<', $_ or die "Could not open $_: $!"; my @lines = sort grep /\_\(\'/, <$fh>; push @files, { name => "$_", lines => \@lines } if @lines; }, -- 2.20.1