gitea
/
Koha-clms
1
0
Fork 0
Code Issues Pull Requests Packages Projects Releases Wiki Activity

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>
This commit is contained in:
Colin Campbell 2012-06-09 10:40:19 +01:00 committed by Paul Poulain
parent 9dc42e9ec4
commit 9929c52a57
12 changed files with 39 additions and 58 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

25
C4/SIP/ILS/Item.pm
View File

@ -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
View File

@ -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
View File

@ -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
View File

@ -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
View File

@ -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
View File

@ -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
View File

@ -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
View File

@ -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
View File

@ -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
View File

@ -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
View File

@ -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
View File

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