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 <stacey@catalyst-eu.net>
Signed-off-by: Paul Poulain <paul.poulain@biblibre.com>

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);
 }

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;

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;

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;

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});

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};
 	}
 

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);

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__
 

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__
 

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

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();

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';