From f2259a2354b503b824dfb94f2eb9bc8c31c457ff Mon Sep 17 00:00:00 2001 From: Colin Campbell Date: Sat, 9 Jun 2012 10:40:19 +0100 Subject: [PATCH] Bug 8216: Allow SIP modules to pass critic tests Add C4/SIP to perlcritic tests. Fix those issues that were generating perlcritic errors Signed-off-by: Stacey Walker Signed-off-by: Paul Poulain Signed-off-by: Chris Cormack Signed-off-by: Jared Camins-Esakov --- 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 | 4 ++-- 12 files changed, 40 insertions(+), 59 deletions(-) diff --git a/C4/SIP/ILS/Item.pm b/C4/SIP/ILS/Item.pm index 1e900bdaef..a379503694 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 95981fb227..c27beb4d92 100644 --- a/C4/SIP/ILS/Patron.pm +++ b/C4/SIP/ILS/Patron.pm @@ -42,7 +42,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); @@ -208,7 +208,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 { @@ -232,7 +235,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 617a4ebc5f..604aa2cc52 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 22abf657eb..f3fd47abd8 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 73acaa3456..950c6c6cf7 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 2e49bf7ed2..6551eee844 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 c6de11e464..86bf9e16ca 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 ed102c7b2e..6932000250 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('',) || 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 e0616ae0d2..662e24cfc7 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('',) || die $@ unless caller(); -} - 1; __END__ diff --git a/C4/SIP/Sip/MsgType.pm b/C4/SIP/Sip/MsgType.pm index fe4681538e..7da622c89b 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 0504d23c8c..d834c5b14d 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 6018502a40..d6280350ce 100755 --- a/t/00-testcritic.t +++ b/t/00-testcritic.t @@ -14,10 +14,10 @@ use English qw(-no_match_vars); my @all_koha_dirs = qw( acqui admin authorities basket C4 catalogue cataloguing circ debian errors labels members misc offline_circ opac patroncards reports reserve reviews rotating_collections -serials sms suggestion t tags test tools virtualshelves); +serials sms suggestion t tags test tools virtualshelves Koha); my @dirs = qw( acqui admin authorities basket catalogue cataloguing circ debian errors labels - offline_circ reserve reviews rotating_collections serials sms virtualshelves ); + members offline_circ reserve reviews rotating_collections serials sms virtualshelves Koha); if ( not $ENV{TEST_QA} ) { my $msg = 'Author test. Set $ENV{TEST_QA} to a true value to run'; -- 2.39.5