[Koha-patches] [PATCH] Bug 8216: Allow SIP modules to pass critic tests
Colin Campbell
colin.campbell at ptfs-europe.com
Sat Jun 9 12:44:10 CEST 2012
Add C4/SIP to perlcritic tests. Fix those issues that were
generating perlcritic errors
---
C4/SIP/ILS/Item.pm | 25 +++++++++++++------------
C4/SIP/ILS/Patron.pm | 9 ++++++---
C4/SIP/ILS/Transaction/Checkout.pm | 3 +--
C4/SIP/ILS/Transaction/Hold.pm | 3 +--
C4/SIP/ILS/Transaction/Renew.pm | 5 ++---
C4/SIP/ILS/Transaction/RenewAll.pm | 3 +--
C4/SIP/SIPServer.pm | 2 +-
C4/SIP/Sip/Checksum.pm | 6 ------
C4/SIP/Sip/Configuration.pm | 9 ---------
C4/SIP/Sip/MsgType.pm | 10 +++++-----
C4/SIP/t/SIPtest.pm | 20 ++++++++------------
t/00-testcritic.t | 2 +-
12 files changed, 39 insertions(+), 58 deletions(-)
diff --git a/C4/SIP/ILS/Item.pm b/C4/SIP/ILS/Item.pm
index 1e900bd..ef812e6 100644
--- a/C4/SIP/ILS/Item.pm
+++ b/C4/SIP/ILS/Item.pm
@@ -86,7 +86,7 @@ sub new {
if (! $item) {
syslog("LOG_DEBUG", "new ILS::Item('%s'): not found", $item_id);
warn "new ILS::Item($item_id) : No item '$item_id'.";
- return undef;
+ return;
}
$item->{ 'itemnumber' } = $itemnumber;
$item->{ 'id' } = $item->{barcode}; # to SIP, the barcode IS the id.
@@ -347,25 +347,26 @@ sub available {
return 0;
}
-sub _barcode_to_borrowernumber ($) {
+sub _barcode_to_borrowernumber {
my $known = shift;
- (defined($known)) or return undef;
- my $member = GetMember(cardnumber=>$known) or return undef;
+ return unless defined $known;
+ my $member = GetMember(cardnumber=>$known) or return;
return $member->{borrowernumber};
}
-sub barcode_is_borrowernumber ($$$) { # because hold_queue only has borrowernumber...
+sub barcode_is_borrowernumber { # because hold_queue only has borrowernumber...
my $self = shift; # not really used
my $barcode = shift;
- my $number = shift or return undef; # can't be zero
- (defined($barcode)) or return undef; # might be 0 or 000 or 000000
- my $converted = _barcode_to_borrowernumber($barcode) or return undef;
- return ($number eq $converted); # even though both *should* be numbers, eq is safer.
+ my $number = shift or return; # can't be zero
+ return unless defined $barcode; # might be 0 or 000 or 000000
+ my $converted = _barcode_to_borrowernumber($barcode);
+ return unless $converted;
+ return ($number == $converted);
}
-sub fill_reserve ($$) {
+sub fill_reserve {
my $self = shift;
- my $hold = shift or return undef;
+ my $hold = shift or return;
foreach (qw(biblionumber borrowernumber reservedate)) {
- $hold->{$_} or return undef;
+ $hold->{$_} or return;
}
return ModReserveFill($hold);
}
diff --git a/C4/SIP/ILS/Patron.pm b/C4/SIP/ILS/Patron.pm
index 99fd6e7..005c524 100644
--- a/C4/SIP/ILS/Patron.pm
+++ b/C4/SIP/ILS/Patron.pm
@@ -41,7 +41,7 @@ sub new {
$debug and warn "new Patron (GetMember): " . Dumper($kp);
unless (defined $kp) {
syslog("LOG_DEBUG", "new ILS::Patron(%s): no such patron", $patron_id);
- return undef;
+ return;
}
$kp = GetMemberDetails(undef,$patron_id);
$debug and warn "new Patron (GetMemberDetails): " . Dumper($kp);
@@ -207,7 +207,10 @@ sub check_password {
# A few special cases, not in AUTOLOADed %fields
sub fee_amount {
my $self = shift;
- return $self->{fines} || undef;
+ if ( $self->{fines} ) {
+ return $self->{fines};
+ }
+ return;
}
sub fines_amount {
@@ -231,7 +234,7 @@ sub expired {
#
sub drop_hold {
my ($self, $item_id) = @_;
- $item_id or return undef;
+ return if !$item_id;
my $result = 0;
foreach (qw(hold_items unavail_holds)) {
$self->{$_} or next;
diff --git a/C4/SIP/ILS/Transaction/Checkout.pm b/C4/SIP/ILS/Transaction/Checkout.pm
index d483e16..026f778 100644
--- a/C4/SIP/ILS/Transaction/Checkout.pm
+++ b/C4/SIP/ILS/Transaction/Checkout.pm
@@ -38,8 +38,7 @@ my %fields = (
sub new {
my $class = shift;;
my $self = $class->SUPER::new();
- my $element;
- foreach $element (keys %fields) {
+ foreach my $element (keys %fields) {
$self->{_permitted}->{$element} = $fields{$element};
}
@{$self}{keys %fields} = values %fields;
diff --git a/C4/SIP/ILS/Transaction/Hold.pm b/C4/SIP/ILS/Transaction/Hold.pm
index 22abf65..6900ef8 100644
--- a/C4/SIP/ILS/Transaction/Hold.pm
+++ b/C4/SIP/ILS/Transaction/Hold.pm
@@ -29,8 +29,7 @@ my %fields = (
sub new {
my $class = shift;
my $self = $class->SUPER::new();
- my $element;
- foreach $element (keys %fields) {
+ foreach my $element (keys %fields) {
$self->{_permitted}->{$element} = $fields{$element};
}
@{$self}{keys %fields} = values %fields;
diff --git a/C4/SIP/ILS/Transaction/Renew.pm b/C4/SIP/ILS/Transaction/Renew.pm
index d7f949b..5d9bfb2 100644
--- a/C4/SIP/ILS/Transaction/Renew.pm
+++ b/C4/SIP/ILS/Transaction/Renew.pm
@@ -22,9 +22,8 @@ my %fields = (
sub new {
my $class = shift;
my $self = $class->SUPER::new();
- my $element;
- foreach $element (keys %fields) {
+ foreach my $element (keys %fields) {
$self->{_permitted}->{$element} = $fields{$element};
}
@@ -32,7 +31,7 @@ sub new {
return bless $self, $class;
}
-sub do_renew_for ($$) {
+sub do_renew_for {
my $self = shift;
my $borrower = shift;
my ($renewokay,$renewerror) = CanBookBeRenewed($borrower->{borrowernumber},$self->{item}->{itemnumber});
diff --git a/C4/SIP/ILS/Transaction/RenewAll.pm b/C4/SIP/ILS/Transaction/RenewAll.pm
index 10fb27d..bd92415 100644
--- a/C4/SIP/ILS/Transaction/RenewAll.pm
+++ b/C4/SIP/ILS/Transaction/RenewAll.pm
@@ -23,9 +23,8 @@ my %fields = (
sub new {
my $class = shift;
my $self = $class->SUPER::new();
- my $element;
- foreach $element (keys %fields) {
+ foreach my $element (keys %fields) {
$self->{_permitted}->{$element} = $fields{$element};
}
diff --git a/C4/SIP/SIPServer.pm b/C4/SIP/SIPServer.pm
index c6de11e..86bf9e1 100644
--- a/C4/SIP/SIPServer.pm
+++ b/C4/SIP/SIPServer.pm
@@ -161,7 +161,7 @@ sub raw_transport {
syslog("LOG_INFO", "raw_transport: shutting down");
}
-sub get_clean_string ($) {
+sub get_clean_string {
my $string = shift;
if (defined $string) {
syslog("LOG_DEBUG", "get_clean_string pre-clean(length %s): %s", length($string), $string);
diff --git a/C4/SIP/Sip/Checksum.pm b/C4/SIP/Sip/Checksum.pm
index ed102c7..6932000 100644
--- a/C4/SIP/Sip/Checksum.pm
+++ b/C4/SIP/Sip/Checksum.pm
@@ -36,12 +36,6 @@ sub verify_cksum {
return (($cksum + $shortsum) & 0xFFFF) == 0;
}
-{
- no warnings qw(once);
- eval join('',<main::DATA>) || die $@ unless caller();
- # FIXME: what the heck is this?
-}
-
1;
__END__
diff --git a/C4/SIP/Sip/Configuration.pm b/C4/SIP/Sip/Configuration.pm
index e0616ae..662e24c 100644
--- a/C4/SIP/Sip/Configuration.pm
+++ b/C4/SIP/Sip/Configuration.pm
@@ -80,15 +80,6 @@ sub find_service {
return $self->{listeners}->{$portstr};
}
-#
-# Testing
-#
-
-{
- no warnings qw(once);
- eval join('',<main::DATA>) || die $@ unless caller();
-}
-
1;
__END__
diff --git a/C4/SIP/Sip/MsgType.pm b/C4/SIP/Sip/MsgType.pm
index c3914c0..1cfb67e 100644
--- a/C4/SIP/Sip/MsgType.pm
+++ b/C4/SIP/Sip/MsgType.pm
@@ -293,11 +293,11 @@ sub new {
if (!exists($handlers{$msgtag})) {
syslog("LOG_WARNING", "new Sip::MsgType: Skipping message of unknown type '%s' in '%s'",
$msgtag, $msg);
- return(undef);
+ return;
} elsif (!exists($handlers{$msgtag}->{protocol}->{$protocol_version})) {
syslog("LOG_WARNING", "new Sip::MsgType: Skipping message '%s' unsupported by protocol rev. '%d'",
$msgtag, $protocol_version);
- return(undef);
+ return;
}
bless $self, $class;
@@ -405,7 +405,7 @@ sub handle {
}
unless ($self->{handler}) {
syslog("LOG_WARNING", "No handler defined for '%s'", $msg);
- return undef;
+ return;
}
return($self->{handler}->($self, $server)); # FIXME
# FIXME: Use of uninitialized value in subroutine entry
@@ -794,8 +794,8 @@ sub handle_request_acs_resend {
return REQUEST_ACS_RESEND;
}
-sub login_core ($$$) {
- my $server = shift or return undef;
+sub login_core {
+ my $server = shift or return;
my $uid = shift;
my $pwd = shift;
my $status = 1; # Assume it all works
diff --git a/C4/SIP/t/SIPtest.pm b/C4/SIP/t/SIPtest.pm
index 0504d23..df2dcd7 100644
--- a/C4/SIP/t/SIPtest.pm
+++ b/C4/SIP/t/SIPtest.pm
@@ -14,22 +14,18 @@ BEGIN {
auth => [qw(&api_auth)],
basic => [qw($datepat $textpat $login_test $sc_status_test
$instid $instid2 $currency $server $username $password)],
+ # duplicate user1 and item1 as user2 and item2
+ # w/ tags like $user2_pin instead of $user_pin
user1 => [qw($user_barcode $user_pin $user_fullname $user_homeaddr $user_email
$user_phone $user_birthday $user_ptype $user_inet)],
+ user2 => [qw($user2_barcode $user._pin $user2_fullname $user2_homeaddr $user2_email
+ $user2_phone $user2_birthday $user2_ptype $user2_inet)],
item1 => [qw($item_barcode $item_title $item_owner )],
+ item2 => [qw($item2_barcode $item2_title $item2_owner )],
+ # we've got item3_* also
+ item3 => [qw($item3_barcode $item3_title $item3_owner )],
diacritic => [qw($item_diacritic_barcode $item_diacritic_title $item_diacritic_owner)],
);
- # duplicate user1 and item1 as user2 and item2
- # w/ tags like $user2_pin instead of $user_pin
- foreach my $tag (qw(user item)) {
- my @tags = @{$EXPORT_TAGS{$tag.'1'}}; # fresh array avoids side affect in map
- push @{$EXPORT_TAGS{$tag.'2'}}, map {s/($tag)\_/${1}2_/;$_} @tags;
- }
- # we've got item3_* also
- foreach my $tag (qw(item)) {
- my @tags = @{$EXPORT_TAGS{$tag.'1'}}; # fresh array avoids side affect in map
- push @{$EXPORT_TAGS{$tag.'3'}}, map {s/($tag)\_/${1}3_/;$_} @tags;
- }
# From perldoc Exporter
# Add all the other ":class" tags to the ":all" class, deleting duplicates
my %seen;
@@ -241,7 +237,7 @@ sub one_msg {
return;
}
-sub api_auth() {
+sub api_auth {
# AUTH
$ENV{REMOTE_USER} = $username;
my $query = CGI->new();
diff --git a/t/00-testcritic.t b/t/00-testcritic.t
index d628035..caa95d6 100755
--- a/t/00-testcritic.t
+++ b/t/00-testcritic.t
@@ -17,7 +17,7 @@ labels members misc offline_circ opac patroncards reports reserve reviews rotati
serials sms suggestion t tags test tools virtualshelves Koha);
my @dirs = qw( acqui admin authorities basket catalogue cataloguing circ debian errors labels
- members offline_circ reserve reviews rotating_collections serials sms virtualshelves Koha);
+ 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';
--
1.7.11.rc0
More information about the Koha-patches
mailing list