X-Git-Url: http://git.rot13.org/?a=blobdiff_plain;f=C4%2FCirculation.pm;h=fe2840947e37bb14ff8d930017b607c17bed81df;hb=b6e62489d8dc749db077ccb86ea29f4ae7b91fa6;hp=0e2694a4d0e87dcc15693a6390fbbbdb53059eaf;hpb=c85458a33e82994118e17447c5e111da9b566489;p=koha.git diff --git a/C4/Circulation.pm b/C4/Circulation.pm index 0e2694a4d0..fe2840947e 100644 --- a/C4/Circulation.pm +++ b/C4/Circulation.pm @@ -19,7 +19,7 @@ package C4::Circulation; use strict; -require Exporter; +#use warnings; # soon! use C4::Context; use C4::Stats; use C4::Reserves; @@ -28,6 +28,10 @@ use C4::Biblio; use C4::Items; use C4::Members; use C4::Dates; +use C4::Calendar; +use C4::Accounts; +use C4::ItemCirculationAlertPreference; +use C4::Message; use Date::Calc qw( Today Today_and_Now @@ -46,14 +50,14 @@ use Data::Dumper; use vars qw($VERSION @ISA @EXPORT @EXPORT_OK %EXPORT_TAGS); BEGIN { - # set the version for version checking - $VERSION = 3.01; + require Exporter; + $VERSION = 3.02; # for version checking @ISA = qw(Exporter); # FIXME subs that should probably be elsewhere push @EXPORT, qw( &FixOverduesOnReturn - &cuecatbarcodedecode + &barcodedecode ); # subs to deal with issuing a book @@ -64,9 +68,13 @@ BEGIN { &AddRenewal &GetRenewCount &GetItemIssue + &GetOpenIssue &GetItemIssues &GetBorrowerIssues &GetIssuingCharges + &GetIssuingRule + &GetBranchBorrowerCircRule + &GetBranchItemRule &GetBiblioIssues &AnonymiseIssueHistory ); @@ -74,6 +82,7 @@ BEGIN { # subs to deal with returns push @EXPORT, qw( &AddReturn + &MarkIssueReturned ); # subs to deal with transfers @@ -83,6 +92,9 @@ BEGIN { &GetTransfersFromTo &updateWrongTransfer &DeleteTransfer + &IsBranchTransferAllowed + &CreateBranchTransferLimit + &DeleteBranchTransferLimits ); } @@ -102,33 +114,52 @@ Also deals with stocktaking. =head1 FUNCTIONS -=head2 decode +=head2 barcodedecode -=head3 $str = &decode($chunk); +=head3 $str = &barcodedecode($barcode, [$filter]); =over 4 -=item Decodes a segment of a string emitted by a CueCat barcode scanner and -returns it. +=item Generic filter function for barcode string. +Called on every circ if the System Pref itemBarcodeInputFilter is set. +Will do some manipulation of the barcode for systems that deliver a barcode +to circulation.pl that differs from the barcode stored for the item. +For proper functioning of this filter, calling the function on the +correct barcode string (items.barcode) should return an unaltered barcode. + +The optional $filter argument is to allow for testing or explicit +behavior that ignores the System Pref. Valid values are the same as the +System Pref options. =back =cut -# FIXME - At least, I'm pretty sure this is for decoding CueCat stuff. -# FIXME From Paul : i don't understand what this sub does & why it has to be called on every circ. Speak of this with chris maybe ? - -sub cuecatbarcodedecode { - my ($barcode) = @_; - chomp($barcode); - my @fields = split( /\./, $barcode ); - my @results = map( decode($_), @fields[ 1 .. $#fields ] ); - if ( $#results == 2 ) { - return $results[2]; - } - else { - return $barcode; - } +# FIXME -- the &decode fcn below should be wrapped into this one. +# FIXME -- these plugins should be moved out of Circulation.pm +# +sub barcodedecode { + my ($barcode, $filter) = @_; + $filter = C4::Context->preference('itemBarcodeInputFilter') unless $filter; + $filter or return $barcode; # ensure filter is defined, else return untouched barcode + if ($filter eq 'whitespace') { + $barcode =~ s/\s//g; + } elsif ($filter eq 'cuecat') { + chomp($barcode); + my @fields = split( /\./, $barcode ); + my @results = map( decode($_), @fields[ 1 .. $#fields ] ); + ($#results == 2) and return $results[2]; + } elsif ($filter eq 'T-prefix') { + if ($barcode =~ /^[Tt](\d)/) { + (defined($1) and $1 eq '0') and return $barcode; + $barcode = substr($barcode, 2) + 0; # FIXME: probably should be substr($barcode, 1) + } + return sprintf("T%07d", $barcode); + # FIXME: $barcode could be "T1", causing warning: substr outside of string + # Why drop the nonzero digit after the T? + # Why pass non-digits (or empty string) to "T%07d"? + } + return $barcode; # return barcode, modified or not } =head2 decode @@ -140,6 +171,9 @@ sub cuecatbarcodedecode { =item Decodes a segment of a string emitted by a CueCat barcode scanner and returns it. +FIXME: Should be replaced with Barcode::Cuecat from CPAN +or Javascript based decoding on the client side. + =back =cut @@ -152,7 +186,7 @@ sub decode { my $l = ( $#s + 1 ) % 4; if ($l) { if ( $l == 1 ) { - warn "Error!"; + # warn "Error: Cuecat decode parsing failed!"; return; } $l = 4 - $l; @@ -243,9 +277,23 @@ sub transferbook { my $hbr = $biblio->{'homebranch'}; my $fbr = $biblio->{'holdingbranch'}; + # if using Branch Transfer Limits + if ( C4::Context->preference("UseBranchTransferLimits") == 1 ) { + if ( C4::Context->preference("item-level_itypes") && C4::Context->preference("BranchTransferLimitsType") eq 'itemtype' ) { + if ( ! IsBranchTransferAllowed( $tbr, $fbr, $biblio->{'itype'} ) ) { + $messages->{'NotAllowed'} = $tbr . "::" . $biblio->{'itype'}; + $dotransfer = 0; + } + } elsif ( ! IsBranchTransferAllowed( $tbr, $fbr, $biblio->{ C4::Context->preference("BranchTransferLimitsType") } ) ) { + $messages->{'NotAllowed'} = $tbr . "::" . $biblio->{ C4::Context->preference("BranchTransferLimitsType") }; + $dotransfer = 0; + } + } + # if is permanent... if ( $hbr && $branches->{$hbr}->{'PE'} ) { $messages->{'IsPermanent'} = $hbr; + $dotransfer = 0; } # can't transfer book if is already there.... @@ -282,94 +330,6 @@ sub transferbook { return ( $dotransfer, $messages, $biblio ); } -=head2 CanBookBeIssued - -Check if a book can be issued. - -my ($issuingimpossible,$needsconfirmation) = CanBookBeIssued($borrower,$barcode,$year,$month,$day); - -=over 4 - -=item C<$borrower> hash with borrower informations (from GetMemberDetails) - -=item C<$barcode> is the bar code of the book being issued. - -=item C<$year> C<$month> C<$day> contains the date of the return (in case it's forced by "stickyduedate". - -=back - -Returns : - -=over 4 - -=item C<$issuingimpossible> a reference to a hash. It contains reasons why issuing is impossible. -Possible values are : - -=back - -=head3 INVALID_DATE - -sticky due date is invalid - -=head3 GNA - -borrower gone with no address - -=head3 CARD_LOST - -borrower declared it's card lost - -=head3 DEBARRED - -borrower debarred - -=head3 UNKNOWN_BARCODE - -barcode unknown - -=head3 NOT_FOR_LOAN - -item is not for loan - -=head3 WTHDRAWN - -item withdrawn. - -=head3 RESTRICTED - -item is restricted (set by ??) - -C<$issuingimpossible> a reference to a hash. It contains reasons why issuing is impossible. -Possible values are : - -=head3 DEBT - -borrower has debts. - -=head3 RENEW_ISSUE - -renewing, not issuing - -=head3 ISSUED_TO_ANOTHER - -issued to someone else. - -=head3 RESERVED - -reserved for someone else. - -=head3 INVALID_DATE - -sticky due date is invalid - -=head3 TOO_MANY - -if the borrower borrows to much things - -=cut - -# check if a book can be issued. - sub TooMany { my $borrower = shift; @@ -379,10 +339,10 @@ sub TooMany { my $dbh = C4::Context->dbh; my $branch; # Get which branchcode we need - if (C4::Context->preference('CircControl') eq 'PickupLibary'){ - $branch = C4::Context->userenv->{'branchcode'}; + if (C4::Context->preference('CircControl') eq 'PickupLibrary'){ + $branch = C4::Context->userenv->{'branch'}; } - elsif (C4::Context->preference('CircControl') eq 'PatronLibary'){ + elsif (C4::Context->preference('CircControl') eq 'PatronLibrary'){ $branch = $borrower->{'branchcode'}; } else { @@ -392,130 +352,107 @@ sub TooMany { my $type = (C4::Context->preference('item-level_itypes')) ? $item->{'itype'} # item-level : $item->{'itemtype'}; # biblio-level - - my $sth = - $dbh->prepare( - 'SELECT * FROM issuingrules - WHERE categorycode = ? - AND itemtype = ? - AND branchcode = ?' - ); - - my $query2 = "SELECT COUNT(*) FROM issues i, biblioitems s1, items s2 - WHERE i.borrowernumber = ? - AND i.returndate IS NULL - AND i.itemnumber = s2.itemnumber - AND s1.biblioitemnumber = s2.biblioitemnumber"; - if (C4::Context->preference('item-level_itypes')){ - $query2.=" AND s2.itype=? "; - } else { - $query2.=" AND s1.itemtype= ? "; - } - my $sth2= $dbh->prepare($query2); - my $sth3 = - $dbh->prepare( - 'SELECT COUNT(*) FROM issues - WHERE borrowernumber = ? - AND returndate IS NULL' - ); - my $alreadyissued; - - # check the 3 parameters (branch / itemtype / category code - $sth->execute( $cat_borrower, $type, $branch ); - my $result = $sth->fetchrow_hashref; -# warn "$cat_borrower, $type, $branch = ".Data::Dumper::Dumper($result); - - if ( $result->{maxissueqty} ne '' ) { -# warn "checking on everything set"; - $sth2->execute( $borrower->{'borrowernumber'}, $type ); - my $alreadyissued = $sth2->fetchrow; - if ( $result->{'maxissueqty'} <= $alreadyissued ) { - return ( "$alreadyissued / ".( $result->{maxissueqty} + 0 )." (rule on branch/category/itemtype failed)" ); - } - # now checking for total - $sth->execute( $cat_borrower, '', $branch ); - my $result = $sth->fetchrow_hashref; - if ( $result->{maxissueqty} ne '*' ) { - $sth2->execute( $borrower->{'borrowernumber'}, $type ); - my $alreadyissued = $sth2->fetchrow; - if ( $result->{'maxissueqty'} <= $alreadyissued ) { - return ( "$alreadyissued / ".( $result->{maxissueqty} + 0 )." (rule on branch/category/total failed)" ); + + # given branch, patron category, and item type, determine + # applicable issuing rule + my $issuing_rule = GetIssuingRule($cat_borrower, $type, $branch); + + # if a rule is found and has a loan limit set, count + # how many loans the patron already has that meet that + # rule + if (defined($issuing_rule) and defined($issuing_rule->{'maxissueqty'})) { + my @bind_params; + my $count_query = "SELECT COUNT(*) FROM issues + JOIN items USING (itemnumber) "; + + my $rule_itemtype = $issuing_rule->{itemtype}; + if ($rule_itemtype eq "*") { + # matching rule has the default item type, so count only + # those existing loans that don't fall under a more + # specific rule + if (C4::Context->preference('item-level_itypes')) { + $count_query .= " WHERE items.itype NOT IN ( + SELECT itemtype FROM issuingrules + WHERE branchcode = ? + AND (categorycode = ? OR categorycode = ?) + AND itemtype <> '*' + ) "; + } else { + $count_query .= " JOIN biblioitems USING (biblionumber) + WHERE biblioitems.itemtype NOT IN ( + SELECT itemtype FROM issuingrules + WHERE branchcode = ? + AND (categorycode = ? OR categorycode = ?) + AND itemtype <> '*' + ) "; + } + push @bind_params, $issuing_rule->{branchcode}; + push @bind_params, $issuing_rule->{categorycode}; + push @bind_params, $cat_borrower; + } else { + # rule has specific item type, so count loans of that + # specific item type + if (C4::Context->preference('item-level_itypes')) { + $count_query .= " WHERE items.itype = ? "; + } else { + $count_query .= " JOIN biblioitems USING (biblionumber) + WHERE biblioitems.itemtype= ? "; } + push @bind_params, $type; } - } - # check the 2 parameters (branch / itemtype / default categorycode - $sth->execute( '*', $type, $branch ); - $result = $sth->fetchrow_hashref; -# warn "*, $type, $branch = ".Data::Dumper::Dumper($result); - - if ( $result->{maxissueqty} ne '' ) { -# warn "checking on 2 parameters (default categorycode)"; - $sth2->execute( $borrower->{'borrowernumber'}, $type ); - my $alreadyissued = $sth2->fetchrow; - if ( $result->{'maxissueqty'} <= $alreadyissued ) { - return ( "$alreadyissued / ".( $result->{maxissueqty} + 0 )." (rule on branch / default category / itemtype failed)" ); - } - # now checking for total - $sth->execute( '*', '*', $branch ); - my $result = $sth->fetchrow_hashref; - if ( $result->{maxissueqty} ne '' ) { - $sth2->execute( $borrower->{'borrowernumber'}, $type ); - my $alreadyissued = $sth2->fetchrow; - if ( $result->{'maxissueqty'} <= $alreadyissued ) { - return ( "$alreadyissued / ".( $result->{maxissueqty} + 0 )." (rule on branch / default category / total failed)" ); + $count_query .= " AND borrowernumber = ? "; + push @bind_params, $borrower->{'borrowernumber'}; + my $rule_branch = $issuing_rule->{branchcode}; + if ($rule_branch ne "*") { + if (C4::Context->preference('CircControl') eq 'PickupLibrary') { + $count_query .= " AND issues.branchcode = ? "; + push @bind_params, $branch; + } elsif (C4::Context->preference('CircControl') eq 'PatronLibrary') { + ; # if branch is the patron's home branch, then count all loans by patron + } else { + $count_query .= " AND items.homebranch = ? "; + push @bind_params, $branch; } } - } - - # check the 1 parameters (default branch / itemtype / categorycode - $sth->execute( $cat_borrower, $type, '*' ); - $result = $sth->fetchrow_hashref; -# warn "$cat_borrower, $type, * = ".Data::Dumper::Dumper($result); - - if ( $result->{maxissueqty} ne '' ) { -# warn "checking on 1 parameter (default branch + categorycode)"; - $sth2->execute( $borrower->{'borrowernumber'}, $type ); - my $alreadyissued = $sth2->fetchrow; - if ( $result->{'maxissueqty'} <= $alreadyissued ) { - return ( "$alreadyissued / ".( $result->{maxissueqty} + 0 )." (rule on default branch/category/itemtype failed)" ); - } - # now checking for total - $sth->execute( $cat_borrower, '*', '*' ); - my $result = $sth->fetchrow_hashref; - if ( $result->{maxissueqty} ne '' ) { - $sth2->execute( $borrower->{'borrowernumber'}, $type ); - my $alreadyissued = $sth2->fetchrow; - if ( $result->{'maxissueqty'} <= $alreadyissued ) { - return ( "$alreadyissued / ".( $result->{maxissueqty} + 0 )." (rule on default branch / category / total failed)" ); - } + + my $count_sth = $dbh->prepare($count_query); + $count_sth->execute(@bind_params); + my ($current_loan_count) = $count_sth->fetchrow_array; + + my $max_loans_allowed = $issuing_rule->{'maxissueqty'}; + if ($current_loan_count >= $max_loans_allowed) { + return "$current_loan_count / $max_loans_allowed"; } } - # check the 0 parameters (default branch / itemtype / default categorycode - $sth->execute( '*', $type, '*' ); - $result = $sth->fetchrow_hashref; -# warn "*, $type, * = ".Data::Dumper::Dumper($result); - - if ( $result->{maxissueqty} ne '' ) { -# warn "checking on default branch and default categorycode"; - $sth2->execute( $borrower->{'borrowernumber'}, $type ); - my $alreadyissued = $sth2->fetchrow; - if ( $result->{'maxissueqty'} <= $alreadyissued ) { - return ( "$alreadyissued / ".( $result->{maxissueqty} + 0 )." (rule on default branch / default category / itemtype failed)" ); + # Now count total loans against the limit for the branch + my $branch_borrower_circ_rule = GetBranchBorrowerCircRule($branch, $cat_borrower); + if (defined($branch_borrower_circ_rule->{maxissueqty})) { + my @bind_params = (); + my $branch_count_query = "SELECT COUNT(*) FROM issues + JOIN items USING (itemnumber) + WHERE borrowernumber = ? "; + push @bind_params, $borrower->{borrowernumber}; + + if (C4::Context->preference('CircControl') eq 'PickupLibrary') { + $branch_count_query .= " AND issues.branchcode = ? "; + push @bind_params, $branch; + } elsif (C4::Context->preference('CircControl') eq 'PatronLibrary') { + ; # if branch is the patron's home branch, then count all loans by patron + } else { + $branch_count_query .= " AND items.homebranch = ? "; + push @bind_params, $branch; } - } - # now checking for total - $sth->execute( '*', '*', '*' ); - $result = $sth->fetchrow_hashref; - if ( $result->{maxissueqty} ne '' ) { - warn "checking total"; - $sth2->execute( $borrower->{'borrowernumber'}, $type ); - my $alreadyissued = $sth2->fetchrow; - if ( $result->{'maxissueqty'} <= $alreadyissued ) { - return ( "$alreadyissued / ".( $result->{maxissueqty} + 0 )." (rule on default branch / default category / total failed)" ); - } - } + my $branch_count_sth = $dbh->prepare($branch_count_query); + $branch_count_sth->execute(@bind_params); + my ($current_loan_count) = $branch_count_sth->fetchrow_array; + + my $max_loans_allowed = $branch_borrower_circ_rule->{maxissueqty}; + if ($current_loan_count >= $max_loans_allowed) { + return "$current_loan_count / $max_loans_allowed"; + } + } # OK, the patron can issue !!! return; @@ -569,12 +506,6 @@ The borrower number of the last three patrons who borrowed this item. sub itemissues { my ( $bibitem, $biblio ) = @_; my $dbh = C4::Context->dbh; - - # FIXME - If this function die()s, the script will abort, and the - # user won't get anything; depending on how far the script has - # gotten, the user might get a blank page. It would be much better - # to at least print an error message. The easiest way to do this - # is to set $SIG{__DIE__}. my $sth = $dbh->prepare("Select * from items where items.biblioitemnumber = ?") || die $dbh->errstr; @@ -596,7 +527,6 @@ sub itemissues { "SELECT * FROM issues LEFT JOIN borrowers ON issues.borrowernumber = borrowers.borrowernumber WHERE itemnumber = ? - AND returndate IS NULL " ); @@ -607,22 +537,16 @@ sub itemissues { $data->{'borrower'} = $data2->{'borrowernumber'}; } else { - if ( $data->{'wthdrawn'} eq '1' ) { - $data->{'date_due'} = 'Cancelled'; - } - else { - $data->{'date_due'} = 'Available'; - } # else - } # else + $data->{'date_due'} = ($data->{'wthdrawn'} eq '1') ? 'Cancelled' : 'Available'; + } $sth2->finish; # Find the last 3 people who borrowed this item. $sth2 = $dbh->prepare( - "SELECT * FROM issues + "SELECT * FROM old_issues LEFT JOIN borrowers ON issues.borrowernumber = borrowers.borrowernumber WHERE itemnumber = ? - AND returndate IS NOT NULL ORDER BY returndate DESC,timestamp DESC" ); @@ -647,11 +571,92 @@ sub itemissues { =head2 CanBookBeIssued -$issuingimpossible, $needsconfirmation = - CanBookBeIssued( $borrower, $barcode, $duedatespec, $inprocess ); -C<$duedatespec> is a C4::Dates object. +Check if a book can be issued. + +( $issuingimpossible, $needsconfirmation ) = CanBookBeIssued( $borrower, $barcode, $duedatespec, $inprocess ); + C<$issuingimpossible> and C<$needsconfirmation> are some hashref. +=over 4 + +=item C<$borrower> hash with borrower informations (from GetMemberDetails) + +=item C<$barcode> is the bar code of the book being issued. + +=item C<$duedatespec> is a C4::Dates object. + +=item C<$inprocess> + +=back + +Returns : + +=over 4 + +=item C<$issuingimpossible> a reference to a hash. It contains reasons why issuing is impossible. +Possible values are : + +=back + +=head3 INVALID_DATE + +sticky due date is invalid + +=head3 GNA + +borrower gone with no address + +=head3 CARD_LOST + +borrower declared it's card lost + +=head3 DEBARRED + +borrower debarred + +=head3 UNKNOWN_BARCODE + +barcode unknown + +=head3 NOT_FOR_LOAN + +item is not for loan + +=head3 WTHDRAWN + +item withdrawn. + +=head3 RESTRICTED + +item is restricted (set by ??) + +C<$issuingimpossible> a reference to a hash. It contains reasons why issuing is impossible. +Possible values are : + +=head3 DEBT + +borrower has debts. + +=head3 RENEW_ISSUE + +renewing, not issuing + +=head3 ISSUED_TO_ANOTHER + +issued to someone else. + +=head3 RESERVED + +reserved for someone else. + +=head3 INVALID_DATE + +sticky due date is invalid + +=head3 TOO_MANY + +if the borrower borrows to much things + =cut sub CanBookBeIssued { @@ -661,17 +666,40 @@ sub CanBookBeIssued { my $item = GetItem(GetItemnumberFromBarcode( $barcode )); my $issue = GetItemIssue($item->{itemnumber}); my $biblioitem = GetBiblioItemData($item->{biblioitemnumber}); - $item->{'itemtype'}=$biblioitem->{'itemtype'}; + $item->{'itemtype'}=$item->{'itype'}; my $dbh = C4::Context->dbh; + # MANDATORY CHECKS - unless item exists, nothing else matters + unless ( $item->{barcode} ) { + $issuingimpossible{UNKNOWN_BARCODE} = 1; + } + return ( \%issuingimpossible, \%needsconfirmation ) if %issuingimpossible; + # # DUE DATE is OK ? -- should already have checked. # - #$issuingimpossible{INVALID_DATE} = 1 unless ($duedate); + unless ( $duedate ) { + my $issuedate = strftime( "%Y-%m-%d", localtime ); + my $branch = (C4::Context->preference('CircControl') eq 'PickupLibrary') ? C4::Context->userenv->{'branch'} : + (C4::Context->preference('CircControl') eq 'PatronLibrary') ? $borrower->{'branchcode'} : + $item->{'homebranch'}; # fallback to item's homebranch + my $itype = ( C4::Context->preference('item-level_itypes') ) ? $item->{'itype'} : $biblioitem->{'itemtype'}; + my $loanlength = GetLoanLength( $borrower->{'categorycode'}, $itype, $branch ); + $duedate = CalcDateDue( C4::Dates->new( $issuedate, 'iso' ), $loanlength, $branch, $borrower ); + + # Offline circ calls AddIssue directly, doesn't run through here + # So issuingimpossible should be ok. + } + $issuingimpossible{INVALID_DATE} = $duedate->output('syspref') unless ( $duedate && $duedate->output('iso') ge C4::Dates->today('iso') ); # # BORROWER STATUS # + if ( $borrower->{'category_type'} eq 'X' && ( $item->{barcode} )) { + # stats only borrower -- add entry to statistics table, and return issuingimpossible{STATS} = 1 . + &UpdateStats(C4::Context->userenv->{'branch'},'localuse','','',$item->{'itemnumber'},$item->{'itemtype'},$borrower->{'borrowernumber'}); + return( { STATS => 1 }, {}); + } if ( $borrower->{flags}->{GNA} ) { $issuingimpossible{GNA} = 1; } @@ -702,13 +730,13 @@ sub CanBookBeIssued { if ( $amount > $amountlimit && !$inprocess ) { $issuingimpossible{DEBT} = sprintf( "%.2f", $amount ); } - elsif ( $amount <= $amountlimit && !$inprocess ) { + elsif ( $amount > 0 && $amount <= $amountlimit && !$inprocess ) { $needsconfirmation{DEBT} = sprintf( "%.2f", $amount ); } } else { if ( $amount > 0 ) { - $needsconfirmation{DEBT} = $amount; + $needsconfirmation{DEBT} = sprintf( "%.2f", $amount ); } } @@ -716,35 +744,41 @@ sub CanBookBeIssued { # JB34 CHECKS IF BORROWERS DONT HAVE ISSUE TOO MANY BOOKS # my $toomany = TooMany( $borrower, $item->{biblionumber}, $item ); - $needsconfirmation{TOO_MANY} = $toomany if $toomany; + # if TooMany return / 0, then the user has no permission to check out this book + if ($toomany =~ /\/ 0/) { + $needsconfirmation{PATRON_CANT} = 1; + } else { + $needsconfirmation{TOO_MANY} = $toomany if $toomany; + } # # ITEM CHECKING # - unless ( $item->{barcode} ) { - $issuingimpossible{UNKNOWN_BARCODE} = 1; - } if ( $item->{'notforloan'} && $item->{'notforloan'} > 0 ) { - $issuingimpossible{NOT_FOR_LOAN} = 1; + if(!C4::Context->preference("AllowNotForLoanOverride")){ + $issuingimpossible{NOT_FOR_LOAN} = 1; + }else{ + $needsconfirmation{NOT_FOR_LOAN_FORCING} = 1; + } + } + elsif ( !$item->{'notforloan'} ){ + # we have to check itemtypes.notforloan also + if (C4::Context->preference('item-level_itypes')){ + # this should probably be a subroutine + my $sth = $dbh->prepare("SELECT notforloan FROM itemtypes WHERE itemtype = ?"); + $sth->execute($item->{'itemtype'}); + my $notforloan=$sth->fetchrow_hashref(); + $sth->finish(); + if ($notforloan->{'notforloan'} == 1){ + $issuingimpossible{NOT_FOR_LOAN} = 1; + } + } + elsif ($biblioitem->{'notforloan'} == 1){ + $issuingimpossible{NOT_FOR_LOAN} = 1; + } } - elsif ( !$item->{'notforloan'} ){ - # we have to check itemtypes.notforloan also - if (C4::Context->preference('item-level_itypes')){ - # this should probably be a subroutine - my $sth = $dbh->prepare("SELECT notforloan FROM itemtypes WHERE itemtype = ?"); - $sth->execute($item->{'itemtype'}); - my $notforloan=$sth->fetchrow_hashref(); - $sth->finish(); - if ($notforloan->{'notforloan'} == 1){ - $issuingimpossible{NOT_FOR_LOAN} = 1; - } - } - elsif ($biblioitem->{'notforloan'} == 1){ - $issuingimpossible{NOT_FOR_LOAN} = 1; - } - } if ( $item->{'wthdrawn'} && $item->{'wthdrawn'} == 1 ) { $issuingimpossible{WTHDRAWN} = 1; @@ -758,7 +792,7 @@ sub CanBookBeIssued { my $userenv = C4::Context->userenv; if ( ($userenv) && ( $userenv->{flags} != 1 ) ) { $issuingimpossible{NOTSAMEBRANCH} = 1 - if ( $item->{C4::Context->preference("HomeOrHoldingbranch")} ne $userenv->{branch} ); + if ( $item->{C4::Context->preference("HomeOrHoldingBranch")} ne $userenv->{branch} ); } } @@ -770,7 +804,7 @@ sub CanBookBeIssued { # Already issued to current borrower. Ask whether the loan should # be renewed. - my ($CanBookBeRenewed) = CanBookBeRenewed( + my ($CanBookBeRenewed,$renewerror) = CanBookBeRenewed( $borrower->{'borrowernumber'}, $item->{'itemnumber'} ); @@ -784,7 +818,7 @@ sub CanBookBeIssued { elsif ($issue->{borrowernumber}) { # issued to someone else - my $currborinfo = GetMemberDetails( $issue->{borrowernumber} ); + my $currborinfo = C4::Members::GetMemberDetails( $issue->{borrowernumber} ); # warn "=>.$currborinfo->{'firstname'} $currborinfo->{'surname'} ($currborinfo->{'cardnumber'})"; $needsconfirmation{ISSUED_TO_ANOTHER} = @@ -794,98 +828,81 @@ sub CanBookBeIssued { # See if the item is on reserve. my ( $restype, $res ) = C4::Reserves::CheckReserves( $item->{'itemnumber'} ); if ($restype) { - my $resbor = $res->{'borrowernumber'}; + my $resbor = $res->{'borrowernumber'}; + my ( $resborrower ) = C4::Members::GetMemberDetails( $resbor, 0 ); + my $branches = GetBranches(); + my $branchname = $branches->{ $res->{'branchcode'} }->{'branchname'}; if ( $resbor ne $borrower->{'borrowernumber'} && $restype eq "Waiting" ) { - # The item is on reserve and waiting, but has been # reserved by some other patron. - my ( $resborrower, $flags ) = - GetMemberDetails( $resbor, 0 ); - my $branches = GetBranches(); - my $branchname = - $branches->{ $res->{'branchcode'} }->{'branchname'}; $needsconfirmation{RESERVE_WAITING} = "$resborrower->{'firstname'} $resborrower->{'surname'} ($resborrower->{'cardnumber'}, $branchname)"; - -# CancelReserve(0, $res->{'itemnumber'}, $res->{'borrowernumber'}); Doesn't belong in a checking subroutine. } elsif ( $restype eq "Reserved" ) { - # The item is on reserve for someone else. - my ( $resborrower, $flags ) = - GetMemberDetails( $resbor, 0 ); - my $branches = GetBranches(); - my $branchname = - $branches->{ $res->{'branchcode'} }->{'branchname'}; $needsconfirmation{RESERVED} = "$res->{'reservedate'} : $resborrower->{'firstname'} $resborrower->{'surname'} ($resborrower->{'cardnumber'})"; } } - if ( C4::Context->preference("LibraryName") eq "Horowhenua Library Trust" ) { - if ( $borrower->{'categorycode'} eq 'W' ) { - my %issuingimpossible; - return ( \%issuingimpossible, \%needsconfirmation ); - } else { - return ( \%issuingimpossible, \%needsconfirmation ); - } - } else { - return ( \%issuingimpossible, \%needsconfirmation ); - } + return ( \%issuingimpossible, \%needsconfirmation ); } =head2 AddIssue Issue a book. Does no check, they are done in CanBookBeIssued. If we reach this sub, it means the user confirmed if needed. -&AddIssue($borrower,$barcode,$date) +&AddIssue($borrower, $barcode, [$datedue], [$cancelreserve], [$issuedate]) =over 4 -=item C<$borrower> hash with borrower informations (from GetMemberDetails) +=item C<$borrower> is a hash with borrower informations (from GetMemberDetails). -=item C<$barcode> is the bar code of the book being issued. +=item C<$barcode> is the barcode of the item being issued. + +=item C<$datedue> is a C4::Dates object for the max date of return, i.e. the date due (optional). +Calculated if empty. + +=item C<$cancelreserve> is 1 to override and cancel any pending reserves for the item (optional). -=item C<$date> contains the max date of return. calculated if empty. +=item C<$issuedate> is the date to issue the item in iso (YYYY-MM-DD) format (optional). +Defaults to today. Unlike C<$datedue>, NOT a C4::Dates object, unfortunately. AddIssue does the following things : -- step 01: check that there is a borrowernumber & a barcode provided -- check for RENEWAL (book issued & being issued to the same patron) - - renewal YES = Calculate Charge & renew - - renewal NO = - * BOOK ACTUALLY ISSUED ? do a return if book is actually issued (but to someone else) - * RESERVE PLACED ? - - fill reserve if reserve to this patron - - cancel reserve or not, otherwise - * TRANSFERT PENDING ? - - complete the transfert - * ISSUE THE BOOK + + - step 01: check that there is a borrowernumber & a barcode provided + - check for RENEWAL (book issued & being issued to the same patron) + - renewal YES = Calculate Charge & renew + - renewal NO = + * BOOK ACTUALLY ISSUED ? do a return if book is actually issued (but to someone else) + * RESERVE PLACED ? + - fill reserve if reserve to this patron + - cancel reserve or not, otherwise + * TRANSFERT PENDING ? + - complete the transfert + * ISSUE THE BOOK =back =cut sub AddIssue { - my ( $borrower, $barcode, $date, $cancelreserve ) = @_; + my ( $borrower, $barcode, $datedue, $cancelreserve, $issuedate, $sipmode) = @_; my $dbh = C4::Context->dbh; my $barcodecheck=CheckValidBarcode($barcode); + + # $issuedate defaults to today. + if ( ! defined $issuedate ) { + $issuedate = strftime( "%Y-%m-%d", localtime ); + # TODO: for hourly circ, this will need to be a C4::Dates object + # and all calls to AddIssue including issuedate will need to pass a Dates object. + } if ($borrower and $barcode and $barcodecheck ne '0'){ # find which item we issue - my $item = GetItem('', $barcode); - my $datedue; - - my $branch; - # Get which branchcode we need - if (C4::Context->preference('CircControl') eq 'PickupLibary'){ - $branch = C4::Context->userenv->{'branchcode'}; - } - elsif (C4::Context->preference('CircControl') eq 'PatronLibary'){ - $branch = $borrower->{'branchcode'}; - } - else { - # items home library - $branch = $item->{'homebranch'}; - } + my $item = GetItem('', $barcode) or return undef; # if we don't get an Item, abort. + my $branch = (C4::Context->preference('CircControl') eq 'PickupLibrary') ? C4::Context->userenv->{'branch'} : + (C4::Context->preference('CircControl') eq 'PatronLibrary') ? $borrower->{'branchcode'} : + $item->{'homebranch'}; # fallback to item's homebranch # get actual issuing if there is one my $actualissue = GetItemIssue( $item->{itemnumber}); @@ -896,14 +913,14 @@ sub AddIssue { # # check if we just renew the issue. # - if ( $actualissue->{borrowernumber} eq $borrower->{'borrowernumber'} ) { - AddRenewal( + if ($actualissue->{borrowernumber} eq $borrower->{'borrowernumber'}) { + $datedue = AddRenewal( $borrower->{'borrowernumber'}, $item->{'itemnumber'}, $branch, - $date + $datedue, + $issuedate, # here interpreted as the renewal date ); - } else { # it's NOT a renewal @@ -922,36 +939,23 @@ sub AddIssue { if ($restype) { my $resbor = $res->{'borrowernumber'}; if ( $resbor eq $borrower->{'borrowernumber'} ) { - # The item is reserved by the current patron ModReserveFill($res); } elsif ( $restype eq "Waiting" ) { - # warn "Waiting"; # The item is on reserve and waiting, but has been # reserved by some other patron. - my ( $resborrower, $flags ) = GetMemberDetails( $resbor, 0 ); - my $branches = GetBranches(); - my $branchname = - $branches->{ $res->{'branchcode'} }->{'branchname'}; } elsif ( $restype eq "Reserved" ) { - # warn "Reserved"; # The item is reserved by someone else. - my ( $resborrower, $flags ) = - GetMemberDetails( $resbor, 0 ); - my $branches = GetBranches(); - my $branchname = $branches->{ $res->{'branchcode'} }->{'branchname'}; if ($cancelreserve) { # cancel reserves on this item - CancelReserve( 0, $res->{'itemnumber'}, - $res->{'borrowernumber'} ); + CancelReserve(0, $res->{'itemnumber'}, $res->{'borrowernumber'}); } } if ($cancelreserve) { - CancelReserve( $res->{'biblionumber'}, 0, - $res->{'borrowernumber'} ); + CancelReserve($res->{'biblionumber'}, 0, $res->{'borrowernumber'}); } else { # set waiting reserve to first in reserve queue as book isn't waiting now @@ -966,17 +970,16 @@ sub AddIssue { # Starting process for transfer job (checking transfert and validate it if we have one) my ($datesent) = GetTransfers($item->{'itemnumber'}); if ($datesent) { - # updating line of branchtranfert to finish it, and changing the to branch value, implement a comment for lisibility of this case (maybe for stats ....) - my $sth = + # updating line of branchtranfert to finish it, and changing the to branch value, implement a comment for visibility of this case (maybe for stats ....) + my $sth = $dbh->prepare( "UPDATE branchtransfers SET datearrived = now(), tobranch = ?, - comments = 'Forced branchtransfert' + comments = 'Forced branchtransfer' WHERE itemnumber= ? AND datearrived IS NULL" ); - $sth->execute(C4::Context->userenv->{'branch'},$item->{'itemnumber'}); - $sth->finish; + $sth->execute(C4::Context->userenv->{'branch'},$item->{'itemnumber'}); } # Record in the database the fact that the book was issued. @@ -986,30 +989,18 @@ sub AddIssue { (borrowernumber, itemnumber,issuedate, date_due, branchcode) VALUES (?,?,?,?,?)" ); - my $dateduef; - if ($date) { - $dateduef = $date; - } else { - my $itype=(C4::Context->preference('item-level_itypes')) ? $biblio->{'itype'} : $biblio->{'itemtype'} ; - my $loanlength = GetLoanLength( - $borrower->{'categorycode'}, - $itype, - $branch - ); - $datedue = time + ($loanlength) * 86400; - my @datearr = localtime($datedue); - $dateduef = C4::Dates->new( sprintf("%04d-%02d-%02d", 1900 + $datearr[5], $datearr[4] + 1, $datearr[3]), 'iso'); - $dateduef=CheckValidDatedue($dateduef,$item->{'itemnumber'},C4::Context->userenv->{'branch'}); - - # if ReturnBeforeExpiry ON the datedue can't be after borrower expirydate - if ( C4::Context->preference('ReturnBeforeExpiry') && $dateduef->output('iso') gt $borrower->{dateexpiry} ) { - $dateduef = C4::Dates->new($borrower->{dateexpiry},'iso'); - } - }; - $sth->execute( - $borrower->{'borrowernumber'}, - $item->{'itemnumber'}, - strftime( "%Y-%m-%d", localtime ),$dateduef->output('iso'), C4::Context->userenv->{'branch'} + unless ($datedue) { + my $itype = ( C4::Context->preference('item-level_itypes') ) ? $biblio->{'itype'} : $biblio->{'itemtype'}; + my $loanlength = GetLoanLength( $borrower->{'categorycode'}, $itype, $branch ); + $datedue = CalcDateDue( C4::Dates->new( $issuedate, 'iso' ), $loanlength, $branch, $borrower ); + + } + $sth->execute( + $borrower->{'borrowernumber'}, # borrowernumber + $item->{'itemnumber'}, # itemnumber + $issuedate, # issuedate + $datedue->output('iso'), # date_due + C4::Context->userenv->{'branch'} # branchcode ); $sth->finish; $item->{'issues'}++; @@ -1017,10 +1008,10 @@ sub AddIssue { holdingbranch => C4::Context->userenv->{'branch'}, itemlost => 0, datelastborrowed => C4::Dates->new()->output('iso'), - onloan => $dateduef->output('iso'), + onloan => $datedue->output('iso'), }, $item->{'biblionumber'}, $item->{'itemnumber'}); ModDateLastSeen( $item->{'itemnumber'} ); - + # If it costs to borrow this book, charge it to the patron's account. my ( $charge, $itemtype ) = GetIssuingCharges( $item->{'itemnumber'}, @@ -1037,16 +1028,33 @@ sub AddIssue { # Record the fact that this book was issued. &UpdateStats( C4::Context->userenv->{'branch'}, - 'issue', $charge, - '', $item->{'itemnumber'}, - $item->{'itemtype'}, $borrower->{'borrowernumber'} + 'issue', $charge, + ($sipmode ? "SIP-$sipmode" : ''), $item->{'itemnumber'}, + $item->{'itype'}, $borrower->{'borrowernumber'} + ); + + # Send a checkout slip. + my $circulation_alert = 'C4::ItemCirculationAlertPreference'; + my %conditions = ( + branchcode => $branch, + categorycode => $borrower->{categorycode}, + item_type => $item->{itype}, + notification => 'CHECKOUT', ); + if ($circulation_alert->is_enabled_for(\%conditions)) { + SendCirculationAlert({ + type => 'CHECKOUT', + item => $item, + borrower => $borrower, + branch => $branch, + }); + } } - - &logaction(C4::Context->userenv->{'number'},"CIRCULATION","ISSUE",$borrower->{'borrowernumber'},$biblio->{'biblionumber'}) + + logaction("CIRCULATION", "ISSUE", $borrower->{'borrowernumber'}, $biblio->{'biblionumber'}) if C4::Context->preference("IssueLog"); - return ($datedue); } + return ($datedue); # not necessarily the same as when it came in! } =head2 GetLoanLength @@ -1072,27 +1080,27 @@ sub GetLoanLength { return $loanlength->{issuelength} if defined($loanlength) && $loanlength->{issuelength} ne 'NULL'; - $sth->execute( $borrowertype, $itemtype, "*" ); + $sth->execute( $borrowertype, "*", $branchcode ); $loanlength = $sth->fetchrow_hashref; return $loanlength->{issuelength} if defined($loanlength) && $loanlength->{issuelength} ne 'NULL'; - $sth->execute( $borrowertype, "*", $branchcode ); + $sth->execute( "*", $itemtype, $branchcode ); $loanlength = $sth->fetchrow_hashref; return $loanlength->{issuelength} if defined($loanlength) && $loanlength->{issuelength} ne 'NULL'; - $sth->execute( "*", $itemtype, $branchcode ); + $sth->execute( "*", "*", $branchcode ); $loanlength = $sth->fetchrow_hashref; return $loanlength->{issuelength} if defined($loanlength) && $loanlength->{issuelength} ne 'NULL'; - $sth->execute( $borrowertype, "*", "*" ); + $sth->execute( $borrowertype, $itemtype, "*" ); $loanlength = $sth->fetchrow_hashref; return $loanlength->{issuelength} if defined($loanlength) && $loanlength->{issuelength} ne 'NULL'; - $sth->execute( "*", "*", $branchcode ); + $sth->execute( $borrowertype, "*", "*" ); $loanlength = $sth->fetchrow_hashref; return $loanlength->{issuelength} if defined($loanlength) && $loanlength->{issuelength} ne 'NULL'; @@ -1111,16 +1119,235 @@ sub GetLoanLength { return 21; } +=head2 GetIssuingRule + +FIXME - This is a copy-paste of GetLoanLength +as a stop-gap. Do not wish to change API for GetLoanLength +this close to release, however, Overdues::GetIssuingRules is broken. + +Get the issuing rule for an itemtype, a borrower type and a branch +Returns a hashref from the issuingrules table. + +my $irule = &GetIssuingRule($borrowertype,$itemtype,branchcode) + +=cut + +sub GetIssuingRule { + my ( $borrowertype, $itemtype, $branchcode ) = @_; + my $dbh = C4::Context->dbh; + my $sth = $dbh->prepare( "select * from issuingrules where categorycode=? and itemtype=? and branchcode=? and issuelength is not null" ); + my $irule; + + $sth->execute( $borrowertype, $itemtype, $branchcode ); + $irule = $sth->fetchrow_hashref; + return $irule if defined($irule) ; + + $sth->execute( $borrowertype, "*", $branchcode ); + $irule = $sth->fetchrow_hashref; + return $irule if defined($irule) ; + + $sth->execute( "*", $itemtype, $branchcode ); + $irule = $sth->fetchrow_hashref; + return $irule if defined($irule) ; + + $sth->execute( "*", "*", $branchcode ); + $irule = $sth->fetchrow_hashref; + return $irule if defined($irule) ; + + $sth->execute( $borrowertype, $itemtype, "*" ); + $irule = $sth->fetchrow_hashref; + return $irule if defined($irule) ; + + $sth->execute( $borrowertype, "*", "*" ); + $irule = $sth->fetchrow_hashref; + return $irule if defined($irule) ; + + $sth->execute( "*", $itemtype, "*" ); + $irule = $sth->fetchrow_hashref; + return $irule if defined($irule) ; + + $sth->execute( "*", "*", "*" ); + $irule = $sth->fetchrow_hashref; + return $irule if defined($irule) ; + + # if no rule matches, + return undef; +} + +=head2 GetBranchBorrowerCircRule + +=over 4 + +my $branch_cat_rule = GetBranchBorrowerCircRule($branchcode, $categorycode); + +=back + +Retrieves circulation rule attributes that apply to the given +branch and patron category, regardless of item type. +The return value is a hashref containing the following key: + +maxissueqty - maximum number of loans that a +patron of the given category can have at the given +branch. If the value is undef, no limit. + +This will first check for a specific branch and +category match from branch_borrower_circ_rules. + +If no rule is found, it will then check default_branch_circ_rules +(same branch, default category). If no rule is found, +it will then check default_borrower_circ_rules (default +branch, same category), then failing that, default_circ_rules +(default branch, default category). + +If no rule has been found in the database, it will default to +the buillt in rule: + +maxissueqty - undef + +C<$branchcode> and C<$categorycode> should contain the +literal branch code and patron category code, respectively - no +wildcards. + +=cut + +sub GetBranchBorrowerCircRule { + my $branchcode = shift; + my $categorycode = shift; + + my $branch_cat_query = "SELECT maxissueqty + FROM branch_borrower_circ_rules + WHERE branchcode = ? + AND categorycode = ?"; + my $dbh = C4::Context->dbh(); + my $sth = $dbh->prepare($branch_cat_query); + $sth->execute($branchcode, $categorycode); + my $result; + if ($result = $sth->fetchrow_hashref()) { + return $result; + } + + # try same branch, default borrower category + my $branch_query = "SELECT maxissueqty + FROM default_branch_circ_rules + WHERE branchcode = ?"; + $sth = $dbh->prepare($branch_query); + $sth->execute($branchcode); + if ($result = $sth->fetchrow_hashref()) { + return $result; + } + + # try default branch, same borrower category + my $category_query = "SELECT maxissueqty + FROM default_borrower_circ_rules + WHERE categorycode = ?"; + $sth = $dbh->prepare($category_query); + $sth->execute($categorycode); + if ($result = $sth->fetchrow_hashref()) { + return $result; + } + + # try default branch, default borrower category + my $default_query = "SELECT maxissueqty + FROM default_circ_rules"; + $sth = $dbh->prepare($default_query); + $sth->execute(); + if ($result = $sth->fetchrow_hashref()) { + return $result; + } + + # built-in default circulation rule + return { + maxissueqty => undef, + }; +} + +=head2 GetBranchItemRule + +=over 4 + +my $branch_item_rule = GetBranchItemRule($branchcode, $itemtype); + +=back + +Retrieves circulation rule attributes that apply to the given +branch and item type, regardless of patron category. + +The return value is a hashref containing the following key: + +holdallowed => Hold policy for this branch and itemtype. Possible values: + 0: No holds allowed. + 1: Holds allowed only by patrons that have the same homebranch as the item. + 2: Holds allowed from any patron. + +This searches branchitemrules in the following order: + + * Same branchcode and itemtype + * Same branchcode, itemtype '*' + * branchcode '*', same itemtype + * branchcode and itemtype '*' + +Neither C<$branchcode> nor C<$categorycode> should be '*'. + +=cut + +sub GetBranchItemRule { + my ( $branchcode, $itemtype ) = @_; + my $dbh = C4::Context->dbh(); + my $result = {}; + + my @attempts = ( + ['SELECT holdallowed + FROM branch_item_rules + WHERE branchcode = ? + AND itemtype = ?', $branchcode, $itemtype], + ['SELECT holdallowed + FROM default_branch_circ_rules + WHERE branchcode = ?', $branchcode], + ['SELECT holdallowed + FROM default_branch_item_rules + WHERE itemtype = ?', $itemtype], + ['SELECT holdallowed + FROM default_circ_rules'], + ); + + foreach my $attempt (@attempts) { + my ($query, @bind_params) = @{$attempt}; + + # Since branch/category and branch/itemtype use the same per-branch + # defaults tables, we have to check that the key we want is set, not + # just that a row was returned + return $result if ( defined( $result->{'holdallowed'} = $dbh->selectrow_array( $query, {}, @bind_params ) ) ); + } + + # built-in default circulation rule + return { + holdallowed => 2, + }; +} + =head2 AddReturn ($doreturn, $messages, $iteminformation, $borrower) = - &AddReturn($barcode, $branch, $exemptfine); + &AddReturn($barcode, $branch, $exemptfine, $dropbox); Returns a book. -C<$barcode> is the bar code of the book being returned. C<$branch> is -the code of the branch where the book is being returned. C<$exemptfine> -indicates that overdue charges for the item will not be applied. +=over 4 + +=item C<$barcode> is the bar code of the book being returned. + +=item C<$branch> is the code of the branch where the book is being returned. + +=item C<$exemptfine> indicates that overdue charges for the item will be +removed. + +=item C<$dropbox> indicates that the check-in date is assumed to be +yesterday, or the last non-holiday as defined in C4::Calendar . If +overdue charges are applied and C<$dropbox> is true, the last charge +will be removed. This assumes that the fines accrual script has run +for _today_. + +=back C<&AddReturn> returns a list of four items: @@ -1163,7 +1390,7 @@ patron who last borrowed the book. =cut sub AddReturn { - my ( $barcode, $branch, $exemptfine ) = @_; + my ( $barcode, $branch, $exemptfine, $dropbox ) = @_; my $dbh = C4::Context->dbh; my $messages; my $doreturn = 1; @@ -1182,12 +1409,19 @@ sub AddReturn { # find the borrower if ( ( not $iteminformation->{borrowernumber} ) && $doreturn ) { $messages->{'NotIssued'} = $barcode; + # even though item is not on loan, it may still + # be transferred; therefore, get current branch information + my $curr_iteminfo = GetItem($iteminformation->{'itemnumber'}); + $iteminformation->{'homebranch'} = $curr_iteminfo->{'homebranch'}; + $iteminformation->{'holdingbranch'} = $curr_iteminfo->{'holdingbranch'}; + $iteminformation->{'itemlost'} = $curr_iteminfo->{'itemlost'}; $doreturn = 0; } # check if the book is in a permanent collection.... - my $hbr = $iteminformation->{'homebranch'}; + my $hbr = $iteminformation->{C4::Context->preference("HomeOrHoldingBranch")}; my $branches = GetBranches(); + # FIXME -- This 'PE' attribute is largely undocumented. afaict, there's no user interface that reflects this functionality. if ( $hbr && $branches->{$hbr}->{'PE'} ) { $messages->{'IsPermanent'} = $hbr; } @@ -1212,29 +1446,38 @@ sub AddReturn { # case of a return of document (deal with issues and holdingbranch) if ($doreturn) { - my $sth = - $dbh->prepare( - "UPDATE issues SET returndate = now() WHERE (borrowernumber = ?) AND (itemnumber = ?) AND (returndate IS NULL)" - ); - $sth->execute( $borrower->{'borrowernumber'}, - $iteminformation->{'itemnumber'} ); + my $circControlBranch; + if($dropbox) { + # don't allow dropbox mode to create an invalid entry in issues (issuedate > returndate) FIXME: actually checks eq, not gt + undef($dropbox) if ( $iteminformation->{'issuedate'} eq C4::Dates->today('iso') ); + if (C4::Context->preference('CircControl') eq 'ItemHomeBranch' ) { + $circControlBranch = $iteminformation->{homebranch}; + } elsif ( C4::Context->preference('CircControl') eq 'PatronLibrary') { + $circControlBranch = $borrower->{branchcode}; + } else { # CircControl must be PickupLibrary. + $circControlBranch = $iteminformation->{holdingbranch}; + # FIXME - is this right ? are we sure that the holdingbranch is still the pickup branch? + } + } + MarkIssueReturned($borrower->{'borrowernumber'}, $iteminformation->{'itemnumber'},$circControlBranch); $messages->{'WasReturned'} = 1; # FIXME is the "= 1" right? - } - - # continue to deal with returns cases, but not only if we have an issue + - # the holdingbranch is updated if the document is returned in an other location . - if ( $iteminformation->{'holdingbranch'} ne C4::Context->userenv->{'branch'} ) { - UpdateHoldingbranch(C4::Context->userenv->{'branch'},$iteminformation->{'itemnumber'}); - # reload iteminformation holdingbranch with the userenv value - $iteminformation->{'holdingbranch'} = C4::Context->userenv->{'branch'}; + # continue to deal with returns cases, but not only if we have an issue + + # the holdingbranch is updated if the document is returned in an other location . + if ( $iteminformation->{'holdingbranch'} ne C4::Context->userenv->{'branch'} ) { + UpdateHoldingbranch(C4::Context->userenv->{'branch'},$iteminformation->{'itemnumber'}); + # reload iteminformation holdingbranch with the userenv value + $iteminformation->{'holdingbranch'} = C4::Context->userenv->{'branch'}; + } + ModDateLastSeen( $iteminformation->{'itemnumber'} ); + ModItem({ onloan => undef }, $biblio->{'biblionumber'}, $iteminformation->{'itemnumber'}); + + if ($iteminformation->{borrowernumber}){ + ($borrower) = C4::Members::GetMemberDetails( $iteminformation->{borrowernumber}, 0 ); + } } - ModDateLastSeen( $iteminformation->{'itemnumber'} ); - ModItem({ onloan => undef }, $biblio->{'biblionumber'}, $iteminformation->{'itemnumber'}); - - if ($iteminformation->{borrowernumber}){ - ($borrower) = C4::Members::GetMemberDetails( $iteminformation->{borrowernumber}, 0 ); - } # fix up the accounts..... if ( $iteminformation->{'itemlost'} ) { $messages->{'WasLost'} = 1; @@ -1271,7 +1514,7 @@ sub AddReturn { } # fix up the overdues in accounts... FixOverduesOnReturn( $borrower->{'borrowernumber'}, - $iteminformation->{'itemnumber'}, $exemptfine ); + $iteminformation->{'itemnumber'}, $exemptfine, $dropbox ); # find reserves..... # if we don't have a reserve with the status W, we launch the Checkreserves routine @@ -1291,17 +1534,39 @@ sub AddReturn { $biblio->{'itemtype'}, $borrower->{'borrowernumber'} ); + + # Send a check-in slip. + my $circulation_alert = 'C4::ItemCirculationAlertPreference'; + my %conditions = ( + branchcode => $branch, + categorycode => $borrower->{categorycode}, + item_type => $iteminformation->{itype}, + notification => 'CHECKIN', + ); + if ($doreturn && $circulation_alert->is_enabled_for(\%conditions)) { + SendCirculationAlert({ + type => 'CHECKIN', + item => $iteminformation, + borrower => $borrower, + branch => $branch, + }); + } - &logaction(C4::Context->userenv->{'number'},"CIRCULATION","RETURN",$iteminformation->{borrowernumber},$iteminformation->{'biblionumber'}) + logaction("CIRCULATION", "RETURN", $iteminformation->{borrowernumber}, $iteminformation->{'biblionumber'}) if C4::Context->preference("ReturnLog"); #adding message if holdingbranch is non equal a userenv branch to return the document to homebranch #we check, if we don't have reserv or transfert for this document, if not, return it to homebranch . - if ( ($iteminformation->{'holdingbranch'} ne $iteminformation->{'homebranch'}) and not $messages->{'WrongTransfer'} and ($validTransfert ne 1) and ($reserveDone ne 1) ){ + if ($doreturn and ($branch ne $iteminformation->{'homebranch'}) and not $messages->{'WrongTransfer'} and ($validTransfert ne 1) and ($reserveDone ne 1) ){ if (C4::Context->preference("AutomaticItemReturn") == 1) { ModItemTransfer($iteminformation->{'itemnumber'}, C4::Context->userenv->{'branch'}, $iteminformation->{'homebranch'}); $messages->{'WasTransfered'} = 1; + } elsif ( C4::Context->preference("UseBranchTransferLimits") == 1 + && ! IsBranchTransferAllowed( $branch, $iteminformation->{'homebranch'}, $iteminformation->{ C4::Context->preference("BranchTransferLimitsType") } ) + ) { + ModItemTransfer($iteminformation->{'itemnumber'}, C4::Context->userenv->{'branch'}, $iteminformation->{'homebranch'}); + $messages->{'WasTransfered'} = 1; } else { $messages->{'NeedsTransfer'} = 1; @@ -1311,20 +1576,78 @@ sub AddReturn { return ( $doreturn, $messages, $iteminformation, $borrower ); } +=head2 MarkIssueReturned + +=over 4 + +MarkIssueReturned($borrowernumber, $itemnumber, $dropbox_branch, $returndate); + +=back + +Unconditionally marks an issue as being returned by +moving the C row to C and +setting C to the current date, or +the last non-holiday date of the branccode specified in +C . Assumes you've already checked that +it's safe to do this, i.e. last non-holiday > issuedate. + +if C<$returndate> is specified (in iso format), it is used as the date +of the return. It is ignored when a dropbox_branch is passed in. + +Ideally, this function would be internal to C, +not exported, but it is currently needed by one +routine in C. + +=cut + +sub MarkIssueReturned { + my ( $borrowernumber, $itemnumber, $dropbox_branch, $returndate ) = @_; + my $dbh = C4::Context->dbh; + my $query = "UPDATE issues SET returndate="; + my @bind; + if ($dropbox_branch) { + my $calendar = C4::Calendar->new( branchcode => $dropbox_branch ); + my $dropboxdate = $calendar->addDate( C4::Dates->new(), -1 ); + $query .= " ? "; + push @bind, $dropboxdate->output('iso'); + } elsif ($returndate) { + $query .= " ? "; + push @bind, $returndate; + } else { + $query .= " now() "; + } + $query .= " WHERE borrowernumber = ? AND itemnumber = ?"; + push @bind, $borrowernumber, $itemnumber; + # FIXME transaction + my $sth_upd = $dbh->prepare($query); + $sth_upd->execute(@bind); + my $sth_copy = $dbh->prepare("INSERT INTO old_issues SELECT * FROM issues + WHERE borrowernumber = ? + AND itemnumber = ?"); + $sth_copy->execute($borrowernumber, $itemnumber); + my $sth_del = $dbh->prepare("DELETE FROM issues + WHERE borrowernumber = ? + AND itemnumber = ?"); + $sth_del->execute($borrowernumber, $itemnumber); +} + =head2 FixOverduesOnReturn - &FixOverduesOnReturn($brn,$itm, $exemptfine); + &FixOverduesOnReturn($brn,$itm, $exemptfine, $dropboxmode); C<$brn> borrowernumber C<$itm> itemnumber +C<$exemptfine> BOOL -- remove overdue charge associated with this issue. +C<$dropboxmode> BOOL -- remove lastincrement on overdue charge associated with this issue. + internal function, called only by AddReturn =cut sub FixOverduesOnReturn { - my ( $borrowernumber, $item, $exemptfine ) = @_; + my ( $borrowernumber, $item, $exemptfine, $dropbox ) = @_; my $dbh = C4::Context->dbh; # check for overdue fine @@ -1337,10 +1660,30 @@ sub FixOverduesOnReturn { # alter fine to show that the book has been returned my $data; if ($data = $sth->fetchrow_hashref) { - my $uquery =($exemptfine)? "update accountlines set accounttype='FFOR', amountoutstanding=0":"update accountlines set accounttype='F' "; + my $uquery; + my @bind = ($borrowernumber,$item ,$data->{'accountno'}); + if ($exemptfine) { + $uquery = "update accountlines set accounttype='FFOR', amountoutstanding=0"; + if (C4::Context->preference("FinesLog")) { + &logaction("FINES", 'MODIFY',$borrowernumber,"Overdue forgiven: item $item"); + } + } elsif ($dropbox && $data->{lastincrement}) { + my $outstanding = $data->{amountoutstanding} - $data->{lastincrement} ; + my $amt = $data->{amount} - $data->{lastincrement} ; + if (C4::Context->preference("FinesLog")) { + &logaction("FINES", 'MODIFY',$borrowernumber,"Dropbox adjustment $amt, item $item"); + } + $uquery = "update accountlines set accounttype='F' "; + if($outstanding >= 0 && $amt >=0) { + $uquery .= ", amount = ? , amountoutstanding=? "; + unshift @bind, ($amt, $outstanding) ; + } + } else { + $uquery = "update accountlines set accounttype='F' "; + } $uquery .= " where (borrowernumber = ?) and (itemnumber = ?) and (accountno = ?)"; my $usth = $dbh->prepare($uquery); - $usth->execute($borrowernumber,$item ,$data->{'accountno'}); + $usth->execute(@bind); $usth->finish(); } @@ -1364,7 +1707,6 @@ Internal function, called by AddReturn sub FixAccountForLostAndReturned { my ($iteminfo, $borrower) = @_; - my %env; my $dbh = C4::Context->dbh; my $itm = $iteminfo->{'itemnumber'}; # check for charge made for lost book @@ -1389,7 +1731,7 @@ sub FixAccountForLostAndReturned { $usth->execute($data->{'borrowernumber'},$itm,$acctno); $usth->finish; #check if any credit is left if so writeoff other accounts - my $nextaccntno = getnextacctno(\%env,$data->{'borrowernumber'},$dbh); + my $nextaccntno = getnextacctno($data->{'borrowernumber'}); if ($amountleft < 0){ $amountleft*=-1; } @@ -1453,6 +1795,15 @@ C<$itemnumber> is the itemnumber Returns an array of hashes +FIXME: Though the above says that this function returns nothing if the +item is not issued, this actually returns a hasref that looks like +this: + { + itemnumber => 1, + overdue => 1 + } + + =cut sub GetItemIssue { @@ -1468,7 +1819,7 @@ sub GetItemIssue { "SELECT * FROM issues LEFT JOIN items ON issues.itemnumber=items.itemnumber WHERE - issues.itemnumber=? AND returndate IS NULL "); + issues.itemnumber=?"); $sth->execute($itemnumber); my $data = $sth->fetchrow_hashref; my $datedue = $data->{'date_due'}; @@ -1481,6 +1832,28 @@ sub GetItemIssue { return ($data); } +=head2 GetOpenIssue + +$issue = GetOpenIssue( $itemnumber ); + +Returns the row from the issues table if the item is currently issued, undef if the item is not currently issued + +C<$itemnumber> is the item's itemnumber + +Returns a hashref + +=cut + +sub GetOpenIssue { + my ( $itemnumber ) = @_; + + my $dbh = C4::Context->dbh; + my $sth = $dbh->prepare( "SELECT * FROM issues WHERE itemnumber = ? AND returndate IS NULL" ); + $sth->execute( $itemnumber ); + my $issue = $sth->fetchrow_hashref(); + return $issue; +} + =head2 GetItemIssues $issues = &GetItemIssues($itemnumber, $history); @@ -1502,15 +1875,24 @@ sub GetItemIssues { # get today date my $today = POSIX::strftime("%Y%m%d", localtime); - my $sth = $dbh->prepare( - "SELECT * FROM issues - LEFT JOIN borrowers ON borrowers.borrowernumber - LEFT JOIN items ON items.itemnumber=issues.itemnumber - WHERE - issues.itemnumber=?".($history?"":" AND returndate IS NULL "). - "ORDER BY issues.date_due DESC" - ); - $sth->execute($itemnumber); + my $sql = "SELECT * FROM issues + JOIN borrowers USING (borrowernumber) + JOIN items USING (itemnumber) + WHERE issues.itemnumber = ? "; + if ($history) { + $sql .= "UNION ALL + SELECT * FROM old_issues + LEFT JOIN borrowers USING (borrowernumber) + JOIN items USING (itemnumber) + WHERE old_issues.itemnumber = ? "; + } + $sql .= "ORDER BY date_due DESC"; + my $sth = $dbh->prepare($sql); + if ($history) { + $sth->execute($itemnumber, $itemnumber); + } else { + $sth->execute($itemnumber); + } while ( my $data = $sth->fetchrow_hashref ) { my $datedue = $data->{'date_due'}; $datedue =~ s/-//g; @@ -1546,12 +1928,20 @@ sub GetBiblioIssues { LEFT JOIN borrowers ON borrowers.borrowernumber = issues.borrowernumber LEFT JOIN items ON issues.itemnumber = items.itemnumber LEFT JOIN biblioitems ON items.itemnumber = biblioitems.biblioitemnumber - LEFT JOIN biblio ON biblio.biblionumber = items.biblioitemnumber + LEFT JOIN biblio ON biblio.biblionumber = items.biblionumber + WHERE biblio.biblionumber = ? + UNION ALL + SELECT old_issues.*,items.barcode,biblio.biblionumber,biblio.title, biblio.author,borrowers.cardnumber,borrowers.surname,borrowers.firstname + FROM old_issues + LEFT JOIN borrowers ON borrowers.borrowernumber = old_issues.borrowernumber + LEFT JOIN items ON old_issues.itemnumber = items.itemnumber + LEFT JOIN biblioitems ON items.itemnumber = biblioitems.biblioitemnumber + LEFT JOIN biblio ON biblio.biblionumber = items.biblionumber WHERE biblio.biblionumber = ? - ORDER BY issues.timestamp + ORDER BY timestamp "; my $sth = $dbh->prepare($query); - $sth->execute($biblionumber); + $sth->execute($biblionumber, $biblionumber); my @issues; while ( my $data = $sth->fetchrow_hashref ) { @@ -1560,9 +1950,43 @@ sub GetBiblioIssues { return \@issues; } +=head2 GetUpcomingDueIssues + +=over 4 + +my $upcoming_dues = GetUpcomingDueIssues( { days_in_advance => 4 } ); + +=back + +=cut + +sub GetUpcomingDueIssues { + my $params = shift; + + $params->{'days_in_advance'} = 7 unless exists $params->{'days_in_advance'}; + my $dbh = C4::Context->dbh; + + my $statement = <{'days_in_advance'} ); + + my $sth = $dbh->prepare( $statement ); + $sth->execute( @bind_parameters ); + my $upcoming_dues = $sth->fetchall_arrayref({}); + $sth->finish; + + return $upcoming_dues; +} + =head2 CanBookBeRenewed -$ok = &CanBookBeRenewed($borrowernumber, $itemnumber); +($ok,$error) = &CanBookBeRenewed($borrowernumber, $itemnumber[, $override_limit]); Find out whether a borrowed item may be renewed. @@ -1573,20 +1997,25 @@ has the item on loan. C<$itemnumber> is the number of the item to renew. +C<$override_limit>, if supplied with a true value, causes +the limit on the number of times that the loan can be renewed +(as controlled by the item type) to be ignored. + C<$CanBookBeRenewed> returns a true value iff the item may be renewed. The item must currently be on loan to the specified borrower; renewals must be allowed for the item's type; and the borrower must not have -already renewed the loan. +already renewed the loan. $error will contain the reason the renewal can not proceed =cut sub CanBookBeRenewed { # check renewal status - my ( $borrowernumber, $itemnumber ) = @_; + my ( $borrowernumber, $itemnumber, $override_limit ) = @_; my $dbh = C4::Context->dbh; my $renews = 1; my $renewokay = 0; + my $error; # Look in the issues table for this item, lent to this borrower, # and not yet returned. @@ -1595,8 +2024,7 @@ sub CanBookBeRenewed { my $sth1 = $dbh->prepare( "SELECT * FROM issues WHERE borrowernumber = ? - AND itemnumber = ? - AND returndate IS NULL" + AND itemnumber = ?" ); $sth1->execute( $borrowernumber, $itemnumber ); if ( my $data1 = $sth1->fetchrow_hashref ) { @@ -1607,34 +2035,38 @@ sub CanBookBeRenewed { # because it's a bit messy: given the item number, we need to find # the biblioitem, which gives us the itemtype, which tells us # whether it may be renewed. - my $sth2 = $dbh->prepare( - "SELECT renewalsallowed FROM items - LEFT JOIN biblioitems on items.biblioitemnumber = biblioitems.biblioitemnumber - LEFT JOIN itemtypes ON biblioitems.itemtype = itemtypes.itemtype - WHERE items.itemnumber = ? - " - ); + my $query = "SELECT renewalsallowed FROM items "; + $query .= (C4::Context->preference('item-level_itypes')) + ? "LEFT JOIN itemtypes ON items.itype = itemtypes.itemtype " + : "LEFT JOIN biblioitems on items.biblioitemnumber = biblioitems.biblioitemnumber + LEFT JOIN itemtypes ON biblioitems.itemtype = itemtypes.itemtype "; + $query .= "WHERE items.itemnumber = ?"; + my $sth2 = $dbh->prepare($query); $sth2->execute($itemnumber); if ( my $data2 = $sth2->fetchrow_hashref ) { $renews = $data2->{'renewalsallowed'}; } - if ( $renews && $renews >= $data1->{'renewals'} ) { + if ( ( $renews && $renews > $data1->{'renewals'} ) || $override_limit ) { $renewokay = 1; } + else { + $error="too_many"; + } $sth2->finish; my ( $resfound, $resrec ) = C4::Reserves::CheckReserves($itemnumber); if ($resfound) { $renewokay = 0; + $error="on_reserve" } } $sth1->finish; - return ($renewokay); + return ($renewokay,$error); } =head2 AddRenewal -&AddRenewal($borrowernumber, $itemnumber, $datedue); +&AddRenewal($borrowernumber, $itemnumber, $branch, [$datedue], [$lastreneweddate]); Renews a loan. @@ -1643,66 +2075,90 @@ has the item. C<$itemnumber> is the number of the item to renew. -C<$datedue> can be used to set the due date. If C<$datedue> is the -empty string, C<&AddRenewal> will calculate the due date automatically -from the book's item type. If you wish to set the due date manually, -C<$datedue> should be in the form YYYY-MM-DD. +C<$branch> is the library branch. Defaults to the homebranch of the ITEM. + +C<$datedue> can be a C4::Dates object used to set the due date. + +C<$lastreneweddate> is an optional ISO-formatted date used to set issues.lastreneweddate. If +this parameter is not supplied, lastreneweddate is set to the current date. + +If C<$datedue> is the empty string, C<&AddRenewal> will calculate the due date automatically +from the book's item type. =cut sub AddRenewal { + my $borrowernumber = shift or return undef; + my $itemnumber = shift or return undef; + my $item = GetItem($itemnumber) or return undef; + my $biblio = GetBiblioFromItemNumber($itemnumber) or return undef; + my $branch = (@_) ? shift : $item->{homebranch}; # opac-renew doesn't send branch + my $datedue = shift; + my $lastreneweddate = shift; - my ( $borrowernumber, $itemnumber, $branch ,$datedue ) = @_; - my $dbh = C4::Context->dbh; - - my $biblio = GetBiblioFromItemNumber($itemnumber); # If the due date wasn't specified, calculate it by adding the # book's loan length to today's date. - unless ( $datedue ) { - + unless ($datedue && $datedue->output('iso')) { - my $borrower = C4::Members::GetMemberDetails( $borrowernumber, 0 ); + my $borrower = C4::Members::GetMemberDetails( $borrowernumber, 0 ) or return undef; my $loanlength = GetLoanLength( $borrower->{'categorycode'}, (C4::Context->preference('item-level_itypes')) ? $biblio->{'itype'} : $biblio->{'itemtype'} , - $borrower->{'branchcode'} + $item->{homebranch} # item's homebranch determines loanlength OR do we want the branch specified by the AddRenewal argument? ); - #FIXME -- choose issuer or borrower branch. - #FIXME -- where's the calendar ? - #FIXME -- $debug-ify the (0) - my @darray = Add_Delta_DHMS( Today_and_Now(), $loanlength, 0, 0, 0 ); - $datedue = C4::Dates->new( sprintf("%04d-%02d-%02d",@darray[0..2]), 'iso'); - (0) and print STDERR "C4::Dates->new->output = " . C4::Dates->new()->output() - . "\ndatedue->output = " . $datedue->output() - . "\n(Y,M,D) = " . join ',', @darray; - $datedue=CheckValidDatedue($datedue,$itemnumber,$branch); + #FIXME -- use circControl? + $datedue = CalcDateDue(C4::Dates->new(),$loanlength,$branch,$borrower); # this branch is the transactional branch. + # The question of whether to use item's homebranch calendar is open. + } + + # $lastreneweddate defaults to today. + unless (defined $lastreneweddate) { + $lastreneweddate = strftime( "%Y-%m-%d", localtime ); } + my $dbh = C4::Context->dbh; # Find the issues record for this book my $sth = $dbh->prepare("SELECT * FROM issues WHERE borrowernumber=? - AND itemnumber=? - AND returndate IS NULL" + AND itemnumber=?" ); $sth->execute( $borrowernumber, $itemnumber ); my $issuedata = $sth->fetchrow_hashref; $sth->finish; + # If the due date wasn't specified, calculate it by adding the + # book's loan length to due's date. + unless (@_ and $datedue = shift and $datedue->output('iso')) { + + my $borrower = C4::Members::GetMemberDetails( $borrowernumber, 0 ) or return undef; + my $loanlength = GetLoanLength( + $borrower->{'categorycode'}, + (C4::Context->preference('item-level_itypes')) ? $biblio->{'itype'} : $biblio->{'itemtype'} , + $item->{homebranch} # item's homebranch determines loanlength OR do we want the branch specified by the AddRenewal argument? + ); + + $datedue = (C4::Context->preference('RenewalPeriodBase') eq 'date_due') ? + C4::Dates->new($issuedata->{date_due}, 'iso') : + C4::Dates->new(); + #FIXME -- use circControl? + $datedue = CalcDateDue($datedue,$loanlength,$branch); # this branch is the transactional branch. + # The question of whether to use item's homebranch calendar is open. + } + # Update the issues record to have the new due date, and a new count # of how many times it has been renewed. my $renews = $issuedata->{'renewals'} + 1; - $sth = $dbh->prepare("UPDATE issues SET date_due = ?, renewals = ? + $sth = $dbh->prepare("UPDATE issues SET date_due = ?, renewals = ?, lastreneweddate = ? WHERE borrowernumber=? - AND itemnumber=? - AND returndate IS NULL" + AND itemnumber=?" ); - $sth->execute( $datedue->output('iso'), $renews, $borrowernumber, $itemnumber ); + $sth->execute( $datedue->output('iso'), $renews, $lastreneweddate, $borrowernumber, $itemnumber ); $sth->finish; # Update the renewal count on the item, and tell zebra to reindex $renews = $biblio->{'renewals'} + 1; - ModItem({ renewals => $renews }, $biblio->{'biblionumber'}, $itemnumber); + ModItem({ renewals => $renews, onloan => $datedue->output('iso') }, $biblio->{'biblionumber'}, $itemnumber); # Charge a new rental fee, if applicable? my ( $charge, $type ) = GetIssuingCharges( $itemnumber, $borrowernumber ); @@ -1711,10 +2167,12 @@ sub AddRenewal { my $item = GetBiblioFromItemNumber($itemnumber); $sth = $dbh->prepare( "INSERT INTO accountlines - (borrowernumber,accountno,date,amount, - description,accounttype,amountoutstanding, - itemnumber) - VALUES (?,?,now(),?,?,?,?,?)" + (date, + borrowernumber, accountno, amount, + description, + accounttype, amountoutstanding, itemnumber + ) + VALUES (now(),?,?,?,?,?,?,?)" ); $sth->execute( $borrowernumber, $accountno, $charge, "Renewal of Rental Item $item->{'title'} $item->{'barcode'}", @@ -1722,7 +2180,8 @@ sub AddRenewal { $sth->finish; } # Log the renewal - UpdateStats( $branch, 'renew', $charge, '', $itemnumber ); + UpdateStats( $branch, 'renew', $charge, '', $itemnumber, $item->{itype}, $borrowernumber); + return $datedue; } sub GetRenewCount { @@ -1738,22 +2197,25 @@ sub GetRenewCount { # FIXME - I think this function could be redone to use only one SQL call. my $sth = $dbh->prepare("select * from issues where (borrowernumber = ?) - and (itemnumber = ?) - and returndate is null"); + and (itemnumber = ?)"); $sth->execute($bornum,$itemno); - my $data = $sth->fetchrow_hashref; - $renewcount = $data->{'renewals'} if $data->{'renewals'}; - my $sth2 = $dbh->prepare("select renewalsallowed from items,biblioitems,itemtypes - where (items.itemnumber = ?) - and (items.biblioitemnumber = biblioitems.biblioitemnumber) - and (biblioitems.itemtype = itemtypes.itemtype)"); + my $data = $sth->fetchrow_hashref; + $renewcount = $data->{'renewals'} if $data->{'renewals'}; + $sth->finish; + my $query = "SELECT renewalsallowed FROM items "; + $query .= (C4::Context->preference('item-level_itypes')) + ? "LEFT JOIN itemtypes ON items.itype = itemtypes.itemtype " + : "LEFT JOIN biblioitems on items.biblioitemnumber = biblioitems.biblioitemnumber + LEFT JOIN itemtypes ON biblioitems.itemtype = itemtypes.itemtype "; + $query .= "WHERE items.itemnumber = ?"; + my $sth2 = $dbh->prepare($query); $sth2->execute($itemno); - my $data2 = $sth2->fetchrow_hashref(); - $renewsallowed = $data2->{'renewalsallowed'}; - $renewsleft = $renewsallowed - $renewcount; -# warn "Renewcount:$renewcount RenewsAll:$renewsallowed RenewLeft:$renewsleft"; - return ($renewcount,$renewsallowed,$renewsleft); + my $data2 = $sth2->fetchrow_hashref(); + $renewsallowed = $data2->{'renewalsallowed'}; + $renewsleft = $renewsallowed - $renewcount; + return ($renewcount,$renewsallowed,$renewsleft); } + =head2 GetIssuingCharges ($charge, $item_type) = &GetIssuingCharges($itemnumber, $borrowernumber); @@ -1861,7 +2323,6 @@ sub GetTransfers { return @row; } - =head2 GetTransfersFromTo @results = GetTransfersFromTo($frombranch,$tobranch); @@ -1926,7 +2387,7 @@ sub AnonymiseIssueHistory { my $borrowernumber = shift; my $dbh = C4::Context->dbh; my $query = " - UPDATE issues + UPDATE old_issues SET borrowernumber = NULL WHERE returndate < '".$date."' AND borrowernumber IS NOT NULL @@ -1936,6 +2397,77 @@ sub AnonymiseIssueHistory { return $rows_affected; } +=head2 SendCirculationAlert + +Send out a C or C alert using the messaging system. + +B: + +=over 4 + +=item type + +Valid values for this parameter are: C and C. + +=item item + +Hashref of information about the item being checked in or out. + +=item borrower + +Hashref of information about the borrower of the item. + +=item branch + +The branchcode from where the checkout or check-in took place. + +=back + +B: + + SendCirculationAlert({ + type => 'CHECKOUT', + item => $item, + borrower => $borrower, + branch => $branch, + }); + +=cut + +sub SendCirculationAlert { + my ($opts) = @_; + my ($type, $item, $borrower, $branch) = + ($opts->{type}, $opts->{item}, $opts->{borrower}, $opts->{branch}); + my %message_name = ( + CHECKIN => 'Item Check-in', + CHECKOUT => 'Item Checkout', + ); + my $borrower_preferences = C4::Members::Messaging::GetMessagingPreferences({ + borrowernumber => $borrower->{borrowernumber}, + message_name => $message_name{$type}, + }); + my $letter = C4::Letters::getletter('circulation', $type); + C4::Letters::parseletter($letter, 'biblio', $item->{biblionumber}); + C4::Letters::parseletter($letter, 'biblioitems', $item->{biblionumber}); + C4::Letters::parseletter($letter, 'borrowers', $borrower->{borrowernumber}); + C4::Letters::parseletter($letter, 'branches', $branch); + my @transports = @{ $borrower_preferences->{transports} }; + # warn "no transports" unless @transports; + for (@transports) { + # warn "transport: $_"; + my $message = C4::Message->find_last_message($borrower, $type, $_); + if (!$message) { + #warn "create new message"; + C4::Message->enqueue($letter, $borrower, $_); + } else { + #warn "append to old message"; + $message->append($letter); + $message->update; + } + } + $letter; +} + =head2 updateWrongTransfer $items = updateWrongTransfer($itemNumber,$borrowernumber,$waitingAtLibrary,$FromLibrary); @@ -1974,19 +2506,58 @@ sub UpdateHoldingbranch { ModItem({ holdingbranch => $branch }, undef, $itemnumber); } +=head2 CalcDateDue + +$newdatedue = CalcDateDue($startdate,$loanlength,$branchcode); +this function calculates the due date given the loan length , +checking against the holidays calendar as per the 'useDaysMode' syspref. +C<$startdate> = C4::Dates object representing start date of loan period (assumed to be today) +C<$branch> = location whose calendar to use +C<$loanlength> = loan length prior to adjustment +=cut + +sub CalcDateDue { + my ($startdate,$loanlength,$branch,$borrower) = @_; + my $datedue; + + if(C4::Context->preference('useDaysMode') eq 'Days') { # ignoring calendar + my $timedue = time + ($loanlength) * 86400; + #FIXME - assumes now even though we take a startdate + my @datearr = localtime($timedue); + $datedue = C4::Dates->new( sprintf("%04d-%02d-%02d", 1900 + $datearr[5], $datearr[4] + 1, $datearr[3]), 'iso'); + } else { + my $calendar = C4::Calendar->new( branchcode => $branch ); + $datedue = $calendar->addDate($startdate, $loanlength); + } + + # if ReturnBeforeExpiry ON the datedue can't be after borrower expirydate + if ( C4::Context->preference('ReturnBeforeExpiry') && $datedue->output('iso') gt $borrower->{dateexpiry} ) { + $datedue = C4::Dates->new( $borrower->{dateexpiry}, 'iso' ); + } + + # if ceilingDueDate ON the datedue can't be after the ceiling date + if ( C4::Context->preference('ceilingDueDate') + && ( C4::Context->preference('ceilingDueDate') =~ C4::Dates->regexp('syspref') ) + && $datedue->output gt C4::Context->preference('ceilingDueDate') ) { + $datedue = C4::Dates->new( C4::Context->preference('ceilingDueDate') ); + } + + return $datedue; +} + =head2 CheckValidDatedue + This function does not account for holiday exceptions nor does it handle the 'useDaysMode' syspref . + To be replaced by CalcDateDue() once C4::Calendar use is tested. $newdatedue = CheckValidDatedue($date_due,$itemnumber,$branchcode); -this function return a new date due after checked if it's a repeatable or special holiday +this function validates the loan length against the holidays calendar, and adjusts the due date as per the 'useDaysMode' syspref. C<$date_due> = returndate calculate with no day check C<$itemnumber> = itemnumber -C<$branchcode> = localisation of issue - +C<$branchcode> = location of issue (affected by 'CircControl' syspref) +C<$loanlength> = loan length prior to adjustment =cut -# Why not create calendar object? - -# TODO add 'duedate' option to useDaysMode . -sub CheckValidDatedue { +sub CheckValidDatedue { my ($date_due,$itemnumber,$branchcode)=@_; my @datedue=split('-',$date_due->output('iso')); my $years=$datedue[0]; @@ -1995,24 +2566,25 @@ my $day=$datedue[2]; # die "Item# $itemnumber ($branchcode) due: " . ${date_due}->output() . "\n(Y,M,D) = ($years,$month,$day)": my $dow; for (my $i=0;$i<2;$i++){ - $dow=Day_of_Week($years,$month,$day); - ($dow=0) if ($dow>6); - my $result=CheckRepeatableHolidays($itemnumber,$dow,$branchcode); - my $countspecial=CheckSpecialHolidays($years,$month,$day,$itemnumber,$branchcode); - my $countspecialrepeatable=CheckRepeatableSpecialHolidays($month,$day,$itemnumber,$branchcode); - if (($result ne '0') or ($countspecial ne '0') or ($countspecialrepeatable ne '0') ){ - $i=0; - (($years,$month,$day) = Add_Delta_Days($years,$month,$day, 1))if ($i ne '1'); - } - } - my $newdatedue=C4::Dates->new(sprintf("%04d-%02d-%02d",$years,$month,$day),'iso'); + $dow=Day_of_Week($years,$month,$day); + ($dow=0) if ($dow>6); + my $result=CheckRepeatableHolidays($itemnumber,$dow,$branchcode); + my $countspecial=CheckSpecialHolidays($years,$month,$day,$itemnumber,$branchcode); + my $countspecialrepeatable=CheckRepeatableSpecialHolidays($month,$day,$itemnumber,$branchcode); + if (($result ne '0') or ($countspecial ne '0') or ($countspecialrepeatable ne '0') ){ + $i=0; + (($years,$month,$day) = Add_Delta_Days($years,$month,$day, 1))if ($i ne '1'); + } + } + my $newdatedue=C4::Dates->new(sprintf("%04d-%02d-%02d",$years,$month,$day),'iso'); return $newdatedue; } + =head2 CheckRepeatableHolidays $countrepeatable = CheckRepeatableHoliday($itemnumber,$week_day,$branchcode); -this function check if the date due is a repeatable holiday +this function checks if the date due is a repeatable holiday C<$date_due> = returndate calculate with no day check C<$itemnumber> = itemnumber C<$branchcode> = localisation of issue @@ -2106,7 +2678,67 @@ $sth->finish; return $exist; } -1; +=head2 IsBranchTransferAllowed + +$allowed = IsBranchTransferAllowed( $toBranch, $fromBranch, $code ); + +Code is either an itemtype or collection doe depending on the pref BranchTransferLimitsType + +=cut + +sub IsBranchTransferAllowed { + my ( $toBranch, $fromBranch, $code ) = @_; + + if ( $toBranch eq $fromBranch ) { return 1; } ## Short circuit for speed. + + my $limitType = C4::Context->preference("BranchTransferLimitsType"); + my $dbh = C4::Context->dbh; + + my $sth = $dbh->prepare("SELECT * FROM branch_transfer_limits WHERE toBranch = ? AND fromBranch = ? AND $limitType = ?"); + $sth->execute( $toBranch, $fromBranch, $code ); + my $limit = $sth->fetchrow_hashref(); + + ## If a row is found, then that combination is not allowed, if no matching row is found, then the combination *is allowed* + if ( $limit->{'limitId'} ) { + return 0; + } else { + return 1; + } +} + +=head2 CreateBranchTransferLimit + +CreateBranchTransferLimit( $toBranch, $fromBranch, $code ); + +$code is either itemtype or collection code depending on what the pref BranchTransferLimitsType is set to. + +=cut + +sub CreateBranchTransferLimit { + my ( $toBranch, $fromBranch, $code ) = @_; + + my $limitType = C4::Context->preference("BranchTransferLimitsType"); + + my $dbh = C4::Context->dbh; + + my $sth = $dbh->prepare("INSERT INTO branch_transfer_limits ( $limitType, toBranch, fromBranch ) VALUES ( ?, ?, ? )"); + $sth->execute( $code, $toBranch, $fromBranch ); +} + +=head2 DeleteBranchTransferLimits + +DeleteBranchTransferLimits(); + +=cut + +sub DeleteBranchTransferLimits { + my $dbh = C4::Context->dbh; + my $sth = $dbh->prepare("TRUNCATE TABLE branch_transfer_limits"); + $sth->execute(); +} + + + 1; __END__