Browse Source

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>
3.10.x
Colin Campbell 11 years ago
committed by Paul Poulain
parent
commit
9929c52a57
  1. 25
      C4/SIP/ILS/Item.pm
  2. 9
      C4/SIP/ILS/Patron.pm
  3. 3
      C4/SIP/ILS/Transaction/Checkout.pm
  4. 3
      C4/SIP/ILS/Transaction/Hold.pm
  5. 5
      C4/SIP/ILS/Transaction/Renew.pm
  6. 3
      C4/SIP/ILS/Transaction/RenewAll.pm
  7. 2
      C4/SIP/SIPServer.pm
  8. 6
      C4/SIP/Sip/Checksum.pm
  9. 9
      C4/SIP/Sip/Configuration.pm
  10. 10
      C4/SIP/Sip/MsgType.pm
  11. 20
      C4/SIP/t/SIPtest.pm
  12. 2
      t/00-testcritic.t

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

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

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

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

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

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

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

6
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__

9
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__

10
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

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

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

Loading…
Cancel
Save