Lines 61-73
use Date::Calc qw(
Link Here
|
61 |
use vars qw($VERSION @ISA @EXPORT @EXPORT_OK %EXPORT_TAGS); |
61 |
use vars qw($VERSION @ISA @EXPORT @EXPORT_OK %EXPORT_TAGS); |
62 |
|
62 |
|
63 |
BEGIN { |
63 |
BEGIN { |
64 |
require Exporter; |
64 |
require Exporter; |
65 |
$VERSION = 3.07.00.049; # for version checking |
65 |
$VERSION = 3.07.00.049; # for version checking |
66 |
@ISA = qw(Exporter); |
66 |
@ISA = qw(Exporter); |
67 |
|
67 |
|
68 |
# FIXME subs that should probably be elsewhere |
68 |
# FIXME subs that should probably be elsewhere |
69 |
push @EXPORT, qw( |
69 |
push @EXPORT, qw( |
70 |
&barcodedecode |
70 |
&barcodedecode |
71 |
&LostItem |
71 |
&LostItem |
72 |
&ReturnLostItem |
72 |
&ReturnLostItem |
73 |
); |
73 |
); |
Lines 86-116
BEGIN {
Link Here
|
86 |
&GetIssuingRule |
86 |
&GetIssuingRule |
87 |
&GetBranchBorrowerCircRule |
87 |
&GetBranchBorrowerCircRule |
88 |
&GetBranchItemRule |
88 |
&GetBranchItemRule |
89 |
&GetBiblioIssues |
89 |
&GetBiblioIssues |
90 |
&GetOpenIssue |
90 |
&GetOpenIssue |
91 |
&AnonymiseIssueHistory |
91 |
&AnonymiseIssueHistory |
92 |
&CheckIfIssuedToPatron |
92 |
&CheckIfIssuedToPatron |
93 |
&IsItemIssued |
93 |
&IsItemIssued |
94 |
); |
94 |
); |
95 |
|
95 |
|
96 |
# subs to deal with returns |
96 |
# subs to deal with returns |
97 |
push @EXPORT, qw( |
97 |
push @EXPORT, qw( |
98 |
&AddReturn |
98 |
&AddReturn |
99 |
&MarkIssueReturned |
99 |
&MarkIssueReturned |
100 |
); |
100 |
); |
101 |
|
101 |
|
102 |
# subs to deal with transfers |
102 |
# subs to deal with transfers |
103 |
push @EXPORT, qw( |
103 |
push @EXPORT, qw( |
104 |
&transferbook |
104 |
&transferbook |
105 |
&GetTransfers |
105 |
&GetTransfers |
106 |
&GetTransfersFromTo |
106 |
&GetTransfersFromTo |
107 |
&updateWrongTransfer |
107 |
&updateWrongTransfer |
108 |
&DeleteTransfer |
108 |
&DeleteTransfer |
|
|
109 |
&CanItemBeTransferred |
109 |
&IsBranchTransferAllowed |
110 |
&IsBranchTransferAllowed |
110 |
&CreateBranchTransferLimit |
111 |
&CreateBranchTransferLimit |
111 |
&DeleteBranchTransferLimits |
112 |
&DeleteBranchTransferLimits |
112 |
&TransferSlip |
113 |
&TransferSlip |
113 |
); |
114 |
); |
114 |
|
115 |
|
115 |
# subs to deal with offline circulation |
116 |
# subs to deal with offline circulation |
116 |
push @EXPORT, qw( |
117 |
push @EXPORT, qw( |
Lines 163-192
sub barcodedecode {
Link Here
|
163 |
my $branch = C4::Branch::mybranch(); |
164 |
my $branch = C4::Branch::mybranch(); |
164 |
$filter = C4::Context->preference('itemBarcodeInputFilter') unless $filter; |
165 |
$filter = C4::Context->preference('itemBarcodeInputFilter') unless $filter; |
165 |
$filter or return $barcode; # ensure filter is defined, else return untouched barcode |
166 |
$filter or return $barcode; # ensure filter is defined, else return untouched barcode |
166 |
if ($filter eq 'whitespace') { |
167 |
if ($filter eq 'whitespace') { |
167 |
$barcode =~ s/\s//g; |
168 |
$barcode =~ s/\s//g; |
168 |
} elsif ($filter eq 'cuecat') { |
169 |
} elsif ($filter eq 'cuecat') { |
169 |
chomp($barcode); |
170 |
chomp($barcode); |
170 |
my @fields = split( /\./, $barcode ); |
171 |
my @fields = split( /\./, $barcode ); |
171 |
my @results = map( decode($_), @fields[ 1 .. $#fields ] ); |
172 |
my @results = map( decode($_), @fields[ 1 .. $#fields ] ); |
172 |
($#results == 2) and return $results[2]; |
173 |
($#results == 2) and return $results[2]; |
173 |
} elsif ($filter eq 'T-prefix') { |
174 |
} elsif ($filter eq 'T-prefix') { |
174 |
if ($barcode =~ /^[Tt](\d)/) { |
175 |
if ($barcode =~ /^[Tt](\d)/) { |
175 |
(defined($1) and $1 eq '0') and return $barcode; |
176 |
(defined($1) and $1 eq '0') and return $barcode; |
176 |
$barcode = substr($barcode, 2) + 0; # FIXME: probably should be substr($barcode, 1) |
177 |
$barcode = substr($barcode, 2) + 0; # FIXME: probably should be substr($barcode, 1) |
177 |
} |
178 |
} |
178 |
return sprintf("T%07d", $barcode); |
179 |
return sprintf("T%07d", $barcode); |
179 |
# FIXME: $barcode could be "T1", causing warning: substr outside of string |
180 |
# FIXME: $barcode could be "T1", causing warning: substr outside of string |
180 |
# Why drop the nonzero digit after the T? |
181 |
# Why drop the nonzero digit after the T? |
181 |
# Why pass non-digits (or empty string) to "T%07d"? |
182 |
# Why pass non-digits (or empty string) to "T%07d"? |
182 |
} elsif ($filter eq 'libsuite8') { |
183 |
} elsif ($filter eq 'libsuite8') { |
183 |
unless($barcode =~ m/^($branch)-/i){ #if barcode starts with branch code its in Koha style. Skip it. |
184 |
unless($barcode =~ m/^($branch)-/i){ #if barcode starts with branch code its in Koha style. Skip it. |
184 |
if($barcode =~ m/^(\d)/i){ #Some barcodes even start with 0's & numbers and are assumed to have b as the item type in the libsuite8 software |
185 |
if($barcode =~ m/^(\d)/i){ #Some barcodes even start with 0's & numbers and are assumed to have b as the item type in the libsuite8 software |
185 |
$barcode =~ s/^[0]*(\d+)$/$branch-b-$1/i; |
186 |
$barcode =~ s/^[0]*(\d+)$/$branch-b-$1/i; |
186 |
}else{ |
187 |
}else{ |
187 |
$barcode =~ s/^(\D+)[0]*(\d+)$/$branch-$1-$2/i; |
188 |
$barcode =~ s/^(\D+)[0]*(\d+)$/$branch-$1-$2/i; |
188 |
} |
189 |
} |
189 |
} |
190 |
} |
190 |
} elsif ($filter eq 'EAN13') { |
191 |
} elsif ($filter eq 'EAN13') { |
191 |
my $ean = CheckDigits('ean'); |
192 |
my $ean = CheckDigits('ean'); |
192 |
if ( $ean->is_valid($barcode) ) { |
193 |
if ( $ean->is_valid($barcode) ) { |
Lines 195-201
sub barcodedecode {
Link Here
|
195 |
} else { |
196 |
} else { |
196 |
warn "# [$barcode] not valid EAN-13/UPC-A\n"; |
197 |
warn "# [$barcode] not valid EAN-13/UPC-A\n"; |
197 |
} |
198 |
} |
198 |
} |
199 |
} |
199 |
return $barcode; # return barcode, modified or not |
200 |
return $barcode; # return barcode, modified or not |
200 |
} |
201 |
} |
201 |
|
202 |
|
Lines 301-307
sub transferbook {
Link Here
|
301 |
my $messages; |
302 |
my $messages; |
302 |
my $dotransfer = 1; |
303 |
my $dotransfer = 1; |
303 |
my $branches = GetBranches(); |
304 |
my $branches = GetBranches(); |
304 |
my $itemnumber = GetItemnumberFromBarcode( $barcode ); |
305 |
my $item = GetItem(undef,$barcode,undef); |
|
|
306 |
my $itemnumber = $item->{itemnumber}; |
305 |
my $issue = GetItemIssue($itemnumber); |
307 |
my $issue = GetItemIssue($itemnumber); |
306 |
my $biblio = GetBiblioFromItemNumber($itemnumber); |
308 |
my $biblio = GetBiblioFromItemNumber($itemnumber); |
307 |
|
309 |
|
Lines 316-331
sub transferbook {
Link Here
|
316 |
my $fbr = $biblio->{'holdingbranch'}; |
318 |
my $fbr = $biblio->{'holdingbranch'}; |
317 |
|
319 |
|
318 |
# if using Branch Transfer Limits |
320 |
# if using Branch Transfer Limits |
319 |
if ( C4::Context->preference("UseBranchTransferLimits") == 1 ) { |
321 |
my $errMsg; |
320 |
if ( C4::Context->preference("item-level_itypes") && C4::Context->preference("BranchTransferLimitsType") eq 'itemtype' ) { |
322 |
($dotransfer, $errMsg) = CanItemBeTransferred( $tbr, $fbr, $item, $biblio ); |
321 |
if ( ! IsBranchTransferAllowed( $tbr, $fbr, $biblio->{'itype'} ) ) { |
323 |
if ( ! $dotransfer ) { |
322 |
$messages->{'NotAllowed'} = $tbr . "::" . $biblio->{'itype'}; |
324 |
$messages->{'NotAllowed'} = $errMsg; |
323 |
$dotransfer = 0; |
|
|
324 |
} |
325 |
} elsif ( ! IsBranchTransferAllowed( $tbr, $fbr, $biblio->{ C4::Context->preference("BranchTransferLimitsType") } ) ) { |
326 |
$messages->{'NotAllowed'} = $tbr . "::" . $biblio->{ C4::Context->preference("BranchTransferLimitsType") }; |
327 |
$dotransfer = 0; |
328 |
} |
329 |
} |
325 |
} |
330 |
|
326 |
|
331 |
# if is permanent... |
327 |
# if is permanent... |
Lines 373-387
sub transferbook {
Link Here
|
373 |
sub TooMany { |
369 |
sub TooMany { |
374 |
my $borrower = shift; |
370 |
my $borrower = shift; |
375 |
my $biblionumber = shift; |
371 |
my $biblionumber = shift; |
376 |
my $item = shift; |
372 |
my $item = shift; |
377 |
my $cat_borrower = $borrower->{'categorycode'}; |
373 |
my $cat_borrower = $borrower->{'categorycode'}; |
378 |
my $dbh = C4::Context->dbh; |
374 |
my $dbh = C4::Context->dbh; |
379 |
my $branch; |
375 |
my $branch; |
380 |
# Get which branchcode we need |
376 |
# Get which branchcode we need |
381 |
$branch = _GetCircControlBranch($item,$borrower); |
377 |
$branch = _GetCircControlBranch($item,$borrower); |
382 |
my $type = (C4::Context->preference('item-level_itypes')) |
378 |
my $type = (C4::Context->preference('item-level_itypes')) |
383 |
? $item->{'itype'} # item-level |
379 |
? $item->{'itype'} # item-level |
384 |
: $item->{'itemtype'}; # biblio-level |
380 |
: $item->{'itemtype'}; # biblio-level |
385 |
|
381 |
|
386 |
# given branch, patron category, and item type, determine |
382 |
# given branch, patron category, and item type, determine |
387 |
# applicable issuing rule |
383 |
# applicable issuing rule |
Lines 698-712
sub CanBookBeIssued {
Link Here
|
698 |
|
694 |
|
699 |
my $item = GetItem(GetItemnumberFromBarcode( $barcode )); |
695 |
my $item = GetItem(GetItemnumberFromBarcode( $barcode )); |
700 |
my $issue = GetItemIssue($item->{itemnumber}); |
696 |
my $issue = GetItemIssue($item->{itemnumber}); |
701 |
my $biblioitem = GetBiblioItemData($item->{biblioitemnumber}); |
697 |
my $biblioitem = GetBiblioItemData($item->{biblioitemnumber}); |
702 |
$item->{'itemtype'}=$item->{'itype'}; |
698 |
$item->{'itemtype'}=$item->{'itype'}; |
703 |
my $dbh = C4::Context->dbh; |
699 |
my $dbh = C4::Context->dbh; |
704 |
|
700 |
|
705 |
# MANDATORY CHECKS - unless item exists, nothing else matters |
701 |
# MANDATORY CHECKS - unless item exists, nothing else matters |
706 |
unless ( $item->{barcode} ) { |
702 |
unless ( $item->{barcode} ) { |
707 |
$issuingimpossible{UNKNOWN_BARCODE} = 1; |
703 |
$issuingimpossible{UNKNOWN_BARCODE} = 1; |
708 |
} |
704 |
} |
709 |
return ( \%issuingimpossible, \%needsconfirmation ) if %issuingimpossible; |
705 |
return ( \%issuingimpossible, \%needsconfirmation ) if %issuingimpossible; |
710 |
|
706 |
|
711 |
# |
707 |
# |
712 |
# DUE DATE is OK ? -- should already have checked. |
708 |
# DUE DATE is OK ? -- should already have checked. |
Lines 739-745
sub CanBookBeIssued {
Link Here
|
739 |
# BORROWER STATUS |
735 |
# BORROWER STATUS |
740 |
# |
736 |
# |
741 |
if ( $borrower->{'category_type'} eq 'X' && ( $item->{barcode} )) { |
737 |
if ( $borrower->{'category_type'} eq 'X' && ( $item->{barcode} )) { |
742 |
# stats only borrower -- add entry to statistics table, and return issuingimpossible{STATS} = 1 . |
738 |
# stats only borrower -- add entry to statistics table, and return issuingimpossible{STATS} = 1 . |
743 |
&UpdateStats(C4::Context->userenv->{'branch'},'localuse','','',$item->{'itemnumber'},$item->{'itemtype'},$borrower->{'borrowernumber'}, undef, $item->{'ccode'}); |
739 |
&UpdateStats(C4::Context->userenv->{'branch'},'localuse','','',$item->{'itemnumber'},$item->{'itemtype'},$borrower->{'borrowernumber'}, undef, $item->{'ccode'}); |
744 |
ModDateLastSeen( $item->{'itemnumber'} ); |
740 |
ModDateLastSeen( $item->{'itemnumber'} ); |
745 |
return( { STATS => 1 }, {}); |
741 |
return( { STATS => 1 }, {}); |
Lines 809-820
sub CanBookBeIssued {
Link Here
|
809 |
my ($blocktype, $count) = C4::Members::IsMemberBlocked($borrower->{'borrowernumber'}); |
805 |
my ($blocktype, $count) = C4::Members::IsMemberBlocked($borrower->{'borrowernumber'}); |
810 |
if ($blocktype == -1) { |
806 |
if ($blocktype == -1) { |
811 |
## patron has outstanding overdue loans |
807 |
## patron has outstanding overdue loans |
812 |
if ( C4::Context->preference("OverduesBlockCirc") eq 'block'){ |
808 |
if ( C4::Context->preference("OverduesBlockCirc") eq 'block'){ |
813 |
$issuingimpossible{USERBLOCKEDOVERDUE} = $count; |
809 |
$issuingimpossible{USERBLOCKEDOVERDUE} = $count; |
814 |
} |
810 |
} |
815 |
elsif ( C4::Context->preference("OverduesBlockCirc") eq 'confirmation'){ |
811 |
elsif ( C4::Context->preference("OverduesBlockCirc") eq 'confirmation'){ |
816 |
$needsconfirmation{USERBLOCKEDOVERDUE} = $count; |
812 |
$needsconfirmation{USERBLOCKEDOVERDUE} = $count; |
817 |
} |
813 |
} |
818 |
} elsif($blocktype == 1) { |
814 |
} elsif($blocktype == 1) { |
819 |
# patron has accrued fine days |
815 |
# patron has accrued fine days |
820 |
$issuingimpossible{USERBLOCKEDREMAINING} = $count; |
816 |
$issuingimpossible{USERBLOCKEDREMAINING} = $count; |
Lines 823-829
sub CanBookBeIssued {
Link Here
|
823 |
# |
819 |
# |
824 |
# JB34 CHECKS IF BORROWERS DONT HAVE ISSUE TOO MANY BOOKS |
820 |
# JB34 CHECKS IF BORROWERS DONT HAVE ISSUE TOO MANY BOOKS |
825 |
# |
821 |
# |
826 |
my ($current_loan_count, $max_loans_allowed) = TooMany( $borrower, $item->{biblionumber}, $item ); |
822 |
my ($current_loan_count, $max_loans_allowed) = TooMany( $borrower, $item->{biblionumber}, $item ); |
827 |
# if TooMany max_loans_allowed returns 0 the user doesn't have permission to check out this book |
823 |
# if TooMany max_loans_allowed returns 0 the user doesn't have permission to check out this book |
828 |
if (defined $max_loans_allowed && $max_loans_allowed == 0) { |
824 |
if (defined $max_loans_allowed && $max_loans_allowed == 0) { |
829 |
$needsconfirmation{PATRON_CANT} = 1; |
825 |
$needsconfirmation{PATRON_CANT} = 1; |
Lines 1178-1184
AddIssue does the following things :
Link Here
|
1178 |
sub AddIssue { |
1174 |
sub AddIssue { |
1179 |
my ( $borrower, $barcode, $datedue, $cancelreserve, $issuedate, $sipmode) = @_; |
1175 |
my ( $borrower, $barcode, $datedue, $cancelreserve, $issuedate, $sipmode) = @_; |
1180 |
my $dbh = C4::Context->dbh; |
1176 |
my $dbh = C4::Context->dbh; |
1181 |
my $barcodecheck=CheckValidBarcode($barcode); |
1177 |
my $barcodecheck=CheckValidBarcode($barcode); |
1182 |
if ($datedue && ref $datedue ne 'DateTime') { |
1178 |
if ($datedue && ref $datedue ne 'DateTime') { |
1183 |
$datedue = dt_from_string($datedue); |
1179 |
$datedue = dt_from_string($datedue); |
1184 |
} |
1180 |
} |
Lines 1192-1233
sub AddIssue {
Link Here
|
1192 |
|
1188 |
|
1193 |
} |
1189 |
} |
1194 |
} |
1190 |
} |
1195 |
if ($borrower and $barcode and $barcodecheck ne '0'){#??? wtf |
1191 |
if ($borrower and $barcode and $barcodecheck ne '0'){#??? wtf |
1196 |
# find which item we issue |
1192 |
# find which item we issue |
1197 |
my $item = GetItem('', $barcode) or return; # if we don't get an Item, abort. |
1193 |
my $item = GetItem('', $barcode) or return; # if we don't get an Item, abort. |
1198 |
my $branch = _GetCircControlBranch($item,$borrower); |
1194 |
my $branch = _GetCircControlBranch($item,$borrower); |
1199 |
|
1195 |
|
1200 |
# get actual issuing if there is one |
1196 |
# get actual issuing if there is one |
1201 |
my $actualissue = GetItemIssue( $item->{itemnumber}); |
1197 |
my $actualissue = GetItemIssue( $item->{itemnumber}); |
1202 |
|
1198 |
|
1203 |
# get biblioinformation for this item |
1199 |
# get biblioinformation for this item |
1204 |
my $biblio = GetBiblioFromItemNumber($item->{itemnumber}); |
1200 |
my $biblio = GetBiblioFromItemNumber($item->{itemnumber}); |
1205 |
|
1201 |
|
1206 |
# |
1202 |
# |
1207 |
# check if we just renew the issue. |
1203 |
# check if we just renew the issue. |
1208 |
# |
1204 |
# |
1209 |
if ($actualissue->{borrowernumber} eq $borrower->{'borrowernumber'}) { |
1205 |
if ($actualissue->{borrowernumber} eq $borrower->{'borrowernumber'}) { |
1210 |
$datedue = AddRenewal( |
1206 |
$datedue = AddRenewal( |
1211 |
$borrower->{'borrowernumber'}, |
1207 |
$borrower->{'borrowernumber'}, |
1212 |
$item->{'itemnumber'}, |
1208 |
$item->{'itemnumber'}, |
1213 |
$branch, |
1209 |
$branch, |
1214 |
$datedue, |
1210 |
$datedue, |
1215 |
$issuedate, # here interpreted as the renewal date |
1211 |
$issuedate, # here interpreted as the renewal date |
1216 |
); |
1212 |
); |
1217 |
} |
1213 |
} |
1218 |
else { |
1214 |
else { |
1219 |
# it's NOT a renewal |
1215 |
# it's NOT a renewal |
1220 |
if ( $actualissue->{borrowernumber}) { |
1216 |
if ( $actualissue->{borrowernumber}) { |
1221 |
# This book is currently on loan, but not to the person |
1217 |
# This book is currently on loan, but not to the person |
1222 |
# who wants to borrow it now. mark it returned before issuing to the new borrower |
1218 |
# who wants to borrow it now. mark it returned before issuing to the new borrower |
1223 |
AddReturn( |
1219 |
AddReturn( |
1224 |
$item->{'barcode'}, |
1220 |
$item->{'barcode'}, |
1225 |
C4::Context->userenv->{'branch'} |
1221 |
C4::Context->userenv->{'branch'} |
1226 |
); |
1222 |
); |
1227 |
} |
1223 |
} |
1228 |
|
1224 |
|
1229 |
MoveReserve( $item->{'itemnumber'}, $borrower->{'borrowernumber'}, $cancelreserve ); |
1225 |
MoveReserve( $item->{'itemnumber'}, $borrower->{'borrowernumber'}, $cancelreserve ); |
1230 |
# Starting process for transfer job (checking transfert and validate it if we have one) |
1226 |
# Starting process for transfer job (checking transfert and validate it if we have one) |
1231 |
my ($datesent) = GetTransfers($item->{'itemnumber'}); |
1227 |
my ($datesent) = GetTransfers($item->{'itemnumber'}); |
1232 |
if ($datesent) { |
1228 |
if ($datesent) { |
1233 |
# updating line of branchtranfert to finish it, and changing the to branch value, implement a comment for visibility of this case (maybe for stats ....) |
1229 |
# updating line of branchtranfert to finish it, and changing the to branch value, implement a comment for visibility of this case (maybe for stats ....) |
Lines 1444-1450
sub GetIssuingRule {
Link Here
|
1444 |
my $sth = $dbh->prepare( "select * from issuingrules where categorycode=? and itemtype=? and branchcode=? and issuelength is not null" ); |
1440 |
my $sth = $dbh->prepare( "select * from issuingrules where categorycode=? and itemtype=? and branchcode=? and issuelength is not null" ); |
1445 |
my $irule; |
1441 |
my $irule; |
1446 |
|
1442 |
|
1447 |
$sth->execute( $borrowertype, $itemtype, $branchcode ); |
1443 |
$sth->execute( $borrowertype, $itemtype, $branchcode ); |
1448 |
$irule = $sth->fetchrow_hashref; |
1444 |
$irule = $sth->fetchrow_hashref; |
1449 |
return $irule if defined($irule) ; |
1445 |
return $irule if defined($irule) ; |
1450 |
|
1446 |
|
Lines 1805-1811
sub AddReturn {
Link Here
|
1805 |
if ($doreturn) { |
1801 |
if ($doreturn) { |
1806 |
my $datedue = $issue->{date_due}; |
1802 |
my $datedue = $issue->{date_due}; |
1807 |
$borrower or warn "AddReturn without current borrower"; |
1803 |
$borrower or warn "AddReturn without current borrower"; |
1808 |
my $circControlBranch; |
1804 |
my $circControlBranch; |
1809 |
if ($dropbox) { |
1805 |
if ($dropbox) { |
1810 |
# define circControlBranch only if dropbox mode is set |
1806 |
# define circControlBranch only if dropbox mode is set |
1811 |
# don't allow dropbox mode to create an invalid entry in issues (issuedate > today) |
1807 |
# don't allow dropbox mode to create an invalid entry in issues (issuedate > today) |
Lines 2745-2766
sub AddRenewal {
Link Here
|
2745 |
|
2741 |
|
2746 |
# Send a renewal slip according to checkout alert preferencei |
2742 |
# Send a renewal slip according to checkout alert preferencei |
2747 |
if ( C4::Context->preference('RenewalSendNotice') eq '1') { |
2743 |
if ( C4::Context->preference('RenewalSendNotice') eq '1') { |
2748 |
my $borrower = C4::Members::GetMemberDetails( $borrowernumber, 0 ); |
2744 |
my $borrower = C4::Members::GetMemberDetails( $borrowernumber, 0 ); |
2749 |
my $circulation_alert = 'C4::ItemCirculationAlertPreference'; |
2745 |
my $circulation_alert = 'C4::ItemCirculationAlertPreference'; |
2750 |
my %conditions = ( |
2746 |
my %conditions = ( |
2751 |
branchcode => $branch, |
2747 |
branchcode => $branch, |
2752 |
categorycode => $borrower->{categorycode}, |
2748 |
categorycode => $borrower->{categorycode}, |
2753 |
item_type => $item->{itype}, |
2749 |
item_type => $item->{itype}, |
2754 |
notification => 'CHECKOUT', |
2750 |
notification => 'CHECKOUT', |
2755 |
); |
2751 |
); |
2756 |
if ($circulation_alert->is_enabled_for(\%conditions)) { |
2752 |
if ($circulation_alert->is_enabled_for(\%conditions)) { |
2757 |
SendCirculationAlert({ |
2753 |
SendCirculationAlert({ |
2758 |
type => 'RENEWAL', |
2754 |
type => 'RENEWAL', |
2759 |
item => $item, |
2755 |
item => $item, |
2760 |
borrower => $borrower, |
2756 |
borrower => $borrower, |
2761 |
branch => $branch, |
2757 |
branch => $branch, |
2762 |
}); |
2758 |
}); |
2763 |
} |
2759 |
} |
2764 |
} |
2760 |
} |
2765 |
|
2761 |
|
2766 |
# Remove any OVERDUES related debarment if the borrower has no overdues |
2762 |
# Remove any OVERDUES related debarment if the borrower has no overdues |
Lines 2775-2781
sub AddRenewal {
Link Here
|
2775 |
|
2771 |
|
2776 |
# Log the renewal |
2772 |
# Log the renewal |
2777 |
UpdateStats( $branch, 'renew', $charge, '', $itemnumber, $item->{itype}, $borrowernumber, undef, $item->{'ccode'}); |
2773 |
UpdateStats( $branch, 'renew', $charge, '', $itemnumber, $item->{itype}, $borrowernumber, undef, $item->{'ccode'}); |
2778 |
return $datedue; |
2774 |
return $datedue; |
2779 |
} |
2775 |
} |
2780 |
|
2776 |
|
2781 |
sub GetRenewCount { |
2777 |
sub GetRenewCount { |
Lines 3138-3144
sub SendCirculationAlert {
Link Here
|
3138 |
my %message_name = ( |
3134 |
my %message_name = ( |
3139 |
CHECKIN => 'Item_Check_in', |
3135 |
CHECKIN => 'Item_Check_in', |
3140 |
CHECKOUT => 'Item_Checkout', |
3136 |
CHECKOUT => 'Item_Checkout', |
3141 |
RENEWAL => 'Item_Checkout', |
3137 |
RENEWAL => 'Item_Checkout', |
3142 |
); |
3138 |
); |
3143 |
my $borrower_preferences = C4::Members::Messaging::GetMessagingPreferences({ |
3139 |
my $borrower_preferences = C4::Members::Messaging::GetMessagingPreferences({ |
3144 |
borrowernumber => $borrower->{borrowernumber}, |
3140 |
borrowernumber => $borrower->{borrowernumber}, |
Lines 3186-3205
This function validate the line of brachtransfer but with the wrong destination
Link Here
|
3186 |
=cut |
3182 |
=cut |
3187 |
|
3183 |
|
3188 |
sub updateWrongTransfer { |
3184 |
sub updateWrongTransfer { |
3189 |
my ( $itemNumber,$waitingAtLibrary,$FromLibrary ) = @_; |
3185 |
my ( $itemNumber,$waitingAtLibrary,$FromLibrary ) = @_; |
3190 |
my $dbh = C4::Context->dbh; |
3186 |
my $dbh = C4::Context->dbh; |
3191 |
# first step validate the actual line of transfert . |
3187 |
# first step validate the actual line of transfert . |
3192 |
my $sth = |
3188 |
my $sth = |
3193 |
$dbh->prepare( |
3189 |
$dbh->prepare( |
3194 |
"update branchtransfers set datearrived = now(),tobranch=?,comments='wrongtransfer' where itemnumber= ? AND datearrived IS NULL" |
3190 |
"update branchtransfers set datearrived = now(),tobranch=?,comments='wrongtransfer' where itemnumber= ? AND datearrived IS NULL" |
3195 |
); |
3191 |
); |
3196 |
$sth->execute($FromLibrary,$itemNumber); |
3192 |
$sth->execute($FromLibrary,$itemNumber); |
3197 |
|
3193 |
|
3198 |
# second step create a new line of branchtransfer to the right location . |
3194 |
# second step create a new line of branchtransfer to the right location . |
3199 |
ModItemTransfer($itemNumber, $FromLibrary, $waitingAtLibrary); |
3195 |
ModItemTransfer($itemNumber, $FromLibrary, $waitingAtLibrary); |
3200 |
|
3196 |
|
3201 |
#third step changing holdingbranch of item |
3197 |
#third step changing holdingbranch of item |
3202 |
UpdateHoldingbranch($FromLibrary,$itemNumber); |
3198 |
UpdateHoldingbranch($FromLibrary,$itemNumber); |
3203 |
} |
3199 |
} |
3204 |
|
3200 |
|
3205 |
=head2 UpdateHoldingbranch |
3201 |
=head2 UpdateHoldingbranch |
Lines 3211-3217
Simple methode for updating hodlingbranch in items BDD line
Link Here
|
3211 |
=cut |
3207 |
=cut |
3212 |
|
3208 |
|
3213 |
sub UpdateHoldingbranch { |
3209 |
sub UpdateHoldingbranch { |
3214 |
my ( $branch,$itemnumber ) = @_; |
3210 |
my ( $branch,$itemnumber ) = @_; |
3215 |
ModItem({ holdingbranch => $branch }, undef, $itemnumber); |
3211 |
ModItem({ holdingbranch => $branch }, undef, $itemnumber); |
3216 |
} |
3212 |
} |
3217 |
|
3213 |
|
Lines 3331-3339
sub CheckRepeatableHolidays{
Link Here
|
3331 |
my($itemnumber,$week_day,$branchcode)=@_; |
3327 |
my($itemnumber,$week_day,$branchcode)=@_; |
3332 |
my $dbh = C4::Context->dbh; |
3328 |
my $dbh = C4::Context->dbh; |
3333 |
my $query = qq|SELECT count(*) |
3329 |
my $query = qq|SELECT count(*) |
3334 |
FROM repeatable_holidays |
3330 |
FROM repeatable_holidays |
3335 |
WHERE branchcode=? |
3331 |
WHERE branchcode=? |
3336 |
AND weekday=?|; |
3332 |
AND weekday=?|; |
3337 |
my $sth = $dbh->prepare($query); |
3333 |
my $sth = $dbh->prepare($query); |
3338 |
$sth->execute($branchcode,$week_day); |
3334 |
$sth->execute($branchcode,$week_day); |
3339 |
my $result=$sth->fetchrow; |
3335 |
my $result=$sth->fetchrow; |
Lines 3359-3370
sub CheckSpecialHolidays{
Link Here
|
3359 |
my ($years,$month,$day,$itemnumber,$branchcode) = @_; |
3355 |
my ($years,$month,$day,$itemnumber,$branchcode) = @_; |
3360 |
my $dbh = C4::Context->dbh; |
3356 |
my $dbh = C4::Context->dbh; |
3361 |
my $query=qq|SELECT count(*) |
3357 |
my $query=qq|SELECT count(*) |
3362 |
FROM `special_holidays` |
3358 |
FROM `special_holidays` |
3363 |
WHERE year=? |
3359 |
WHERE year=? |
3364 |
AND month=? |
3360 |
AND month=? |
3365 |
AND day=? |
3361 |
AND day=? |
3366 |
AND branchcode=? |
3362 |
AND branchcode=? |
3367 |
|; |
3363 |
|; |
3368 |
my $sth = $dbh->prepare($query); |
3364 |
my $sth = $dbh->prepare($query); |
3369 |
$sth->execute($years,$month,$day,$branchcode); |
3365 |
$sth->execute($years,$month,$day,$branchcode); |
3370 |
my $countspecial=$sth->fetchrow ; |
3366 |
my $countspecial=$sth->fetchrow ; |
Lines 3388-3398
sub CheckRepeatableSpecialHolidays{
Link Here
|
3388 |
my ($month,$day,$itemnumber,$branchcode) = @_; |
3384 |
my ($month,$day,$itemnumber,$branchcode) = @_; |
3389 |
my $dbh = C4::Context->dbh; |
3385 |
my $dbh = C4::Context->dbh; |
3390 |
my $query=qq|SELECT count(*) |
3386 |
my $query=qq|SELECT count(*) |
3391 |
FROM `repeatable_holidays` |
3387 |
FROM `repeatable_holidays` |
3392 |
WHERE month=? |
3388 |
WHERE month=? |
3393 |
AND day=? |
3389 |
AND day=? |
3394 |
AND branchcode=? |
3390 |
AND branchcode=? |
3395 |
|; |
3391 |
|; |
3396 |
my $sth = $dbh->prepare($query); |
3392 |
my $sth = $dbh->prepare($query); |
3397 |
$sth->execute($month,$day,$branchcode); |
3393 |
$sth->execute($month,$day,$branchcode); |
3398 |
my $countspecial=$sth->fetchrow ; |
3394 |
my $countspecial=$sth->fetchrow ; |
Lines 3405-3419
sub CheckValidBarcode{
Link Here
|
3405 |
my ($barcode) = @_; |
3401 |
my ($barcode) = @_; |
3406 |
my $dbh = C4::Context->dbh; |
3402 |
my $dbh = C4::Context->dbh; |
3407 |
my $query=qq|SELECT count(*) |
3403 |
my $query=qq|SELECT count(*) |
3408 |
FROM items |
3404 |
FROM items |
3409 |
WHERE barcode=? |
3405 |
WHERE barcode=? |
3410 |
|; |
3406 |
|; |
3411 |
my $sth = $dbh->prepare($query); |
3407 |
my $sth = $dbh->prepare($query); |
3412 |
$sth->execute($barcode); |
3408 |
$sth->execute($barcode); |
3413 |
my $exist=$sth->fetchrow ; |
3409 |
my $exist=$sth->fetchrow ; |
3414 |
return $exist; |
3410 |
return $exist; |
3415 |
} |
3411 |
} |
3416 |
|
3412 |
|
|
|
3413 |
|
3414 |
=head2 CanItemBeTransferred |
3415 |
|
3416 |
A convenience function to easily check item transfer limits. |
3417 |
|
3418 |
($allowed, $errorMessage) = CanItemBeTransferred( $toBranch, $fromBranch, $item, $biblioitem ); |
3419 |
($allowed, $errorMessage) = CanItemBeTransferred( $toBranch, undef, $item, undef] ); |
3420 |
|
3421 |
Checks if UseBranchTransferLimits global preference is in use. |
3422 |
Checks if the given item can be transferred from $fromBranch to $toBranch. |
3423 |
This is dependant on the global setting: |
3424 |
* UseBranchTransferLimits |
3425 |
and "Administration" -> "Library transfer limits" |
3426 |
|
3427 |
C<$toBranch> = the transfer destination library's code |
3428 |
C<$fromBranch> = OPTIONAL, the transfer departure library's code |
3429 |
DEFAULT: using the item's holdingbranch |
3430 |
C<$item> = item-object from items-table |
3431 |
C<$biblioitem> = OPTIONAL, biblioitem-object, is needed when using CCODE instead if |
3432 |
using itemtype to limit branch transfers. |
3433 |
If biblioitem-object is available, it should be provided for performance reasons. |
3434 |
C<returns> if transfer is not allowed: (0, "$fromBranch->$toBranch->transfer limit code") |
3435 |
(1) if transfer allowed. |
3436 |
=cut |
3437 |
|
3438 |
sub CanItemBeTransferred { |
3439 |
|
3440 |
#When we check for BranchTransferLimit global settings centrally, it makes |
3441 |
# using this functionality much easier. |
3442 |
unless ( C4::Context->preference("UseBranchTransferLimits") == 1 ) { |
3443 |
return 1; |
3444 |
} |
3445 |
|
3446 |
#Init parameter variables |
3447 |
my ( $toBranch, $fromBranch, $item, $biblioitem ) = @_; |
3448 |
|
3449 |
#Check the $fromBranch and set the DEFAULT value |
3450 |
$fromBranch = $item->{holdingbranch} if ! defined $fromBranch; |
3451 |
|
3452 |
if ( $toBranch eq $fromBranch ) { return 1; } ## Short circuit for speed. |
3453 |
|
3454 |
#This is the CCode or itemtype value used to find the correct transfer rule for this item. |
3455 |
my $code; |
3456 |
|
3457 |
## Figure out the $code! |
3458 |
## First we need to figure out are we using CCODE or itemtype, this limits do we need $biblioitem or not. |
3459 |
## Since $biblioitem can be optional, we cannot count that it is defined. |
3460 |
if ( C4::Context->preference("BranchTransferLimitsType") eq 'itemtype' ) { |
3461 |
if (C4::Context->preference("item-level_itypes") && defined $item->{'itype'}) { |
3462 |
$code = $item->{'itype'}; #Easiest way to get the $code is from the item. |
3463 |
} |
3464 |
elsif (defined $biblioitem->{itemtype}) { |
3465 |
$code = $biblioitem->{itemtype} |
3466 |
} |
3467 |
#If code cannot be resolved from $item or $biblioitem, we need to escalate to the DB |
3468 |
else { |
3469 |
$biblioitem = C4::Biblio::GetBiblioFromItemNumber( $item->{itemnumber} ); |
3470 |
$code = $biblioitem->{itemtype} |
3471 |
} |
3472 |
|
3473 |
} else { |
3474 |
my $limitType = C4::Context->preference("BranchTransferLimitsType"); |
3475 |
if (defined $item->{ $limitType }) { |
3476 |
$code = $item->{ $limitType }; |
3477 |
} |
3478 |
else { |
3479 |
#collection code (ccode) is not present in the Biblio, so no point looking there. |
3480 |
# If the Item doesn't have a itemtype, then give up and let the transfer pass. |
3481 |
} |
3482 |
} |
3483 |
## Phew we finally got the $code, now it's time to rumble! |
3484 |
|
3485 |
if (! IsBranchTransferAllowed($toBranch, $fromBranch, $code)) { |
3486 |
return 0, "$fromBranch->$toBranch->$code"; |
3487 |
} |
3488 |
else { |
3489 |
return 1; |
3490 |
} |
3491 |
} |
3492 |
|
3493 |
|
3417 |
=head2 IsBranchTransferAllowed |
3494 |
=head2 IsBranchTransferAllowed |
3418 |
|
3495 |
|
3419 |
$allowed = IsBranchTransferAllowed( $toBranch, $fromBranch, $code ); |
3496 |
$allowed = IsBranchTransferAllowed( $toBranch, $fromBranch, $code ); |
Lines 3423-3445
Code is either an itemtype or collection doe depending on the pref BranchTransfe
Link Here
|
3423 |
=cut |
3500 |
=cut |
3424 |
|
3501 |
|
3425 |
sub IsBranchTransferAllowed { |
3502 |
sub IsBranchTransferAllowed { |
3426 |
my ( $toBranch, $fromBranch, $code ) = @_; |
3503 |
my ( $toBranch, $fromBranch, $code ) = @_; |
3427 |
|
3504 |
|
3428 |
if ( $toBranch eq $fromBranch ) { return 1; } ## Short circuit for speed. |
3505 |
if ( $toBranch eq $fromBranch ) { return 1; } ## Short circuit for speed. |
3429 |
|
3506 |
|
3430 |
my $limitType = C4::Context->preference("BranchTransferLimitsType"); |
3507 |
my $limitType = C4::Context->preference("BranchTransferLimitsType"); |
3431 |
my $dbh = C4::Context->dbh; |
3508 |
my $dbh = C4::Context->dbh; |
3432 |
|
3509 |
|
3433 |
my $sth = $dbh->prepare("SELECT * FROM branch_transfer_limits WHERE toBranch = ? AND fromBranch = ? AND $limitType = ?"); |
3510 |
my $sth = $dbh->prepare("SELECT * FROM branch_transfer_limits WHERE toBranch = ? AND fromBranch = ? AND $limitType = ?"); |
3434 |
$sth->execute( $toBranch, $fromBranch, $code ); |
3511 |
$sth->execute( $toBranch, $fromBranch, $code ); |
3435 |
my $limit = $sth->fetchrow_hashref(); |
3512 |
my $limit = $sth->fetchrow_hashref(); |
3436 |
|
3513 |
|
3437 |
## If a row is found, then that combination is not allowed, if no matching row is found, then the combination *is allowed* |
3514 |
## If a row is found, then that combination is not allowed, if no matching row is found, then the combination *is allowed* |
3438 |
if ( $limit->{'limitId'} ) { |
3515 |
if ( $limit->{'limitId'} ) { |
3439 |
return 0; |
3516 |
return 0; |
3440 |
} else { |
3517 |
} else { |
3441 |
return 1; |
3518 |
return 1; |
3442 |
} |
3519 |
} |
3443 |
} |
3520 |
} |
3444 |
|
3521 |
|
3445 |
=head2 CreateBranchTransferLimit |
3522 |
=head2 CreateBranchTransferLimit |