From 4c42971c6e6ad67a715f6cb66eaa444f639f9642 Mon Sep 17 00:00:00 2001 From: "Joe Atzberger (siptest" Date: Wed, 4 Jun 2008 18:14:48 -0500 Subject: [PATCH] SIP abstraction layer implementation for ILS, Items and Patrons. Signed-off-by: Joshua Ferraro --- C4/SIP/ILS.pm | 211 +++++++++++---------------- C4/SIP/ILS/Item.pm | 131 +++++++++-------- C4/SIP/ILS/Patron.pm | 334 ++++++++++++++++++++++++------------------- 3 files changed, 337 insertions(+), 339 deletions(-) diff --git a/C4/SIP/ILS.pm b/C4/SIP/ILS.pm index 559c1ed6bc..14e36bab69 100644 --- a/C4/SIP/ILS.pm +++ b/C4/SIP/ILS.pm @@ -18,6 +18,8 @@ use ILS::Transaction::Hold; use ILS::Transaction::Renew; use ILS::Transaction::RenewAll; +my $debug = 0; + my %supports = ( 'magnetic media' => 1, 'security inhibit' => 0, @@ -36,49 +38,44 @@ my %supports = ( "patron enable" => 1, "hold" => 1, "renew" => 1, - "renew all" => 0, + "renew all" => 1, ); sub new { my ($class, $institution) = @_; my $type = ref($class) || $class; my $self = {}; -#use Data::Dumper; -#warn " INSTITUTION:"; -#warn Dumper($institution); + use Data::Dumper; + $debug and warn "new ILS: INSTITUTION: " . Dumper($institution); syslog("LOG_DEBUG", "new ILS '%s'", $institution->{id}); $self->{institution} = $institution; - return bless $self, $type; } sub find_patron { my $self = shift; -warn "finding patron"; + $debug and warn "ILS: finding patron"; return ILS::Patron->new(@_); } sub find_item { my $self = shift; -warn "find item"; + $debug and warn "ILS: finding item"; return ILS::Item->new(@_); } sub institution { my $self = shift; - return $self->{institution}->{id}; } sub supports { my ($self, $op) = @_; - return (exists($supports{$op}) && $supports{$op}); } sub check_inst_id { my ($self, $id, $whence) = @_; - if ($id ne $self->{institution}->{id}) { syslog("LOG_WARNING", "%s: received institution '%s', expected '%s'", $whence, $id, $self->{institution}->{id}); @@ -87,37 +84,33 @@ sub check_inst_id { sub to_bool { my $bool = shift; - # If it's defined, and matches a true sort of string, or is # a non-zero number, then it's true. + # + # FIXME: this test is faulty + # We're running under warnings and strict. + # But if we don't match regexp, then we go ahead and numerical compare? + # That means we'd generate a warning on 'FALSE' or ''. return defined($bool) && (($bool =~ /true|y|yes/i) || $bool != 0); } sub checkout_ok { my $self = shift; - return (exists($self->{policy}->{checkout}) && to_bool($self->{policy}->{checkout})); } - sub checkin_ok { my $self = shift; - return (exists($self->{policy}->{checkin}) && to_bool($self->{policy}->{checkin})); } - sub status_update_ok { my $self = shift; - return (exists($self->{policy}->{status_update}) && to_bool($self->{policy}->{status_update})); - } - sub offline_ok { my $self = shift; - return (exists($self->{policy}->{offline}) && to_bool($self->{policy}->{offline})); } @@ -168,10 +161,8 @@ sub checkout { } else { syslog("LOG_DEBUG", "ILS::Checkout Issue failed"); - } } - # END TRANSACTION return $circ; @@ -195,7 +186,6 @@ sub checkin { delete $item->{patron}; delete $item->{due_date}; $patron->{items} = [ grep {$_ ne $item_id} @{$patron->{items}} ]; - } # END TRANSACTION @@ -232,35 +222,27 @@ sub add_hold { my ($self, $patron_id, $patron_pwd, $item_id, $title_id, $expiry_date, $pickup_location, $hold_type, $fee_ack) = @_; my ($patron, $item); - my $hold; - my $trans; + my $trans = new ILS::Transaction::Hold; - $trans = new ILS::Transaction::Hold; - - # BEGIN TRANSACTION $patron = new ILS::Patron $patron_id; if (!$patron || (defined($patron_pwd) && !$patron->check_password($patron_pwd))) { - $trans->screen_msg("Invalid Patron."); - - return $trans; + $trans->screen_msg("Invalid Patron."); + return $trans; } - $item = new ILS::Item ($item_id || $title_id); - if (!$item) { - $trans->screen_msg("No such item."); - - # END TRANSACTION (conditionally) - return $trans; - } elsif ($item->fee && ($fee_ack ne 'Y')) { - $trans->screen_msg = "Fee required to place hold."; + unless ($item = new ILS::Item ($item_id || $title_id)) { + $trans->screen_msg("No such item."); + return $trans; + } - # END TRANSACTION (conditionally) - return $trans; + if ($item->fee and $fee_ack ne 'Y') { + $trans->screen_msg = "Fee required to place hold."; + return $trans; } - $hold = { + my $hold = { item_id => $item->id, patron_id => $patron->id, expiration_date => $expiry_date, @@ -272,68 +254,62 @@ sub add_hold { $trans->patron($patron); $trans->item($item); $trans->pickup_location($pickup_location); + $trans->do_hold; - push(@{$item->hold_queue}, $hold); + push(@{$item->hold_queue}, $hold); push(@{$patron->{hold_items}}, $hold); - - # END TRANSACTION return $trans; } sub cancel_hold { my ($self, $patron_id, $patron_pwd, $item_id, $title_id) = @_; my ($patron, $item, $hold); - my $trans; - $trans = new ILS::Transaction::Hold; + my $trans = new ILS::Transaction::Hold; - # BEGIN TRANSACTION $patron = new ILS::Patron $patron_id; if (!$patron) { - $trans->screen_msg("Invalid patron barcode."); - - return $trans; + $trans->screen_msg("Invalid patron barcode."); + return $trans; } elsif (defined($patron_pwd) && !$patron->check_password($patron_pwd)) { - $trans->screen_msg('Invalid patron password.'); - - return $trans; + $trans->screen_msg('Invalid patron password.'); + return $trans; } - $item = new ILS::Item ($item_id || $title_id); - if (!$item) { - $trans->screen_msg("No such item."); - - # END TRANSACTION (conditionally) - return $trans; + unless ($item = new ILS::Item ($item_id || $title_id)) { + $trans->screen_msg("No such item."); + return $trans; } + $trans->patron($patron); + $trans->item($item); + $trans->drop_hold; + unless ($trans->ok) { + $trans->screen_msg("Error with transaction drop_hold: " . $trans->screen_msg); + return $trans; + } # Remove the hold from the patron's record first - $trans->ok($patron->drop_hold($item_id)); - - if (!$trans->ok) { - # We didn't find it on the patron record - $trans->screen_msg("No such hold on patron record."); + $trans->ok($patron->drop_hold($item_id)); # different than the transaction drop! - # END TRANSACTION (conditionally) - return $trans; + unless ($trans->ok) { + # We didn't find it on the patron record + $trans->screen_msg("No such hold on patron record."); + return $trans; } # Now, remove it from the item record. If it was on the patron # record but not on the item record, we'll treat that as success. foreach my $i (0 .. scalar @{$item->hold_queue}) { - $hold = $item->hold_queue->[$i]; - - if ($hold->{patron_id} eq $patron->id) { - # found it: delete it. - splice @{$item->hold_queue}, $i, 1; - last; - } + $hold = $item->hold_queue->[$i]; + if ($hold->{patron_id} eq $patron->id) { + # found it: delete it. + splice @{$item->hold_queue}, $i, 1; + last; # ?? should we keep going, in case there are multiples + } } $trans->screen_msg("Hold Cancelled."); - $trans->patron($patron); - $trans->item($item); return $trans; } @@ -352,22 +328,21 @@ sub alter_hold { # BEGIN TRANSACTION $patron = new ILS::Patron $patron_id; - if (!$patron) { - $trans->screen_msg("Invalid patron barcode."); - - return $trans; + unless ($patron) { + $trans->screen_msg("Invalid patron barcode: '$patron_id'."); + return $trans; } foreach my $i (0 .. scalar @{$patron->{hold_items}}) { - $hold = $patron->{hold_items}[$i]; + $hold = $patron->{hold_items}[$i]; if ($hold->{item_id} eq $item_id) { # Found it. So fix it. - $hold->{expiration_date} = $expiry_date if $expiry_date; + $hold->{expiration_date} = $expiry_date if $expiry_date; $hold->{pickup_location} = $pickup_location if $pickup_location; - $hold->{hold_type} = $hold_type if $hold_type; - - $trans->ok(1); + $hold->{hold_type} = $hold_type if $hold_type; + $trans->change_hold(); + # $trans->ok(1); $trans->screen_msg("Hold updated."); $trans->patron($patron); $trans->item(new ILS::Item $hold->{item_id}); @@ -381,7 +356,7 @@ sub alter_hold { # the item, since it's already been updated by the patron code. if (!$trans->ok) { - $trans->screen_msg("No such outstanding hold."); + $trans->screen_msg("No such outstanding hold."); } return $trans; @@ -399,31 +374,33 @@ sub renew { if (!$patron) { $trans->screen_msg("Invalid patron barcode."); - return $trans; } elsif (!$patron->renew_ok) { $trans->screen_msg("Renewals not allowed."); - return $trans; } - if (defined($title_id)) { - # renewing a title, rather than an item (sort of) + # Previously: renewing a title, rather than an item (sort of) # This is gross, but in a real ILS it would be better + + # if (defined($title_id)) { + # foreach my $i (@{$patron->{items}}) { + # $item = new ILS::Item $i; + # last if ($title_id eq $item->title_id); + # $item = undef; + # } + # } else { + my $j = 0; + my $count = scalar @{$patron->{items}}; foreach my $i (@{$patron->{items}}) { - $item = new ILS::Item $i; - last if ($title_id eq $item->title_id); - $item = undef; - } - } else { - foreach my $i (@{$patron->{items}}) { - if ($i == $item_id) { + syslog("LOG_DEBUG", "checking item %s of %s: $item_id vs. %s", ++$j, $count, $i); + if ($i eq $item_id) { # We have it checked out $item = new ILS::Item $item_id; last; } } - } + # } $trans->item($item); @@ -431,13 +408,12 @@ sub renew { # It's not checked out to $patron_id $trans->screen_msg("Item not checked out to " . $patron->name); } elsif (!$item->available($patron_id)) { - $trans->screen_msg("Item has outstanding holds"); + $trans->screen_msg("Item unavailable due to outstanding holds"); } else { $trans->renewal_ok(1); - $trans->desensitize(0); # It's already checked out $trans->do_renew(); -# warn "done renew $trans->renewal_ok(1);"; + syslog("LOG_DEBUG", "done renew (%s): %s renews %s", $trans->renewal_ok(1),$patron_id,$item_id); # if ($no_block eq 'Y') { # $item->{due_date} = $nb_due_date; @@ -471,38 +447,21 @@ sub renew_all { } if (!defined($patron)) { - $trans->screen_msg("Invalid patron barcode."); - return $trans; + $trans->screen_msg("Invalid patron barcode."); + return $trans; } elsif (!$patron->renew_ok) { - $trans->screen_msg("Renewals not allowed."); - return $trans; + $trans->screen_msg("Renewals not allowed."); + return $trans; } elsif (defined($patron_pwd) && !$patron->check_password($patron_pwd)) { - $trans->screen_msg("Invalid patron password."); - return $trans; - } - - foreach $item_id (@{$patron->{items}}) { - my $item = new ILS::Item $item_id; - - if (!defined($item)) { - syslog("LOG_WARNING", - "renew_all: Invalid item id associated with patron '%s'", - $patron->id); - next; - } - - if (@{$item->hold_queue}) { - # Can't renew if there are outstanding holds - push @{$trans->unrenewed}, $item_id; - } else { - $item->{due_date} = time + (14*24*60*60); # two weeks hence - push @{$trans->renewed}, $item_id; - } + $trans->screen_msg("Invalid patron password."); + return $trans; } + $trans->do_renew_all; $trans->ok(1); - return $trans; } 1; +__END__ + diff --git a/C4/SIP/ILS/Item.pm b/C4/SIP/ILS/Item.pm index aac797760f..58d4b1085f 100644 --- a/C4/SIP/ILS/Item.pm +++ b/C4/SIP/ILS/Item.pm @@ -14,11 +14,24 @@ use Sys::Syslog qw(syslog); use ILS::Transaction; +use C4::Debug; +use C4::Context; use C4::Biblio; use C4::Items; use C4::Circulation; use C4::Members; +use C4::Reserves; +use vars qw($VERSION @ISA @EXPORT @EXPORT_OK); + +BEGIN { + $VERSION = 2.00; + require Exporter; + @ISA = qw(Exporter); + @EXPORT_OK = qw(); +} + +=doc our %item_db = ( '1565921879' => { title => "Perl 5 desktop reference", @@ -42,26 +55,35 @@ our %item_db = ( hold_queue => [], }, ); +=cut + +sub priority_sort { + defined $a->{priority} or return -1; + defined $b->{priority} or return 1; + return $a->{priority} <=> $b->{priority}; +} sub new { - my ($class, $item_id) = @_; - my $type = ref($class) || $class; - my $self; + my ($class, $item_id) = @_; + my $type = ref($class) || $class; + my $self; my $item = GetBiblioFromItemNumber( GetItemnumberFromBarcode($item_id) ); - if (! $item) { + if (! $item) { syslog("LOG_DEBUG", "new ILS::Item('%s'): not found", $item_id); - warn "no item $item_id"; + warn "new ILS::Item($item_id) : No item '$item_id'."; return undef; - } + } $item->{'id'} = $item->{'barcode'}; # check if its on issue and if so get the borrower my $issue = GetItemIssue($item->{'itemnumber'}); my $borrower = GetMember($issue->{'borrowernumber'},'borrowernumber'); $item->{patron} = $borrower->{'cardnumber'}; - $self = $item; - - bless $self, $type; + my @reserves = (@{ GetReservesFromBiblionumber($item->{biblionumber}) }); + $item->{hold_queue} = [ sort priority_sort @reserves ]; + $item->{joetest} = 111; + $self = $item; + bless $self, $type; syslog("LOG_DEBUG", "new ILS::Item('%s'): found with title '%s'", $item_id, $self->{title}); @@ -71,155 +93,132 @@ sub new { sub magnetic { my $self = shift; - return $self->{magnetic_media}; } - sub sip_media_type { my $self = shift; - return $self->{sip_media_type}; } - sub sip_item_properties { my $self = shift; - return $self->{sip_item_properties}; } sub status_update { my ($self, $props) = @_; my $status = new ILS::Transaction; - $self->{sip_item_properties} = $props; $status->{ok} = 1; - return $status; } - sub id { my $self = shift; - return $self->{id}; } - sub title_id { my $self = shift; - return $self->{title}; } - sub permanent_location { my $self = shift; - return $self->{permanent_location} || ''; } - sub current_location { my $self = shift; - return $self->{current_location} || ''; } sub sip_circulation_status { my $self = shift; - if ($self->{patron}) { - return '04'; + return '04'; } elsif (scalar @{$self->{hold_queue}}) { - return '08'; + return '08'; } else { - return '03'; + return '03'; } } sub sip_security_marker { return '02'; } - sub sip_fee_type { return '01'; } sub fee { my $self = shift; - return $self->{fee} || 0; } - sub fee_currency { my $self = shift; - - return $self->{currency} || 'CAD'; + return $self->{currency} || 'USD'; } - sub owner { my $self = shift; - - return 'UWOLS'; + return 'CPL'; # FIXME: UWOLS was hardcoded } - sub hold_queue { my $self = shift; - + (defined $self->{hold_queue}) or return []; return $self->{hold_queue}; } sub hold_queue_position { - my ($self, $patron_id) = @_; - my $i; - - for ($i = 0; $i < scalar @{$self->{hold_queue}}; $i += 1) { - if ($self->{hold_queue}[$i]->{patron_id} eq $patron_id) { - return $i + 1; + my ($self, $patron_id) = @_; + ($self->{hold_queue}) or return 0; + my $i = 0; + foreach (@{$self->{hold_queue}}) { + $i++; + $_->{patron_id} or next; + if ($_->{patron_id} eq $patron_id) { + return $i; + } } - } return 0; } sub due_date { my $self = shift; - return $self->{due_date} || 0; } - sub recall_date { my $self = shift; - return $self->{recall_date} || 0; } - sub hold_pickup_date { my $self = shift; - return $self->{hold_pickup_date} || 0; } - sub screen_msg { my $self = shift; - return $self->{screen_msg} || ''; } - sub print_line { - my $self = shift; - - return $self->{print_line} || ''; + my $self = shift; + return $self->{print_line} || ''; } -# An item is available for a patron if -# 1) It's not checked out and (there's no hold queue OR patron -# is at the front of the queue) +# An item is available for a patron if it is: +# 1) checked out to the same patron and there's no hold queue # OR -# 2) It's checked out to the patron and there's no hold queue +# 2) not checked out and (there's no hold queue OR patron +# is at the front of the queue) sub available { - my ($self, $for_patron) = @_; - - return ((!defined($self->{patron_id}) && (!scalar @{$self->{hold_queue}} - || ($self->{hold_queue}[0] eq $for_patron))) - || ($self->{patron_id} && ($self->{patron_id} eq $for_patron) - && !scalar @{$self->{hold_queue}})); + my ($self, $for_patron) = @_; + my $count = (defined $self->{hold_queue}) ? scalar @{$self->{hold_queue}} : 0; + print STDERR "availability check: hold_queue size $count\n"; + if (defined($self->{patron_id})) { + ($self->{patron_id} eq $for_patron) or return 0; + return ($count ? 0 : 1); + } else { # not checked out + ($count) or return 1; + ($self->{hold_queue}[0] eq $for_patron) and return 1; + } + return 0; } 1; +__END__ + diff --git a/C4/SIP/ILS/Patron.pm b/C4/SIP/ILS/Patron.pm index b536e2b4bc..84a05fc353 100644 --- a/C4/SIP/ILS/Patron.pm +++ b/C4/SIP/ILS/Patron.pm @@ -14,16 +14,25 @@ use Exporter; use Sys::Syslog qw(syslog); use Data::Dumper; +use C4::Debug; use C4::Context; +use C4::Dates; use C4::Koha; use C4::Members; +use C4::Reserves; use Digest::MD5 qw(md5_base64); -our (@ISA, @EXPORT_OK); +use vars qw($VERSION @ISA @EXPORT @EXPORT_OK); -@ISA = qw(Exporter); +BEGIN { + $VERSION = 2.00; + @ISA = qw(Exporter); + @EXPORT_OK = qw(invalid_patron); +} + +our $kp; # koha patron -@EXPORT_OK = qw(invalid_patron); +=doc our %patron_example = ( djfiander => { @@ -55,230 +64,273 @@ our %patron_example = ( unavail_holds => [], inet => 1, }, - ); + ); + +From borrowers table: ++---------------------+--------------+------+-----+ +| Field | Type | Null | Key | ++---------------------+--------------+------+-----+ +| borrowernumber | int(11) | NO | PRI | +| cardnumber | varchar(16) | YES | UNI | +| surname | mediumtext | NO | | +| firstname | text | YES | | +| title | mediumtext | YES | | +| othernames | mediumtext | YES | | +| initials | text | YES | | +| streetnumber | varchar(10) | YES | | +| streettype | varchar(50) | YES | | +| address | mediumtext | NO | | +| address2 | text | YES | | +| city | mediumtext | NO | | +| zipcode | varchar(25) | YES | | +| email | mediumtext | YES | | +| phone | text | YES | | +| mobile | varchar(50) | YES | | +| fax | mediumtext | YES | | +| emailpro | text | YES | | +| phonepro | text | YES | | +| B_streetnumber | varchar(10) | YES | | +| B_streettype | varchar(50) | YES | | +| B_address | varchar(100) | YES | | +| B_city | mediumtext | YES | | +| B_zipcode | varchar(25) | YES | | +| B_email | text | YES | | +| B_phone | mediumtext | YES | | +| dateofbirth | date | YES | | +| branchcode | varchar(10) | NO | MUL | +| categorycode | varchar(10) | NO | MUL | +| dateenrolled | date | YES | | +| dateexpiry | date | YES | | +| gonenoaddress | tinyint(1) | YES | | +| lost | tinyint(1) | YES | | +| debarred | tinyint(1) | YES | | +| contactname | mediumtext | YES | | +| contactfirstname | text | YES | | +| contacttitle | text | YES | | +| guarantorid | int(11) | YES | | +| borrowernotes | mediumtext | YES | | +| relationship | varchar(100) | YES | | +| ethnicity | varchar(50) | YES | | +| ethnotes | varchar(255) | YES | | +| sex | varchar(1) | YES | | +| password | varchar(30) | YES | | +| flags | int(11) | YES | | +| userid | varchar(30) | YES | MUL | +| opacnote | mediumtext | YES | | +| contactnote | varchar(255) | YES | | +| sort1 | varchar(80) | YES | | +| sort2 | varchar(80) | YES | | +| altcontactfirstname | varchar(255) | YES | | +| altcontactsurname | varchar(255) | YES | | +| altcontactaddress1 | varchar(255) | YES | | +| altcontactaddress2 | varchar(255) | YES | | +| altcontactaddress3 | varchar(255) | YES | | +| altcontactzipcode | varchar(50) | YES | | +| altcontactphone | varchar(50) | YES | | ++---------------------+--------------+------+-----+ + +From C4::Members + +$flags->{KEY} +{CHARGES} + {message} Message showing patron's credit or debt + {noissues} Set if patron owes >$5.00 +{GNA} Set if patron gone w/o address + {message} "Borrower has no valid address" + {noissues} Set. +{LOST} Set if patron's card reported lost + {message} Message to this effect + {noissues} Set. +{DBARRED} Set if patron is debarred + {message} Message to this effect + {noissues} Set. +{NOTES} Set if patron has notes + {message} Notes about patron +{ODUES} Set if patron has overdue books + {message} "Yes" + {itemlist} ref-to-array: list of overdue books + {itemlisttext} Text list of overdue items +{WAITING} Set if there are items available that the patron reserved + {message} Message to this effect + {itemlist} ref-to-array: list of available items + +=cut sub new { - my ($class, $patron_id) = @_; + my ($class, $patron_id) = @_; my $type = ref($class) || $class; my $self; - my %ilspatron; - my $kp = GetMember($patron_id,'cardnumber'); -# use Data::Dumper; -# warn Dumper($kp); - if ($kp) { - my $pw = $kp->{password}; ## FIXME - md5hash -- deal with . - my $dob= $kp->{dateofbirth}; - $dob =~ s/\-//g; - my $fines_out = GetMemberAccountRecords($kp->{borrowernumber}); - my ($num_cur_issues,$cur_issues) = GetPendingIssues($kp->{borrowernumber}); - my $debarred = $kp->{debarred}; ### 1 if ($kp->{flags}->{DBARRED}->{noissues}); -# warn "i am debarred: $debarred"; -#warn Dumper(%{$kp->{flags}}); - my $adr = $kp->{streetnumber} . " ". $kp->{address}; - %ilspatron = ( - name => $kp->{firstname} . " " . $kp->{surname}, - id => $kp->{cardnumber}, - password => $pw, - ptype => $kp->{categorycode}, # 'A'dult. Whatever. - birthdate => $kp->{dateofbirth}, ##$dob, - address => $adr, - home_phone => $kp->{phone}, - email_addr => $kp->{email}, - charge_ok => (!$debarred) , ## (C4::Context->preference('FinesMode') eq 'charge') || 0, - renew_ok => 1, - recall_ok => 1, - hold_ok => 1, - card_lost => ($kp->{lost} || $kp->{gonenoaddress}) , - claims_returned => 0, - fines => $fines_out, - fees => 0, - recall_overdue => 0, - items_billed => 0, - screen_msg => 'Greetings from Koha', - print_line => '', - items => ['one item','itemstring 2'] , - hold_items => [],#$kp->{flags}->{WAITING}{itemlist}->{biblionumber}, - overdue_items =>[], # [$kp->{flags}->{ODUES}{itemlisttext}], ### FIXME -> this should be array, not texts string. - fine_items => [], - recall_items => [], - unavail_holds => [], - inet => '', - ); - } else { + $kp = GetMember($patron_id,'cardnumber'); + $debug and warn "new Patron: " . Dumper($kp); + unless (defined $kp) { syslog("LOG_DEBUG", "new ILS::Patron(%s): no such patron", $patron_id); return undef; - } - - $self = \%ilspatron; -# warn Dumper($self); - + } + my $pw = $kp->{password}; ## FIXME - md5hash -- deal with . + my $dob= $kp->{dateofbirth}; + my $fines_out = GetMemberAccountRecords($kp->{borrowernumber}); + my ($num_cur_issues,$cur_issues) = GetPendingIssues($kp->{borrowernumber}); + my $flags = $kp->{flags}; # or warn "Warning: No flags from patron object for '$patron_id'"; + my $debarred = $kp->{debarred}; ### 1 if ($kp->{flags}->{DBARRED}->{noissues}); + $debug and warn "Debarred: $debarred = " . Dumper(%{$kp->{flags}}); + my %ilspatron; + my $adr = $kp->{streetnumber} || ''; + my $address = $kp->{address} || ''; + $adr .= ($adr && $address) ? " $address" : $address; + { + no warnings; # any of these $kp->{fields} being concat'd could be undef + $dob =~ s/\-//g; + %ilspatron = ( + name => $kp->{firstname} . " " . $kp->{surname}, + id => $kp->{cardnumber}, + password => $pw, + ptype => $kp->{categorycode}, # 'A'dult. Whatever. + birthdate => $kp->{dateofbirth}, ##$dob, + branchcode => $kp->{branchcode}, + address => $adr, + home_phone => $kp->{phone}, + email_addr => $kp->{email}, + charge_ok => (!$debarred), ## (C4::Context->preference('FinesMode') eq 'charge') || 0, + renew_ok => (!$debarred), + recall_ok => 0, + hold_ok => 0, + card_lost => ($kp->{lost} || $kp->{gonenoaddress} || $flags->{LOST}) , + claims_returned => 0, + fines => $fines_out, + fees => 0, + recall_overdue => 0, + items_billed => 0, + screen_msg => 'Greetings from Koha. ' . $kp->{opacnote}, + print_line => '', + items => [], + hold_items => $flags->{WAITING}{itemlist}, + overdue_items => $flags->{ODUES}{itemlist}, + fine_items => [], + recall_items => [], + unavail_holds => [], + inet => 1, + ); + } + # FIXME: populate items fine_items recall_items +# $ilspatron{hold_items} = (GetReservesFromBorrowernumber($kp->{borrowernumber},'F')); + $ilspatron{unavail_holds} = [(GetReservesFromBorrowernumber($kp->{borrowernumber}))]; + my ($count,$issues) = GetPendingIssues($kp->{borrowernumber}); + $ilspatron{items} = $issues; + $self = \%ilspatron; + $debug and warn Dumper($self); syslog("LOG_DEBUG", "new ILS::Patron(%s): found patron '%s'", $patron_id,$self->{id}); - bless $self, $type; return $self; } sub id { my $self = shift; - return $self->{id}; } - sub name { my $self = shift; - return $self->{name}; } - sub address { my $self = shift; - return $self->{address}; } - sub email_addr { my $self = shift; - return $self->{email_addr}; } - sub home_phone { my $self = shift; - return $self->{home_phone}; } - sub sip_birthdate { my $self = shift; - return $self->{birthdate}; } - sub ptype { my $self = shift; - return $self->{ptype}; } - sub language { my $self = shift; - return $self->{language} || '000'; # Unspecified } - sub charge_ok { my $self = shift; - return $self->{charge_ok}; } - sub renew_ok { my $self = shift; - return $self->{renew_ok}; } - sub recall_ok { my $self = shift; - return $self->{recall_ok}; } - sub hold_ok { my $self = shift; - return $self->{hold_ok}; } - sub card_lost { my $self = shift; - return $self->{card_lost}; } - sub recall_overdue { my $self = shift; - return $self->{recall_overdue}; } - sub check_password { my ($self, $pwd) = @_; my $md5pwd=$self->{password}; ### FIXME - we're allowing access if user has no password. - warn "check $self->{password} $pwd"; - warn "$self->{name}"; + # warn sprintf "check_password for %s: '%s' vs. '%s'",($self->{name}||''),($self->{password}||''),($pwd||''); return (!$self->{password} || md5_base64($pwd) eq $md5pwd ); } - sub currency { my $self = shift; - return $self->{currency}; } - sub fee_amount { my $self = shift; - return $self->{fee_amount} || undef; } - sub screen_msg { my $self = shift; - return $self->{screen_msg}; } - sub print_line { my $self = shift; - return $self->{print_line}; } - sub too_many_charged { my $self = shift; - return $self->{too_many_charged}; } - sub too_many_overdue { my $self = shift; - return $self->{too_many_overdue}; } - sub too_many_renewal { my $self = shift; - return $self->{too_many_renewal}; } - sub too_many_claim_return { my $self = shift; - return $self->{too_many_claim_return}; } - sub too_many_lost { my $self = shift; - return $self->{too_many_lost}; } - sub excessive_fines { my $self = shift; - return $self->{excessive_fines}; } - sub excessive_fees { my $self = shift; - return $self->{excessive_fees}; } - sub too_many_billed { my $self = shift; - return $self->{too_many_billed}; } @@ -287,10 +339,9 @@ sub too_many_billed { # sub hold_items { my ($self, $start, $end) = @_; - - $start = 1 if !defined($start); - $end = scalar @{$self->{hold_items}} if !defined($end); - + $self->{hold_items} or return []; + $start = 1 unless defined($start); + $end = scalar @{$self->{hold_items}} unless defined($end); return [@{$self->{hold_items}}[$start-1 .. $end-1]]; } @@ -300,99 +351,86 @@ sub hold_items { # sub drop_hold { my ($self, $item_id) = @_; - my $i; - - for ($i = 0; $i < scalar @{$self->{hold_items}}; $i += 1) { - if ($self->{hold_items}[$i]->{item_id} eq $item_id) { - splice @{$self->{hold_items}}, $i, 1; - return 1; + $item_id or return undef; + my $result = 0; + foreach (qw(hold_items unavail_holds)) { + $self->{$_} or next; + for (my $i = 0; $i < scalar @{$self->{$_}}; $i++) { + my $held_item = $self->{$_}[$i]->{item_id} or next; + if ($held_item eq $item_id) { + splice @{$self->{$_}}, $i, 1; + $result++; + } + } } - } - - return 0; + return $result; } sub overdue_items { my ($self, $start, $end) = @_; - + $self->{overdue_items} or return []; $start = 1 if !defined($start); $end = scalar @{$self->{overdue_items}} if !defined($end); - return [@{$self->{overdue_items}}[$start-1 .. $end-1]]; } sub charged_items { my ($self, $start, $end) = shift; - + $self->{items} or return []; $start = 1 if !defined($start); $end = scalar @{$self->{items}} if !defined($end); - - syslog("LOG_DEBUG", "charged_items: start = %d, end = %d", $start, $end); - syslog("LOG_DEBUG", "charged_items: items = (%s)", - join(', ', @{$self->{items}})); - + syslog("LOG_DEBUG", "charged_items: start = %d, end = %d; items(%s)", + $start, $end, join(', ', @{$self->{items}})); return [@{$self->{items}}[$start-1 .. $end-1]]; } sub fine_items { my ($self, $start, $end) = @_; - + $self->{fine_items} or return []; $start = 1 if !defined($start); $end = scalar @{$self->{fine_items}} if !defined($end); - return [@{$self->{fine_items}}[$start-1 .. $end-1]]; } sub recall_items { my ($self, $start, $end) = @_; - + $self->{recall_items} or return []; $start = 1 if !defined($start); $end = scalar @{$self->{recall_items}} if !defined($end); - return [@{$self->{recall_items}}[$start-1 .. $end-1]]; } sub unavail_holds { my ($self, $start, $end) = @_; - + $self->{unavail_holds} or return []; $start = 1 if !defined($start); $end = scalar @{$self->{unavail_holds}} if !defined($end); - return [@{$self->{unavail_holds}}[$start-1 .. $end-1]]; } sub block { my ($self, $card_retained, $blocked_card_msg) = @_; - foreach my $field ('charge_ok', 'renew_ok', 'recall_ok', 'hold_ok') { - $self->{$field} = 0; + $self->{$field} = 0; } - $self->{screen_msg} = $blocked_card_msg || "Card Blocked. Please contact library staff"; - return $self; } sub enable { my $self = shift; - foreach my $field ('charge_ok', 'renew_ok', 'recall_ok', 'hold_ok') { - $self->{$field} = 1; + $self->{$field} = 1; } - syslog("LOG_DEBUG", "Patron(%s)->enable: charge: %s, renew:%s, recall:%s, hold:%s", $self->{id}, $self->{charge_ok}, $self->{renew_ok}, $self->{recall_ok}, $self->{hold_ok}); - $self->{screen_msg} = "All privileges restored."; - return $self; } - sub inet_privileges { my $self = shift; - return $self->{inet} ? 'Y' : 'N'; } @@ -409,3 +447,5 @@ sub charge_denied { } 1; +__END__ + -- 2.39.5