[Koha-patches] [PATCH 1/2] Bug 6679 Fix scripts in admin & acqui to pass Perl::Critic
Frédéric Demians
f.demians at tamil.fr
Sat Sep 17 08:06:12 CEST 2011
From: Chris Cormack <chrisc at catalyst.net.nz>
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
---
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 0b9d860..46d05dd 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 0846603..5dbae17 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 "<h1>Invalid PDF Format set</h1>";
+ 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 e99eeb0..6361125 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;
+ at 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 c26f3a9..d7872d6 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 d523c75..f4d1823 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 65f2288..bc7a3cd 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} ) {
--
1.7.6.1
More information about the Koha-patches
mailing list