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.
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);
}
$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);
# 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 {
#
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;
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;
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;
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};
}
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});
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};
}
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);
return (($cksum + $shortsum) & 0xFFFF) == 0;
}
-{
- no warnings qw(once);
- eval join('',<main::DATA>) || die $@ unless caller();
- # FIXME: what the heck is this?
-}
-
1;
__END__
return $self->{listeners}->{$portstr};
}
-#
-# Testing
-#
-
-{
- no warnings qw(once);
- eval join('',<main::DATA>) || die $@ unless caller();
-}
-
1;
__END__
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;
}
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
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
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;
return;
}
-sub api_auth() {
+sub api_auth {
# AUTH
$ENV{REMOTE_USER} = $username;
my $query = CGI->new();
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';
projects / koha.git / commitdiff