From 2bc183350cfd2a81ef1be8fee846d45906f0535b Mon Sep 17 00:00:00 2001 From: Kyle M Hall Date: Fri, 1 Jun 2012 14:20:44 -0400 Subject: [PATCH] Bug 8182 - Problem with overdue fine calculations after upgrade Items that were overdue and still out as of 5/26 (date of Upgrade) were charged overdue fines as of 5/26. When the items DO come back, the overdue fines are calculated again from the due date to the date of checkin. Therefore the patron is being charged double overdue fines from the original date up to 5/26. This is caused by issues.date_due being changed to a datetime, with the hour/minute/secons time portion defaulting to 00:00:00. It should be 23::50::00 instead. This is an unusual patch as it modifies a previous database update. This make sense because if a install has already been updated past the db rev update, this fix will be too late. It will only help those that have not updated past that db revision. --- C4/SIP/ILS/Patron.pm | 387 ++++++++++++++++++-------------- installer/data/mysql/updatedatabase.pl | 1 + 2 files changed, 216 insertions(+), 172 deletions(-) diff --git a/C4/SIP/ILS/Patron.pm b/C4/SIP/ILS/Patron.pm index 99fd6e7..4f63c76 100644 --- a/C4/SIP/ILS/Patron.pm +++ b/C4/SIP/ILS/Patron.pm @@ -1,6 +1,6 @@ # # ILS::Patron.pm -# +# # A Class for hiding the ILS's concept of the patron from the OpenSIP # system # @@ -26,182 +26,203 @@ use Digest::MD5 qw(md5_base64); use vars qw($VERSION @ISA @EXPORT @EXPORT_OK); BEGIN { - $VERSION = 2.03; - @ISA = qw(Exporter); - @EXPORT_OK = qw(invalid_patron); + $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); - 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}}); - 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; + $kp = GetMember( cardnumber => $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} } ); + 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; + if ($expired) { - if ($kp->{opacnote} ) { + if ( $kp->{opacnote} ) { $kp->{opacnote} .= q{ }; } $kp->{opacnote} .= 'PATRON EXPIRED'; } - my %ilspatron; - my $adr = $kp->{streetnumber} || ''; - my $address = $kp->{address} || ''; + my %ilspatron; + my $adr = $kp->{streetnumber} || ''; + my $address = $kp->{address} || ''; my $dob = $kp->{dateofbirth}; $dob and $dob =~ s/-//g; # YYYYMMDD - my $dexpiry = $kp->{dateexpiry}; + my $dexpiry = $kp->{dateexpiry}; $dexpiry and $dexpiry =~ s/-//g; # YYYYMMDD - $adr .= ($adr && $address) ? " $address" : $address; + $adr .= ( $adr && $address ) ? " $address" : $address; my $fines_amount = $flags->{CHARGES}->{amount}; - $fines_amount = ($fines_amount and $fines_amount > 0) ? $fines_amount : 0; + $fines_amount = ( $fines_amount and $fines_amount > 0 ) ? $fines_amount : 0; { - no warnings; # any of these $kp->{fields} being concat'd could be undef - %ilspatron = ( - getmemberdetails_object => $kp, - name => $kp->{firstname} . " " . $kp->{surname}, - id => $kp->{cardnumber}, # to SIP, the id is the BARCODE, not userid - password => $pw, - ptype => $kp->{categorycode}, # 'A'dult. Whatever. - dateexpiry => $dexpiry, - dateexpiry_iso => $kp->{dateexpiry}, - birthdate => $dob, - birthdate_iso => $kp->{dateofbirth}, - branchcode => $kp->{branchcode}, - library_name => "", # only populated if needed, cached here - borrowernumber => $kp->{borrowernumber}, - 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 ), - card_lost => ( $kp->{lost} || $kp->{gonenoaddress} || $flags->{LOST} ), - claims_returned => 0, - fines => $fines_amount, # GetMemberAccountRecords($kp->{borrowernumber}) - fees => 0, # currently not distinct from fines - 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 => ( !$debarred && !$expired ), - expired => $expired, - ); + no warnings; # any of these $kp->{fields} being concat'd could be undef + %ilspatron = ( + getmemberdetails_object => $kp, + name => $kp->{firstname} . " " . $kp->{surname}, + id => $kp->{cardnumber}, # to SIP, the id is the BARCODE, not userid + password => $pw, + ptype => $kp->{categorycode}, # 'A'dult. Whatever. + dateexpiry => $dexpiry, + dateexpiry_iso => $kp->{dateexpiry}, + birthdate => $dob, + birthdate_iso => $kp->{dateofbirth}, + branchcode => $kp->{branchcode}, + library_name => "", # only populated if needed, cached here + borrowernumber => $kp->{borrowernumber}, + 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 ), + card_lost => + ( $kp->{lost} || $kp->{gonenoaddress} || $flags->{LOST} ), + claims_returned => 0, + fines => + $fines_amount, # GetMemberAccountRecords($kp->{borrowernumber}) + fees => 0, # currently not distinct from fines + 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 => ( !$debarred && !$expired ), + expired => $expired, + ); } - $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; - if ($_ ne 'NOTES' and $flags->{$_}->{message}) { - $ilspatron{screen_msg} .= " -- " . $flags->{$_}->{message}; # show all but internal NOTES + $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; + 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 - } - } - } - - # FIXME: populate fine_items recall_items + 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); - syslog("LOG_DEBUG", "new ILS::Patron(%s): found patron '%s'", $patron_id,$self->{id}); + $ilspatron{unavail_holds} = + [ ( GetReservesFromBorrowernumber( $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; } - # 0 means read-only # 1 means read/write my %fields = ( - id => 0, - name => 0, - address => 0, - email_addr => 0, - home_phone => 0, - birthdate => 0, - birthdate_iso => 0, - dateexpiry => 0, - dateexpiry_iso => 0, - ptype => 0, - charge_ok => 0, # for patron_status[0] (inverted) - renew_ok => 0, # for patron_status[1] (inverted) - recall_ok => 0, # for patron_status[2] (inverted) - hold_ok => 0, # for patron_status[3] (inverted) - card_lost => 0, # for patron_status[4] - recall_overdue => 0, - currency => 1, -# fee_limit => 0, - screen_msg => 1, - print_line => 1, - too_many_charged => 0, # for patron_status[5] - too_many_overdue => 0, # for patron_status[6] - too_many_renewal => 0, # for patron_status[7] - too_many_claim_return => 0, # for patron_status[8] - too_many_lost => 0, # for patron_status[9] -# excessive_fines => 0, # for patron_status[10] -# excessive_fees => 0, # for patron_status[11] - recall_overdue => 0, # for patron_status[12] - too_many_billed => 0, # for patron_status[13] - inet => 0, # EnvisionWare extension + id => 0, + name => 0, + address => 0, + email_addr => 0, + home_phone => 0, + birthdate => 0, + birthdate_iso => 0, + dateexpiry => 0, + dateexpiry_iso => 0, + ptype => 0, + charge_ok => 0, # for patron_status[0] (inverted) + renew_ok => 0, # for patron_status[1] (inverted) + recall_ok => 0, # for patron_status[2] (inverted) + hold_ok => 0, # for patron_status[3] (inverted) + card_lost => 0, # for patron_status[4] + recall_overdue => 0, + currency => 1, + + # fee_limit => 0, + screen_msg => 1, + print_line => 1, + too_many_charged => 0, # for patron_status[5] + too_many_overdue => 0, # for patron_status[6] + too_many_renewal => 0, # for patron_status[7] + too_many_claim_return => 0, # for patron_status[8] + too_many_lost => 0, # for patron_status[9] + + # excessive_fines => 0, # for patron_status[10] + # excessive_fees => 0, # for patron_status[11] + recall_overdue => 0, # for patron_status[12] + too_many_billed => 0, # for patron_status[13] + inet => 0, # EnvisionWare extension getmemberdetails_object => 0, ); our $AUTOLOAD; sub DESTROY { + # be cool. needed for AUTOLOAD(?) } sub AUTOLOAD { - my $self = shift; + my $self = shift; my $class = ref($self) or croak "$self is not an object"; - my $name = $AUTOLOAD; + my $name = $AUTOLOAD; $name =~ s/.*://; - unless (exists $fields{$name}) { - croak "Cannot access '$name' field of class '$class'"; + unless ( exists $fields{$name} ) { + 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 ) = @_; + 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 ); } # A few special cases, not in AUTOLOADed %fields @@ -217,7 +238,7 @@ sub fines_amount { sub language { my $self = shift; - return $self->{language} || '000'; # Unspecified + return $self->{language} || '000'; # Unspecified } sub expired { @@ -228,21 +249,21 @@ sub expired { # # remove the hold on item item_id from my hold queue. # return true if I was holding the item, false otherwise. -# +# 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++; - } - } - } + 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 $result; } @@ -252,13 +273,14 @@ sub drop_hold { sub x_items { my $self = shift or return; my $array_var = shift or return; - my ($start, $end) = @_; - $self->{$array_var} 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}})); + $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]]; + return [ @{ $self->{$array_var} }[ $start - 1 .. $end - 1 ] ]; } # @@ -266,49 +288,65 @@ sub x_items { # sub hold_items { my $self = shift or return; - return $self->x_items('hold_items', @_); + return $self->x_items( 'hold_items', @_ ); } sub overdue_items { my $self = shift or return; - return $self->x_items('overdue_items', @_); + return $self->x_items( 'overdue_items', @_ ); } + sub charged_items { my $self = shift or return; - return $self->x_items('items', @_); + return $self->x_items( 'items', @_ ); } + sub fine_items { my $self = shift or return; - return $self->x_items('fine_items', @_); + return $self->x_items( 'fine_items', @_ ); } + sub recall_items { my $self = shift or return; - return $self->x_items('recall_items', @_); + return $self->x_items( 'recall_items', @_ ); } + sub unavail_holds { my $self = shift or return; - return $self->x_items('unavail_holds', @_); + 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; + my ( $self, $card_retained, $blocked_card_msg ) = @_; + foreach + my $field ( 'charge_ok', 'renew_ok', 'recall_ok', 'hold_ok', 'inet' ) + { + $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 + $self->{screen_msg} = "Block feature not implemented" + ; # $blocked_card_msg || "Card Blocked. Please contact library staff"; + # TODO: not really affecting patron record return $self; } sub enable { my $self = shift; - foreach my $field ('charge_ok', 'renew_ok', 'recall_ok', 'hold_ok', 'inet') { - $self->{$field} = 1; + foreach + my $field ( 'charge_ok', 'renew_ok', 'recall_ok', 'hold_ok', 'inet' ) + { + $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} = "Enable feature not implemented."; # "All privileges restored."; # TODO: not really affecting patron record + 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} = "Enable feature not implemented." + ; # "All privileges restored."; # TODO: not really affecting patron record return $self; } @@ -318,26 +356,31 @@ sub inet_privileges { } sub fee_limit { + # my $self = shift; return C4::Context->preference("noissuescharge") || 5; } sub excessive_fees { my $self = shift or return; - return ($self->fee_amount and $self->fee_amount > $self->fee_limit); + return ( $self->fee_amount and $self->fee_amount > $self->fee_limit ); } + sub excessive_fines { my $self = shift or return; - return $self->excessive_fees; # excessive_fines is the same thing as excessive_fees for Koha + return + $self->excessive_fees + ; # excessive_fines is the same thing as excessive_fees for Koha } - + sub library_name { my $self = shift; - unless ($self->{library_name}) { - $self->{library_name} = GetBranchName($self->{branchcode}); + unless ( $self->{library_name} ) { + $self->{library_name} = GetBranchName( $self->{branchcode} ); } return $self->{library_name}; } + # # Messages # diff --git a/installer/data/mysql/updatedatabase.pl b/installer/data/mysql/updatedatabase.pl index 51a6486..a5a436c 100755 --- a/installer/data/mysql/updatedatabase.pl +++ b/installer/data/mysql/updatedatabase.pl @@ -5018,6 +5018,7 @@ if (C4::Context->preference("Version") < TransformToNum($DBversion)) { $DBversion = "3.07.00.035"; if ( C4::Context->preference("Version") < TransformToNum($DBversion) ) { $dbh->do("ALTER TABLE issues CHANGE date_due date_due datetime"); + $dhb->do("UPDATE issues SET date_due = CONCAT(SUBSTR(date_due,1,11),'23:59:00')"); $dbh->do("ALTER TABLE issues CHANGE returndate returndate datetime"); $dbh->do("ALTER TABLE issues CHANGE lastreneweddate lastreneweddate datetime"); $dbh->do("ALTER TABLE issues CHANGE issuedate issuedate datetime"); -- 1.7.2.5