use Modern::Perl;
use DateTime;
use POSIX qw( floor );
-use Koha::DateUtils;
+use YAML::XS;
+use Encode;
+
+use Koha::DateUtils qw( dt_from_string output_pref );
use C4::Context;
-use C4::Stats;
-use C4::Reserves;
-use C4::Biblio;
-use C4::Items;
-use C4::Members;
+use C4::Stats qw( UpdateStats );
+use C4::Reserves qw( CheckReserves CanItemBeReserved MoveReserve ModReserve ModReserveMinusPriority RevertWaitingStatus IsItemOnHoldAndFound IsAvailableForItemLevelRequest );
+use C4::Biblio qw( UpdateTotalIssues );
+use C4::Items qw( ModItemTransfer ModDateLastSeen CartToShelf );
use C4::Accounts;
use C4::ItemCirculationAlertPreference;
use C4::Message;
-use C4::Debug;
-use C4::Log; # logaction
-use C4::Overdues qw(CalcFine UpdateFine get_chargeable_units);
+use C4::Log qw( logaction ); # logaction
+use C4::Overdues;
use C4::RotatingCollections qw(GetCollectionItemBranches);
-use Algorithm::CheckDigits;
+use Algorithm::CheckDigits qw( CheckDigits );
-use Data::Dumper;
+use Data::Dumper qw( Dumper );
use Koha::Account;
use Koha::AuthorisedValues;
use Koha::Biblioitems;
-use Koha::DateUtils;
+use Koha::DateUtils qw( dt_from_string output_pref );
use Koha::Calendar;
use Koha::Checkouts;
use Koha::Illrequests;
use Koha::Items;
use Koha::Patrons;
-use Koha::Patron::Debarments;
+use Koha::Patron::Debarments qw( DelUniqueDebarment GetDebarments );
use Koha::Database;
use Koha::Libraries;
use Koha::Account::Lines;
use Koha::Config::SysPref;
use Koha::Checkouts::ReturnClaims;
use Koha::SearchEngine::Indexer;
-use Carp;
-use List::MoreUtils qw( uniq any );
+use Koha::Exceptions::Checkout;
+use Carp qw( carp );
+use List::MoreUtils qw( any );
use Scalar::Util qw( looks_like_number );
-use Try::Tiny;
-use Date::Calc qw(
- Today
- Today_and_Now
- Add_Delta_YM
- Add_Delta_DHMS
- Date_to_Days
- Day_of_Week
- Add_Delta_Days
-);
-use vars qw(@ISA @EXPORT @EXPORT_OK %EXPORT_TAGS);
-
+use Date::Calc qw( Date_to_Days );
+our (@ISA, @EXPORT_OK);
BEGIN {
- require Exporter;
- @ISA = qw(Exporter);
-
- # FIXME subs that should probably be elsewhere
- push @EXPORT, qw(
- &barcodedecode
- &LostItem
- &ReturnLostItem
- &GetPendingOnSiteCheckouts
- );
-
- # subs to deal with issuing a book
- push @EXPORT, qw(
- &CanBookBeIssued
- &CanBookBeRenewed
- &AddIssue
- &AddRenewal
- &GetRenewCount
- &GetSoonestRenewDate
- &GetLatestAutoRenewDate
- &GetIssuingCharges
- &GetBranchBorrowerCircRule
- &GetBranchItemRule
- &GetOpenIssue
- &CheckIfIssuedToPatron
- &IsItemIssued
- GetTopIssues
- );
-
- # subs to deal with returns
- push @EXPORT, qw(
- &AddReturn
- &MarkIssueReturned
- );
-
- # subs to deal with transfers
- push @EXPORT, qw(
- &transferbook
- &GetTransfers
- &GetTransfersFromTo
- &updateWrongTransfer
- &DeleteTransfer
- &IsBranchTransferAllowed
- &CreateBranchTransferLimit
- &DeleteBranchTransferLimits
- &TransferSlip
- );
-
- # subs to deal with offline circulation
- push @EXPORT, qw(
- &GetOfflineOperations
- &GetOfflineOperation
- &AddOfflineOperation
- &DeleteOfflineOperation
- &ProcessOfflineOperation
+
+ require Exporter;
+ @ISA = qw(Exporter);
+
+ # FIXME subs that should probably be elsewhere
+ push @EXPORT_OK, qw(
+ barcodedecode
+ LostItem
+ ReturnLostItem
+ GetPendingOnSiteCheckouts
+
+ CanBookBeIssued
+ checkHighHolds
+ CanBookBeRenewed
+ AddIssue
+ GetLoanLength
+ GetHardDueDate
+ AddRenewal
+ GetRenewCount
+ GetSoonestRenewDate
+ GetLatestAutoRenewDate
+ GetIssuingCharges
+ AddIssuingCharge
+ GetBranchBorrowerCircRule
+ GetBranchItemRule
+ GetBiblioIssues
+ GetOpenIssue
+ GetUpcomingDueIssues
+ CheckIfIssuedToPatron
+ IsItemIssued
+ GetAgeRestriction
+ GetTopIssues
+
+ AddReturn
+ MarkIssueReturned
+
+ transferbook
+ TooMany
+ GetTransfers
+ GetTransfersFromTo
+ updateWrongTransfer
+ CalcDateDue
+ CheckValidBarcode
+ IsBranchTransferAllowed
+ CreateBranchTransferLimit
+ DeleteBranchTransferLimits
+ TransferSlip
+
+ GetOfflineOperations
+ GetOfflineOperation
+ AddOfflineOperation
+ DeleteOfflineOperation
+ ProcessOfflineOperation
+ ProcessOfflinePayment
);
+ push @EXPORT_OK, '_GetCircControlBranch'; # This is wrong!
}
=head1 NAME
} elsif ($filter eq 'cuecat') {
chomp($barcode);
my @fields = split( /\./, $barcode );
- my @results = map( decode($_), @fields[ 1 .. $#fields ] );
+ my @results = map( C4::Circulation::_decode($_), @fields[ 1 .. $#fields ] );
($#results == 2) and return $results[2];
} elsif ($filter eq 'T-prefix') {
if ($barcode =~ /^[Tt](\d)/) {
return $barcode; # return barcode, modified or not
}
-=head2 decode
+=head2 _decode
- $str = &decode($chunk);
+ $str = &_decode($chunk);
Decodes a segment of a string emitted by a CueCat barcode scanner and
returns it.
=cut
-sub decode {
+sub _decode {
my ($encoded) = @_;
my $seq =
'abcdefghijklmnopqrstuvwxyzABCDEFGHIJKLMNOPQRSTUVWXYZ0123456789+-';
# That'll save a database query.
my ( $resfound, $resrec, undef ) =
CheckReserves( $itemnumber );
- if ( $resfound and not $ignoreRs ) {
+ if ( $resfound ) {
$resrec->{'ResFound'} = $resfound;
$messages->{'ResFound'} = $resrec;
- $dotransfer = 1;
+ $dotransfer = 0 unless $ignoreRs;
}
#actually do the transfer....
ModItemTransfer( $itemnumber, $fbr, $tbr, $trigger );
# don't need to update MARC anymore, we do it in batch now
- $messages->{'WasTransfered'} = 1;
+ $messages->{'WasTransfered'} = $tbr;
}
ModDateLastSeen( $itemnumber );
reserved for someone else.
+=head3 TRANSFERRED
+
+reserved and being transferred for someone else.
+
=head3 INVALID_DATE
sticky due date is invalid or due date in the past
$no_issues_charge_guarantees = undef unless looks_like_number( $no_issues_charge_guarantees );
if ( defined $no_issues_charge_guarantees ) {
my @guarantees = map { $_->guarantee } $patron->guarantee_relationships();
- my $guarantees_non_issues_charges;
+ my $guarantees_non_issues_charges = 0;
foreach my $g ( @guarantees ) {
$guarantees_non_issues_charges += $g->account->non_issues_charges;
}
$needsconfirmation{'resreservedate'} = $res->{reservedate};
$needsconfirmation{'reserve_id'} = $res->{reserve_id};
}
+ elsif ( $restype eq "Transferred" ) {
+ # The item is determined hold being transferred for someone else.
+ $needsconfirmation{TRANSFERRED} = 1;
+ $needsconfirmation{'resfirstname'} = $patron->firstname;
+ $needsconfirmation{'ressurname'} = $patron->surname;
+ $needsconfirmation{'rescardnumber'} = $patron->cardnumber;
+ $needsconfirmation{'resborrowernumber'} = $patron->borrowernumber;
+ $needsconfirmation{'resbranchcode'} = $patron->branchcode;
+ $needsconfirmation{'resreservedate'} = $res->{reservedate};
+ $needsconfirmation{'reserve_id'} = $res->{reserve_id};
+ }
+ elsif ( $restype eq "Processing" ) {
+ # The item is determined hold being processed for someone else.
+ $needsconfirmation{PROCESSING} = 1;
+ $needsconfirmation{'resfirstname'} = $patron->firstname;
+ $needsconfirmation{'ressurname'} = $patron->surname;
+ $needsconfirmation{'rescardnumber'} = $patron->cardnumber;
+ $needsconfirmation{'resborrowernumber'} = $patron->borrowernumber;
+ $needsconfirmation{'resbranchcode'} = $patron->branchcode;
+ $needsconfirmation{'resreservedate'} = $res->{reservedate};
+ $needsconfirmation{'reserve_id'} = $res->{reserve_id};
+ }
}
}
}
my ( $allowed, $message ) = CanBookBeReturned( $item_unblessed, C4::Context->userenv->{branch} );
return unless $allowed;
AddReturn( $item_object->barcode, C4::Context->userenv->{'branch'} );
+ # AddReturn certainly has side-effects, like onloan => undef
+ $item_object->discard_changes;
}
C4::Reserves::MoveReserve( $item_object->itemnumber, $borrower->{'borrowernumber'}, $cancelreserve );
)->store;
}
$issue->discard_changes;
+ C4::Auth::track_login_daily( $borrower->{userid} );
if ( $item_object->location && $item_object->location eq 'CART'
&& ( !$item_object->permanent_location || $item_object->permanent_location ne 'CART' ) ) {
## Item was moved to cart via UpdateItemLocationOnCheckin, anything issued should be taken off the cart.
The return value is a hashref containing the following keys:
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.
+ not_allowed: No holds allowed.
+ from_home_library: Holds allowed only by patrons that have the same homebranch as the item.
+ from_any_library: Holds allowed from any patron.
+ from_local_hold_group: Holds allowed from libraries in hold group
returnbranch => branch to which to return item. Possible values:
noreturn: do not return, let item remain where checked in (floating collections)
my $holdallowed_rule = Koha::CirculationRules->get_effective_rule(
{
branchcode => $branchcode,
- itemtype => $itemtype,
- rule_name => 'holdallowed',
+ itemtype => $itemtype,
+ rule_name => 'holdallowed',
}
);
my $hold_fulfillment_policy_rule = Koha::CirculationRules->get_effective_rule(
{
branchcode => $branchcode,
- itemtype => $itemtype,
- rule_name => 'hold_fulfillment_policy',
+ itemtype => $itemtype,
+ rule_name => 'hold_fulfillment_policy',
}
);
my $returnbranch_rule = Koha::CirculationRules->get_effective_rule(
{
branchcode => $branchcode,
- itemtype => $itemtype,
- rule_name => 'returnbranch',
+ itemtype => $itemtype,
+ rule_name => 'returnbranch',
}
);
my $rules;
$rules->{holdallowed} = defined $holdallowed_rule
? $holdallowed_rule->rule_value
- : 2;
+ : 'from_any_library';
$rules->{hold_fulfillment_policy} = defined $hold_fulfillment_policy_rule
? $hold_fulfillment_policy_rule->rule_value
: 'any';
if ($yaml) {
$yaml = "$yaml\n\n"; # YAML is anal on ending \n. Surplus does not hurt
my $rules;
- eval { $rules = YAML::Load($yaml); };
+ eval { $rules = YAML::XS::Load(Encode::encode_utf8($yaml)); };
if ($@) {
warn "Unable to parse UpdateNotForLoanStatusOnCheckin syspref : $@";
}
}
# check if we have a transfer for this document
- my ($datesent,$frombranch,$tobranch) = GetTransfers( $item->itemnumber );
+ my $transfer = $item->get_transfer;
# if we have a transfer to complete, we update the line of transfers with the datearrived
- my $is_in_rotating_collection = C4::RotatingCollections::isItemInAnyCollection( $item->itemnumber );
- if ($datesent) {
- # At this point we will either fill the transfer or it is a wrong transfer
- # either way we should not now generate a new transfer
+ if ($transfer) {
$validTransfer = 0;
- if ( $tobranch eq $branch ) {
- my $sth = C4::Context->dbh->prepare(
- "UPDATE branchtransfers SET datearrived = now() WHERE itemnumber= ? AND datearrived IS NULL"
- );
- $sth->execute( $item->itemnumber );
- $messages->{'TransferArrived'} = $frombranch;
- } else {
- $messages->{'WrongTransfer'} = $tobranch;
- $messages->{'WrongTransferItem'} = $item->itemnumber;
+ if ( $transfer->in_transit ) {
+ if ( $transfer->tobranch eq $branch ) {
+ $transfer->receive;
+ $messages->{'TransferArrived'} = $transfer->frombranch;
+ # validTransfer=1 allows us returning the item back if the reserve is cancelled
+ $validTransfer = 1 if $transfer->reason eq 'Reserve';
+ }
+ else {
+ $messages->{'WrongTransfer'} = $transfer->tobranch;
+ $messages->{'WrongTransferItem'} = $item->itemnumber;
+ $messages->{'TransferTrigger'} = $transfer->reason;
+ }
+ }
+ else {
+ if ( $transfer->tobranch eq $branch ) {
+ $transfer->receive;
+ $messages->{'TransferArrived'} = $transfer->frombranch;
+ # validTransfer=1 allows us returning the item back if the reserve is cancelled
+ $validTransfer = 1 if $transfer->reason eq 'Reserve';
+ }
+ else {
+ $messages->{'WasTransfered'} = $transfer->tobranch;
+ $messages->{'TransferTrigger'} = $transfer->reason;
+ }
}
}
}
# Transfer to returnbranch if Automatic transfer set or append message NeedsTransfer
- if ($validTransfer && !$is_in_rotating_collection && ($doreturn or $messages->{'NotIssued'}) and !$resfound and ($branch ne $returnbranch) ){
+ if ( $validTransfer && !C4::RotatingCollections::isItemInAnyCollection( $item->itemnumber )
+ && ( $doreturn or $messages->{'NotIssued'} )
+ and !$resfound
+ and ( $branch ne $returnbranch )
+ and not $messages->{'WrongTransfer'}
+ and not $messages->{'WasTransfered'} )
+ {
my $BranchTransferLimitsType = C4::Context->preference("BranchTransferLimitsType") eq 'itemtype' ? 'effective_itemtype' : 'ccode';
if (C4::Context->preference("AutomaticItemReturn" ) or
(C4::Context->preference("UseBranchTransferLimits") and
! IsBranchTransferAllowed($branch, $returnbranch, $item->$BranchTransferLimitsType )
)) {
- $debug and warn sprintf "about to call ModItemTransfer(%s, %s, %s, %s)", $item->itemnumber,$branch, $returnbranch, $transfer_trigger;
- $debug and warn "item: " . Dumper($item->unblessed);
ModItemTransfer($item->itemnumber, $branch, $returnbranch, $transfer_trigger, { skip_record_index => 1 });
- $messages->{'WasTransfered'} = 1;
+ $messages->{'WasTransfered'} = $returnbranch;
+ $messages->{'TransferTrigger'} = $transfer_trigger;
} else {
$messages->{'NeedsTransfer'} = $returnbranch;
$messages->{'TransferTrigger'} = $transfer_trigger;
}
}
- my ( $resfound, $resrec, undef ) = C4::Reserves::CheckReserves($itemnumber);
+ my ( $resfound, $resrec, $possible_reserves ) = C4::Reserves::CheckReserves($itemnumber);
# If next hold is non priority, then check if any hold with priority (non_priority = 0) exists for the same biblionumber.
if ( $resfound && $resrec->{non_priority} ) {
if ( $resfound
&& C4::Context->preference('AllowRenewalIfOtherItemsAvailable') )
{
- my $schema = Koha::Database->new()->schema();
-
- my $item_holds = $schema->resultset('Reserve')->search( { itemnumber => $itemnumber, found => undef } )->count();
+ my $item_holds = Koha::Holds->search( { itemnumber => $itemnumber, found => undef } )->count();
if ($item_holds) {
# There is an item level hold on this item, no other item can fill the hold
$resfound = 1;
else {
# Get all other items that could possibly fill reserves
- my @itemnumbers = $schema->resultset('Item')->search(
- {
- biblionumber => $resrec->{biblionumber},
- onloan => undef,
- notforloan => 0,
- -not => { itemnumber => $itemnumber }
- },
- { columns => 'itemnumber' }
- )->get_column('itemnumber')->all();
+ my $items = Koha::Items->search({
+ biblionumber => $resrec->{biblionumber},
+ onloan => undef,
+ notforloan => 0,
+ -not => { itemnumber => $itemnumber }
+ });
# Get all other reserves that could have been filled by this item
- my @borrowernumbers;
- while (1) {
- my ( $reserve_found, $reserve, undef ) =
- C4::Reserves::CheckReserves( $itemnumber, undef, undef, \@borrowernumbers );
-
- if ($reserve_found) {
- push( @borrowernumbers, $reserve->{borrowernumber} );
- }
- else {
- last;
- }
- }
+ my @borrowernumbers = map { $_->{borrowernumber} } @$possible_reserves;
+ my $patrons = Koha::Patrons->search({
+ borrowernumber => { -in => \@borrowernumbers }
+ });
# If the count of the union of the lists of reservable items for each borrower
# is equal or greater than the number of borrowers, we know that all reserves
# can be filled with available items. We can get the union of the sets simply
# by pushing all the elements onto an array and removing the duplicates.
my @reservable;
- my %patrons;
- ITEM: foreach my $itemnumber (@itemnumbers) {
- my $item = Koha::Items->find( $itemnumber );
- next if IsItemOnHoldAndFound( $itemnumber );
- for my $borrowernumber (@borrowernumbers) {
- my $patron = $patrons{$borrowernumber} //= Koha::Patrons->find( $borrowernumber );
+ ITEM: while ( my $item = $items->next ) {
+ next if IsItemOnHoldAndFound( $item->itemnumber );
+ while ( my $patron = $patrons->next ) {
next unless IsAvailableForItemLevelRequest($item, $patron);
- next unless CanItemBeReserved($borrowernumber,$itemnumber);
-
- push @reservable, $itemnumber;
+ next unless CanItemBeReserved($patron->borrowernumber,$item->itemnumber,undef,{ignore_hold_counts=>1})->{status} eq 'OK';
+ push @reservable, $item->itemnumber;
if (@reservable >= @borrowernumbers) {
$resfound = 0;
last ITEM;
}
last;
}
+ $patrons->reset;
}
}
}
# Update the issues record to have the new due date, and a new count
# of how many times it has been renewed.
my $renews = ( $issue->renewals || 0 ) + 1;
- my $sth = $dbh->prepare("UPDATE issues SET date_due = ?, renewals = ?, unseen_renewals = ?, lastreneweddate = ?
- WHERE borrowernumber=?
- AND itemnumber=?"
- );
+ my $sth = $dbh->prepare("UPDATE issues SET date_due = ?, renewals = ?, unseen_renewals = ?, lastreneweddate = ? WHERE issue_id = ?");
- $sth->execute( $datedue->strftime('%Y-%m-%d %H:%M'), $renews, $unseen_renewals, $lastreneweddate, $borrowernumber, $itemnumber );
+ eval{
+ $sth->execute( $datedue->strftime('%Y-%m-%d %H:%M'), $renews, $unseen_renewals, $lastreneweddate, $issue->issue_id );
+ };
+ if( $sth->err ){
+ Koha::Exceptions::Checkout::FailedRenewal->throw(
+ error => 'Update of issue# ' . $issue->issue_id . ' failed with error: ' . $sth->errstr
+ );
+ }
# Update the renewal count on the item, and tell zebra to reindex
$renews = ( $item_object->renewals || 0 ) + 1;
SELECT datesent,
frombranch,
tobranch,
- branchtransfer_id
+ branchtransfer_id,
+ daterequested,
+ reason
FROM branchtransfers
WHERE itemnumber = ?
AND datearrived IS NULL
+ AND datecancelled IS NULL
';
my $sth = $dbh->prepare($query);
$sth->execute($itemnumber);
FROM branchtransfers
WHERE frombranch=?
AND tobranch=?
+ AND datecancelled IS NULL
+ AND datesent IS NOT NULL
AND datearrived IS NULL
";
my $sth = $dbh->prepare($query);
return (@gettransfers);
}
-=head2 DeleteTransfer
-
- &DeleteTransfer($itemnumber);
-
-=cut
-
-sub DeleteTransfer {
- my ($itemnumber) = @_;
- return unless $itemnumber;
- my $dbh = C4::Context->dbh;
- my $sth = $dbh->prepare(
- "DELETE FROM branchtransfers
- WHERE itemnumber=?
- AND datearrived IS NULL "
- );
- return $sth->execute($itemnumber);
-}
-
=head2 SendCirculationAlert
Send out a C<check-in> or C<checkout> alert using the messaging system.
}
) or next;
- $schema->storage->txn_begin;
C4::Context->dbh->do(q|LOCK TABLE message_queue READ|) unless $do_not_lock;
C4::Context->dbh->do(q|LOCK TABLE message_queue WRITE|) unless $do_not_lock;
my $message = C4::Message->find_last_message($borrower, $type, $mtt);
$message->update;
}
C4::Context->dbh->do(q|UNLOCK TABLES|) unless $do_not_lock;
- $schema->storage->txn_commit;
}
return;
sub updateWrongTransfer {
my ( $itemNumber,$waitingAtLibrary,$FromLibrary ) = @_;
- my $dbh = C4::Context->dbh;
-# first step validate the actual line of transfert .
- my $sth =
- $dbh->prepare(
- "update branchtransfers set datearrived = now(),tobranch=?,comments='wrongtransfer' where itemnumber= ? AND datearrived IS NULL"
- );
- $sth->execute($FromLibrary,$itemNumber);
-
-# second step create a new line of branchtransfer to the right location .
- ModItemTransfer($itemNumber, $FromLibrary, $waitingAtLibrary);
-
-#third step changing holdingbranch of item
- my $item = Koha::Items->find($itemNumber)->holdingbranch($FromLibrary)->store;
+
+ # first step: cancel the original transfer
+ my $item = Koha::Items->find($itemNumber);
+ my $transfer = $item->get_transfer;
+ $transfer->set({ datecancelled => dt_from_string, cancellation_reason => 'WrongTransfer' })->store();
+
+ # second step: create a new transfer to the right location
+ my $new_transfer = $item->request_transfer(
+ {
+ to => $transfer->to_library,
+ reason => $transfer->reason,
+ comment => $transfer->comments,
+ ignore_limits => 1,
+ enqueue => 1
+ }
+ );
+
+ return $new_transfer;
}
=head2 CalcDateDue
#warn " $issues->{'borrowernumber'} / $itemnumber ";
}
- MarkIssueReturned($borrowernumber,$itemnumber,undef,$patron->privacy) if $mark_returned;
+ MarkIssueReturned($borrowernumber,$itemnumber,undef,$patron->privacy,$params) if $mark_returned;
}
- #When item is marked lost automatically cancel its outstanding transfers and set items holdingbranch to the transfer source branch (frombranch)
- if (my ( $datesent,$frombranch,$tobranch ) = GetTransfers($itemnumber)) {
- Koha::Items->find($itemnumber)->holdingbranch($frombranch)->store({ skip_record_index => $params->{skip_record_index} });
+ # When an item is marked as lost, we should automatically cancel its outstanding transfers.
+ my $item = Koha::Items->find($itemnumber);
+ my $transfers = $item->get_transfers;
+ while (my $transfer = $transfers->next) {
+ $transfer->cancel({ reason => 'ItemLost', force => 1 });
}
- my $transferdeleted = DeleteTransfer($itemnumber);
}
sub GetOfflineOperations {
projects / srvgit / blobdiff