X-Git-Url: http://git.rot13.org/?a=blobdiff_plain;f=C4%2FSIP%2FILS%2FPatron.pm;h=001277619e3bfb1d30b424a26269982de3c9ebd6;hb=b59df2bce788bc5cc3b184c9c74688dd745a2fb0;hp=99fd6e7edfa9256e68e35a14ad3fb1d743e9552e;hpb=d5542514d22ca5b9fc6bfb4fb8b6db61e3a512b5;p=koha.git diff --git a/C4/SIP/ILS/Patron.pm b/C4/SIP/ILS/Patron.pm index 99fd6e7edf..001277619e 100644 --- a/C4/SIP/ILS/Patron.pm +++ b/C4/SIP/ILS/Patron.pm @@ -5,7 +5,7 @@ # system # -package ILS::Patron; +package C4::SIP::ILS::Patron; use strict; use warnings; @@ -20,35 +20,29 @@ use C4::Context; use C4::Koha; use C4::Members; use C4::Reserves; -use C4::Branch qw(GetBranchName); -use Digest::MD5 qw(md5_base64); +use C4::Items qw( GetBarcodeFromItemnumber GetItemnumbersForBiblio); +use C4::Auth qw(checkpw); -use vars qw($VERSION @ISA @EXPORT @EXPORT_OK); +use Koha::Libraries; -BEGIN { - $VERSION = 2.03; - @ISA = qw(Exporter); - @EXPORT_OK = qw(invalid_patron); -} - -our $kp; # koha patron +our $kp; # koha patron sub new { - my ($class, $patron_id) = @_; + my ($class, $patron_id) = @_; my $type = ref($class) || $class; my $self; - $kp = GetMember(cardnumber=>$patron_id); - $debug and warn "new Patron (GetMember): " . Dumper($kp); + $kp = GetMember(cardnumber=>$patron_id) || GetMember(userid=>$patron_id); + $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; - } - $kp = GetMemberDetails(undef,$patron_id); - $debug and warn "new Patron (GetMemberDetails): " . Dumper($kp); - my $pw = $kp->{password}; ### FIXME - md5hash -- deal with . - 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 sprintf("Debarred = %s : ", ($debarred||'undef')) . Dumper(%{$kp->{flags}}); + syslog("LOG_DEBUG", "new ILS::Patron(%s): no such patron", $patron_id); + return; + } + $kp = GetMember( borrowernumber => $kp->{borrowernumber}); + $debug and warn "new Patron (GetMember): " . Dumper($kp); + my $pw = $kp->{password}; + my $flags = C4::Members::patronflags( $kp ); + my $debarred = defined($flags->{DBARRED}); + $debug and warn sprintf("Debarred = %s : ", ($debarred||'undef')) . Dumper(%$flags); my ($day, $month, $year) = (localtime)[3,4,5]; my $today = sprintf '%04d-%02d-%02d', $year+1900, $month+1, $day; my $expired = ($today gt $kp->{dateexpiry}) ? 1 : 0; @@ -58,18 +52,18 @@ sub new { } $kp->{opacnote} .= 'PATRON EXPIRED'; } - my %ilspatron; - my $adr = $kp->{streetnumber} || ''; - my $address = $kp->{address} || ''; + my %ilspatron; + my $adr = _get_address($kp); my $dob = $kp->{dateofbirth}; $dob and $dob =~ s/-//g; # YYYYMMDD my $dexpiry = $kp->{dateexpiry}; $dexpiry and $dexpiry =~ s/-//g; # YYYYMMDD - $adr .= ($adr && $address) ? " $address" : $address; my $fines_amount = $flags->{CHARGES}->{amount}; $fines_amount = ($fines_amount and $fines_amount > 0) ? $fines_amount : 0; + my $fee_limit = _fee_limit(); + my $fine_blocked = $fines_amount > $fee_limit; { - no warnings; # any of these $kp->{fields} being concat'd could be undef + no warnings; # any of these $kp->{fields} being concat'd could be undef %ilspatron = ( getmemberdetails_object => $kp, name => $kp->{firstname} . " " . $kp->{surname}, @@ -86,10 +80,10 @@ sub new { address => $adr, home_phone => $kp->{phone}, email_addr => $kp->{email}, - charge_ok => ( !$debarred && !$expired ), - renew_ok => ( !$debarred && !$expired ), - recall_ok => ( !$debarred && !$expired ), - hold_ok => ( !$debarred && !$expired ), + charge_ok => ( !$debarred && !$expired && !$fine_blocked), + renew_ok => ( !$debarred && !$expired && !$fine_blocked), + recall_ok => ( !$debarred && !$expired && !$fine_blocked), + hold_ok => ( !$debarred && !$expired && !$fine_blocked), card_lost => ( $kp->{lost} || $kp->{gonenoaddress} || $flags->{LOST} ), claims_returned => 0, fines => $fines_amount, # GetMemberAccountRecords($kp->{borrowernumber}) @@ -99,34 +93,35 @@ sub new { screen_msg => 'Greetings from Koha. ' . $kp->{opacnote}, print_line => '', items => [], - hold_items => $flags->{WAITING}{itemlist}, - overdue_items => $flags->{ODUES}{itemlist}, + hold_items => $flags->{WAITING}->{itemlist}, + overdue_items => $flags->{ODUES}->{itemlist}, fine_items => [], recall_items => [], unavail_holds => [], inet => ( !$debarred && !$expired ), expired => $expired, + fee_limit => $fee_limit, + userid => $kp->{userid}, ); } $debug and warn "patron fines: $ilspatron{fines} ... amountoutstanding: $kp->{amountoutstanding} ... CHARGES->amount: $flags->{CHARGES}->{amount}"; - for (qw(EXPIRED CHARGES CREDITS GNA LOST DBARRED NOTES)) { - ($flags->{$_}) or next; + for (qw(EXPIRED CHARGES CREDITS GNA LOST DBARRED NOTES)) { + ($flags->{$_}) or next; if ($_ ne 'NOTES' and $flags->{$_}->{message}) { $ilspatron{screen_msg} .= " -- " . $flags->{$_}->{message}; # show all but internal NOTES } - if ($flags->{$_}->{noissues}) { - foreach my $toggle (qw(charge_ok renew_ok recall_ok hold_ok inet)) { - $ilspatron{$toggle} = 0; # if we get noissues, disable everything - } - } - } + if ($flags->{$_}->{noissues}) { + foreach my $toggle (qw(charge_ok renew_ok recall_ok hold_ok inet)) { + $ilspatron{$toggle} = 0; # if we get noissues, disable everything + } + } + } # FIXME: populate fine_items recall_items -# $ilspatron{hold_items} = (GetReservesFromBorrowernumber($kp->{borrowernumber},'F')); - $ilspatron{unavail_holds} = [(GetReservesFromBorrowernumber($kp->{borrowernumber}))]; - $ilspatron{items} = GetPendingIssues($kp->{borrowernumber}); - $self = \%ilspatron; - $debug and warn Dumper($self); + $ilspatron{unavail_holds} = _get_outstanding_holds($kp->{borrowernumber}); + $ilspatron{items} = GetPendingIssues($kp->{borrowernumber}); + $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; @@ -154,7 +149,7 @@ my %fields = ( card_lost => 0, # for patron_status[4] recall_overdue => 0, currency => 1, -# fee_limit => 0, + fee_limit => 0, screen_msg => 1, print_line => 1, too_many_charged => 0, # for patron_status[5] @@ -184,30 +179,39 @@ sub AUTOLOAD { $name =~ s/.*://; unless (exists $fields{$name}) { - croak "Cannot access '$name' field of class '$class'"; + croak "Cannot access '$name' field of class '$class'"; } - if (@_) { + if (@_) { $fields{$name} or croak "Field '$name' of class '$class' is READ ONLY."; - return $self->{$name} = shift; - } else { - return $self->{$name}; - } + return $self->{$name} = shift; + } else { + return $self->{$name}; + } } sub check_password { - my ($self, $pwd) = @_; - my $md5pwd = $self->{password}; - # warn sprintf "check_password for %s: '%s' vs. '%s'",($self->{name}||''),($self->{password}||''),($pwd||''); - (defined $pwd ) or return 0; # you gotta give me something (at least ''), or no deal - (defined $md5pwd) or return($pwd eq ''); # if the record has a NULL password, accept '' as match - return (md5_base64($pwd) eq $md5pwd); + my ( $self, $pwd ) = @_; + + # you gotta give me something (at least ''), or no deal + return 0 unless defined $pwd; + + # If the record has a NULL password, accept '' as match + return $pwd eq q{} unless $self->{password}; + + my $dbh = C4::Context->dbh; + my $ret = 0; + ($ret) = checkpw( $dbh, $self->{userid}, $pwd, undef, undef, 1 ); # dbh, userid, query, type, no_set_userenv + return $ret; } # 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,18 +235,18 @@ sub expired { # sub drop_hold { my ($self, $item_id) = @_; - $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 if !$item_id; + 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 $result; } @@ -250,50 +254,98 @@ sub drop_hold { # from the SIP request. Note those incoming values are 1-indexed, not 0-indexed. # sub x_items { - my $self = shift or return; + my $self = shift; my $array_var = shift or return; my ($start, $end) = @_; - $self->{$array_var} or return []; - $start = 1 unless defined($start); - $end = scalar @{$self->{$array_var}} unless defined($end); - # syslog("LOG_DEBUG", "$array_var: start = %d, end = %d; items(%s)", $start, $end, join(', ', @{$self->{items}})); - return [@{$self->{$array_var}}[$start-1 .. $end-1]]; + my $item_list = []; + if ($self->{$array_var}) { + if ($start && $start > 1) { + --$start; + } + else { + $start = 0; + } + if ( $end && $end < @{$self->{$array_var}} ) { + } + else { + $end = @{$self->{$array_var}}; + --$end; + } + @{$item_list} = @{$self->{$array_var}}[ $start .. $end ]; + + } + return $item_list; } # # List of outstanding holds placed # sub hold_items { - my $self = shift or return; - return $self->x_items('hold_items', @_); + my $self = shift; + my $item_arr = $self->x_items('hold_items', @_); + foreach my $item (@{$item_arr}) { + $item->{barcode} = GetBarcodeFromItemnumber($item->{itemnumber}); + } + return $item_arr; } sub overdue_items { - my $self = shift or return; + my $self = shift; return $self->x_items('overdue_items', @_); } sub charged_items { - my $self = shift or return; + my $self = shift; return $self->x_items('items', @_); } sub fine_items { - my $self = shift or return; - return $self->x_items('fine_items', @_); + require Koha::Database; + require Template; + + my $self = shift; + my $start = shift; + my $end = shift; + my $server = shift; + + my @fees = Koha::Database->new()->schema()->resultset('Accountline')->search( + { + borrowernumber => $self->{borrowernumber}, + amountoutstanding => { '>' => '0' }, + } + ); + + $start = $start ? $start - 1 : 0; + $end = $end ? $end : scalar @fees - 1; + + my $av_field_template = $server ? $server->{account}->{av_field_template} : undef; + $av_field_template ||= "[% accountline.description %] [% accountline.amountoutstanding | format('%.2f') %]"; + + my $tt = Template->new(); + + my @return_values; + for ( my $i = $start; $i <= $end; $i++ ) { + my $fee = $fees[$i]; + + my $output; + $tt->process( \$av_field_template, { accountline => $fee }, \$output ); + push( @return_values, { barcode => $output } ); + } + + return \@return_values; } sub recall_items { - my $self = shift or return; + my $self = shift; return $self->x_items('recall_items', @_); } sub unavail_holds { - my $self = shift or return; + my $self = shift; return $self->x_items('unavail_holds', @_); } sub block { my ($self, $card_retained, $blocked_card_msg) = @_; foreach my $field ('charge_ok', 'renew_ok', 'recall_ok', 'hold_ok', 'inet') { - $self->{$field} = 0; + $self->{$field} = 0; } $self->{screen_msg} = "Block feature not implemented"; # $blocked_card_msg || "Card Blocked. Please contact library staff"; # TODO: not really affecting patron record @@ -303,11 +355,11 @@ sub block { sub enable { my $self = shift; foreach my $field ('charge_ok', 'renew_ok', 'recall_ok', 'hold_ok', 'inet') { - $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->{id}, $self->{charge_ok}, $self->{renew_ok}, + $self->{recall_ok}, $self->{hold_ok}); $self->{screen_msg} = "Enable feature not implemented."; # "All privileges restored."; # TODO: not really affecting patron record return $self; } @@ -317,24 +369,31 @@ sub inet_privileges { return $self->{inet} ? 'Y' : 'N'; } -sub fee_limit { - # my $self = shift; - return C4::Context->preference("noissuescharge") || 5; +sub _fee_limit { + return C4::Context->preference('noissuescharge') || 5; } sub excessive_fees { - my $self = shift or return; + my $self = shift; return ($self->fee_amount and $self->fee_amount > $self->fee_limit); } + sub excessive_fines { - my $self = shift or return; + my $self = shift; return $self->excessive_fees; # excessive_fines is the same thing as excessive_fees for Koha } + +sub holds_blocked_by_excessive_fees { + my $self = shift; + return ( $self->fee_amount + && $self->fee_amount > C4::Context->preference("maxoutstanding") ); +} sub library_name { my $self = shift; unless ($self->{library_name}) { - $self->{library_name} = GetBranchName($self->{branchcode}); + my $library = Koha::Libraries->find( $self->{branchcode} ); + $self->{library_name} = $library ? $library->branchname : ''; } return $self->{library_name}; } @@ -343,48 +402,86 @@ sub library_name { # sub invalid_patron { + my $self = shift; return "Please contact library staff"; } sub charge_denied { + my $self = shift; return "Please contact library staff"; } +sub _get_address { + my $patron = shift; + + my $address = $patron->{streetnumber} || q{}; + for my $field (qw( roaddetails address address2 city state zipcode country)) + { + next unless $patron->{$field}; + if ($address) { + $address .= q{ }; + $address .= $patron->{$field}; + } + else { + $address .= $patron->{$field}; + } + } + return $address; +} + +sub _get_outstanding_holds { + my $borrowernumber = shift; + my @hold_array = grep { !defined $_->{found} || $_->{found} ne 'W'} GetReservesFromBorrowernumber($borrowernumber); + foreach my $h (@hold_array) { + my $item; + if ($h->{itemnumber}) { + $item = $h->{itemnumber}; + } + else { + # We need to return a barcode for the biblio so the client + # can request the biblio info + $item = ( GetItemnumbersForBiblio($h->{biblionumber}) )->[0]; + } + $h->{barcode} = GetBarcodeFromItemnumber($item); + } + return \@hold_array; +} + 1; __END__ =head1 EXAMPLES our %patron_example = ( - djfiander => { - name => "David J. Fiander", - id => 'djfiander', - password => '6789', - ptype => 'A', # 'A'dult. Whatever. - birthdate => '19640925', - address => '2 Meadowvale Dr. St Thomas, ON', - home_phone => '(519) 555 1234', - email_addr => 'djfiander@hotmail.com', - charge_ok => 1, - renew_ok => 1, - recall_ok => 0, - hold_ok => 1, - card_lost => 0, - claims_returned => 0, - fines => 100, - fees => 0, - recall_overdue => 0, - items_billed => 0, - screen_msg => '', - print_line => '', - items => [], - hold_items => [], - overdue_items => [], - fine_items => ['Computer Time'], - recall_items => [], - unavail_holds => [], - inet => 1, - }, + djfiander => { + name => "David J. Fiander", + id => 'djfiander', + password => '6789', + ptype => 'A', # 'A'dult. Whatever. + birthdate => '19640925', + address => '2 Meadowvale Dr. St Thomas, ON', + home_phone => '(519) 555 1234', + email_addr => 'djfiander@hotmail.com', + charge_ok => 1, + renew_ok => 1, + recall_ok => 0, + hold_ok => 1, + card_lost => 0, + claims_returned => 0, + fines => 100, + fees => 0, + recall_overdue => 0, + items_billed => 0, + screen_msg => '', + print_line => '', + items => [], + hold_items => [], + overdue_items => [], + fine_items => ['Computer Time'], + recall_items => [], + unavail_holds => [], + inet => 1, + }, ); From borrowers table: @@ -464,26 +561,26 @@ __END__ $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 + {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