From 7cdea5de355e853f25300821cc641672443177de Mon Sep 17 00:00:00 2001 From: Chris Cormack Date: Mon, 8 Aug 2011 20:29:05 +1200 Subject: [PATCH] Bug 6679 Fix scripts in admin & acqui to pass Perl::Critic MIME-Version: 1.0 Content-Type: text/plain; charset=utf8 Content-Transfer-Encoding: 8bit Scripts in admin & acqui subdirectores weren't passing t/00-testcritic.t. This patch add admin & acqui scripts to test case and fix various errors related to Perl::Critic compliancy. - Fixing a style error to pass Perl::Critic, plus silencing a warn - More style errors, plus fixing a security issue - Explicitly using Carp Contrary to common belief, subroutine prototypes do not enable compile-time checks for proper arguments. Don't use them. Defining a named sub within another sub, does not prevent that subroutine being global Signed-off-by: Frédéric Demians Signed-off-by: Chris Cormack --- acqui/addorderiso2709.pl | 19 ++++++++++++++++--- acqui/basketgroup.pl | 36 +++++++++++++++++++++++++++++++----- acqui/neworderempty.pl | 3 ++- admin/authorised_values.pl | 2 +- admin/preferences.pl | 19 +++++++++---------- t/00-testcritic.t | 2 +- 6 files changed, 60 insertions(+), 21 deletions(-) diff --git a/acqui/addorderiso2709.pl b/acqui/addorderiso2709.pl index 0b9d860f3f..46d05ddaad 100755 --- a/acqui/addorderiso2709.pl +++ b/acqui/addorderiso2709.pl @@ -24,6 +24,7 @@ use strict; use warnings; use CGI; +use Carp; use Number::Format qw(:all); use C4::Context; @@ -210,8 +211,20 @@ if ($op eq ""){ } if ($price){ $orderinfo{'listprice'} = $price; - eval "use C4::Acquisition qw/GetBasket/;"; - eval "use C4::Bookseller qw/GetBookSellerFromId/;"; + eval { + require C4::Acquisition; + import C4::Acquisition qw/GetBasket/; + }; + if ($@){ + croak $@; + } + eval { + require C4::Bookseller; + import C4::Bookseller qw/GetBookSellerFromId/; + }; + if ($@){ + croak $@; + } my $basket = GetBasket( $orderinfo{basketno} ); my $bookseller = GetBookSellerFromId( $basket->{booksellerid} ); my $gst = $bookseller->{gstrate} || C4::Context->preference("gist") || 0; @@ -265,7 +278,7 @@ my $budget = GetBudget($budget_id); # build budget list my $budget_loop = []; -my $budgets = GetBudgetHierarchy( q{}, $borrower->{branchcode}, $borrower->{borrowernumber} ); +$budgets = GetBudgetHierarchy( q{}, $borrower->{branchcode}, $borrower->{borrowernumber} ); foreach my $r ( @{$budgets} ) { if ( !defined $r->{budget_amount} || $r->{budget_amount} == 0 ) { next; diff --git a/acqui/basketgroup.pl b/acqui/basketgroup.pl index 0846603933..5dbae17963 100755 --- a/acqui/basketgroup.pl +++ b/acqui/basketgroup.pl @@ -45,6 +45,7 @@ The bookseller who we want to display the baskets (and basketgroups) of. use strict; use warnings; +use Carp; use C4::Input; use C4::Auth; @@ -184,9 +185,21 @@ sub printbasketgrouppdf{ my ($basketgroupid) = @_; my $pdfformat = C4::Context->preference("OrderPdfFormat"); - eval "use $pdfformat"; - # FIXME consider what would happen if $pdfformat does not - # contain the name of a valid Perl module. + if ($pdfformat eq 'pdfformat::layout3pages' || $pdfformat eq 'pdfformat::layout2pages'){ + eval { + require $pdfformat; + import $pdfformat; + }; + if ($@){ + } + } + else { + print $input->header; + print $input->start_html; # FIXME Should do a nicer page + print "

Invalid PDF Format set

"; + print "Please go to the systempreferences and set a valid pdfformat"; + exit; + } my $basketgroup = GetBasketgroup($basketgroupid); my $bookseller = GetBookSellerFromId($basketgroup->{'booksellerid'}); @@ -202,8 +215,20 @@ sub printbasketgrouppdf{ #isbn, itemtype, author, title, publishercode, quantity, listprice ecost discount gstrate my @ba_order; if ( $ord->{biblionumber} && $ord->{quantity}> 0 ) { - eval "use C4::Biblio"; - eval "use C4::Koha"; + eval { + require C4::Biblio; + import C4::Biblio; + }; + if ($@){ + croak $@; + } + eval { + require C4::Koha; + import C4::Koha; + }; + if ($@){ + croak $@; + } my $bib = GetBiblioData($ord->{biblionumber}); my $itemtypes = GetItemTypes(); if($ord->{isbn}){ @@ -246,6 +271,7 @@ sub printbasketgrouppdf{ ); my $pdf = printpdf($basketgroup, $bookseller, $baskets, \%orders, $bookseller->{gstrate} // C4::Context->preference("gist")) || die "pdf generation failed"; print $pdf; + } my $op = $input->param('op'); diff --git a/acqui/neworderempty.pl b/acqui/neworderempty.pl index e99eeb0d91..6361125eee 100755 --- a/acqui/neworderempty.pl +++ b/acqui/neworderempty.pl @@ -330,7 +330,8 @@ if (C4::Context->preference('AcqCreateItem') eq 'ordering' && !$ordernumber) { $template->param(items => \@itemloop); } # Get the item types list, but only if item_level_itype is YES. Otherwise, it will be in the item, no need to display it in the biblio -my @itemtypes = C4::ItemType->all unless C4::Context->preference('item-level_itypes'); +my @itemtypes; +@itemtypes = C4::ItemType->all unless C4::Context->preference('item-level_itypes'); # fill template $template->param( diff --git a/admin/authorised_values.pl b/admin/authorised_values.pl index c26f3a9ec5..d7872d649a 100755 --- a/admin/authorised_values.pl +++ b/admin/authorised_values.pl @@ -27,7 +27,7 @@ use C4::Koha; use C4::Output; -sub AuthorizedValuesForCategory ($) { +sub AuthorizedValuesForCategory { my ($searchstring) = shift or return; my $dbh = C4::Context->dbh; $searchstring=~ s/\'/\\\'/g; diff --git a/admin/preferences.pl b/admin/preferences.pl index d523c755b5..f4d1823eda 100755 --- a/admin/preferences.pl +++ b/admin/preferences.pl @@ -194,12 +194,6 @@ sub SearchPrefs { my %tab_files = _get_pref_files( $input ); our @terms = split( /\s+/, $searchfield ); - sub matches { - my ( $text ) = @_; - - return !grep( { $text !~ /$_/i } @terms ); - } - foreach my $tab_name ( keys %tab_files ) { my $data = GetTab( $input, $tab_name ); my $title = ( keys( %$data ) )[0]; @@ -209,7 +203,7 @@ sub SearchPrefs { my $matched_groups; while ( my ( $group_title, $contents ) = each %$tab ) { - if ( matches( $group_title ) ) { + if ( matches( $group_title, \@terms ) ) { $matched_groups->{$group_title} = $contents; next; } @@ -225,12 +219,12 @@ sub SearchPrefs { my ( undef, $LINES ) = TransformPrefsToHTML( $data, $searchfield ); return { search_jumped => 1, tab => $tab_name, tab_title => $title, LINES => $LINES }; - } elsif ( matches( $piece->{'pref'} ) ) { + } elsif ( matches( $piece->{'pref'}, \@terms) ) { $matched = 1; - } elsif ( ref( $piece->{'choices'} ) eq 'HASH' && grep( { $_ && matches( $_ ) } values( %{ $piece->{'choices'} } ) ) ) { + } elsif ( ref( $piece->{'choices'} ) eq 'HASH' && grep( { $_ && matches( $_, \@terms ) } values( %{ $piece->{'choices'} } ) ) ) { $matched = 1; } - } elsif ( matches( $piece ) ) { + } elsif ( matches( $piece, \@terms ) ) { $matched = 1; } last if ( $matched ); @@ -252,6 +246,11 @@ sub SearchPrefs { return @tabs; } +sub matches { + my ( $text, $terms ) = @_; + return !grep( { $text !~ /$_/i } @$terms ); +} + my $dbh = C4::Context->dbh; our $input = new CGI; diff --git a/t/00-testcritic.t b/t/00-testcritic.t index 65f2288c76..bc7a3cd7f0 100755 --- a/t/00-testcritic.t +++ b/t/00-testcritic.t @@ -16,7 +16,7 @@ my @all_koha_dirs = qw( acqui admin authorities basket C4 catalogue cataloguing labels members misc offline_circ opac patroncards reports reserve reviews rotating_collections serials sms suggestion t tags test tools virtualshelves); -my @dirs = qw( basket circ debian errors offline_circ reserve reviews rotating_collections +my @dirs = qw( acqui admin basket circ debian errors offline_circ reserve reviews rotating_collections serials sms virtualshelves ); if ( not $ENV{TEST_QA} ) { -- 2.39.5