fixing help feature with new template structure
[koha.git] / C4 / Circulation.pm
1 package C4::Circulation;
2
3 # Copyright 2000-2002 Katipo Communications
4 #
5 # This file is part of Koha.
6 #
7 # Koha is free software; you can redistribute it and/or modify it under the
8 # terms of the GNU General Public License as published by the Free Software
9 # Foundation; either version 2 of the License, or (at your option) any later
10 # version.
11 #
12 # Koha is distributed in the hope that it will be useful, but WITHOUT ANY
13 # WARRANTY; without even the implied warranty of MERCHANTABILITY or FITNESS FOR
14 # A PARTICULAR PURPOSE.  See the GNU General Public License for more details.
15 #
16 # You should have received a copy of the GNU General Public License along with
17 # Koha; if not, write to the Free Software Foundation, Inc., 59 Temple Place,
18 # Suite 330, Boston, MA  02111-1307 USA
19
20 # $Id$
21
22 use strict;
23 require Exporter;
24 use C4::Context;
25 use C4::Stats;
26 use C4::Reserves;
27 use C4::Koha;
28 use C4::Biblio;
29 use C4::Reserves;
30 use C4::Members;
31 use C4::Date;
32 use Date::Calc qw(
33   Today
34   Today_and_Now
35   Add_Delta_YM
36   Add_Delta_DHMS
37   Date_to_Days
38   Day_of_Week
39   Add_Delta_Days        
40 );
41 use POSIX qw(strftime);
42 use C4::Branch; # GetBranches
43 use C4::Log; # logaction
44
45 our ($VERSION,@ISA,@EXPORT,@EXPORT_OK,%EXPORT_TAGS);
46
47 # set the version for version checking
48 $VERSION = do { my @v = '$Revision$' =~ /\d+/g; shift(@v).".".join( "_", map { sprintf "%03d", $_ } @v ); };
49
50 =head1 NAME
51
52 C4::Circulation - Koha circulation module
53
54 =head1 SYNOPSIS
55
56 use C4::Circulation;
57
58 =head1 DESCRIPTION
59
60 The functions in this module deal with circulation, issues, and
61 returns, as well as general information about the library.
62 Also deals with stocktaking.
63
64 =head1 FUNCTIONS
65
66 =cut
67
68 @ISA    = qw(Exporter);
69
70 # FIXME subs that should probably be elsewhere
71 push @EXPORT, qw(
72   &FixOverduesOnReturn
73   &cuecatbarcodedecode
74 );
75
76 # subs to deal with issuing a book
77 push @EXPORT, qw(
78   &CanBookBeIssued
79   &CanBookBeRenewed
80   &AddIssue
81   &AddRenewal
82   &GetItemIssue
83   &GetItemIssues
84   &GetBorrowerIssues
85   &GetIssuingCharges
86   &GetBiblioIssues
87   &AnonymiseIssueHistory
88 );
89 # subs to deal with returns
90 push @EXPORT, qw(
91   &AddReturn
92 );
93
94 # subs to deal with transfers
95 push @EXPORT, qw(
96   &transferbook
97   &GetTransfers
98   &GetTransfersFromTo
99   &updateWrongTransfer
100   &DeleteTransfer
101 );
102
103 # FIXME - At least, I'm pretty sure this is for decoding CueCat stuff.
104 # 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 ?
105
106 =head2 decode
107
108 =head3 $str = &decode($chunk);
109
110 =over 4
111
112 =item Decodes a segment of a string emitted by a CueCat barcode scanner and
113 returns it.
114
115 =back
116
117 =cut
118
119 sub cuecatbarcodedecode {
120     my ($barcode) = @_;
121     chomp($barcode);
122     my @fields = split( /\./, $barcode );
123     my @results = map( decode($_), @fields[ 1 .. $#fields ] );
124     if ( $#results == 2 ) {
125         return $results[2];
126     }
127     else {
128         return $barcode;
129     }
130 }
131
132 =head2 decode
133
134 =head3 $str = &decode($chunk);
135
136 =over 4
137
138 =item Decodes a segment of a string emitted by a CueCat barcode scanner and
139 returns it.
140
141 =back
142
143 =cut
144
145 sub decode {
146     my ($encoded) = @_;
147     my $seq =
148       'abcdefghijklmnopqrstuvwxyzABCDEFGHIJKLMNOPQRSTUVWXYZ0123456789+-';
149     my @s = map { index( $seq, $_ ); } split( //, $encoded );
150     my $l = ( $#s + 1 ) % 4;
151     if ($l) {
152         if ( $l == 1 ) {
153             warn "Error!";
154             return;
155         }
156         $l = 4 - $l;
157         $#s += $l;
158     }
159     my $r = '';
160     while ( $#s >= 0 ) {
161         my $n = ( ( $s[0] << 6 | $s[1] ) << 6 | $s[2] ) << 6 | $s[3];
162         $r .=
163             chr( ( $n >> 16 ) ^ 67 )
164          .chr( ( $n >> 8 & 255 ) ^ 67 )
165          .chr( ( $n & 255 ) ^ 67 );
166         @s = @s[ 4 .. $#s ];
167     }
168     $r = substr( $r, 0, length($r) - $l );
169     return $r;
170 }
171
172 =head2 transferbook
173
174 ($dotransfer, $messages, $iteminformation) = &transferbook($newbranch, $barcode, $ignore_reserves);
175
176 Transfers an item to a new branch. If the item is currently on loan, it is automatically returned before the actual transfer.
177
178 C<$newbranch> is the code for the branch to which the item should be transferred.
179
180 C<$barcode> is the barcode of the item to be transferred.
181
182 If C<$ignore_reserves> is true, C<&transferbook> ignores reserves.
183 Otherwise, if an item is reserved, the transfer fails.
184
185 Returns three values:
186
187 =head3 $dotransfer 
188
189 is true if the transfer was successful.
190
191 =head3 $messages
192
193 is a reference-to-hash which may have any of the following keys:
194
195 =over 4
196
197 =item C<BadBarcode>
198
199 There is no item in the catalog with the given barcode. The value is C<$barcode>.
200
201 =item C<IsPermanent>
202
203 The item's home branch is permanent. This doesn't prevent the item from being transferred, though. The value is the code of the item's home branch.
204
205 =item C<DestinationEqualsHolding>
206
207 The item is already at the branch to which it is being transferred. The transfer is nonetheless considered to have failed. The value should be ignored.
208
209 =item C<WasReturned>
210
211 The item was on loan, and C<&transferbook> automatically returned it before transferring it. The value is the borrower number of the patron who had the item.
212
213 =item C<ResFound>
214
215 The item was reserved. The value is a reference-to-hash whose keys are fields from the reserves table of the Koha database, and C<biblioitemnumber>. It also has the key C<ResFound>, whose value is either C<Waiting> or C<Reserved>.
216
217 =item C<WasTransferred>
218
219 The item was eligible to be transferred. Barring problems communicating with the database, the transfer should indeed have succeeded. The value should be ignored.
220
221 =back
222
223 =cut
224
225 sub transferbook {
226     my ( $tbr, $barcode, $ignoreRs ) = @_;
227     my $messages;
228     my $dotransfer      = 1;
229     my $branches        = GetBranches();
230     my $itemnumber = GetItemnumberFromBarcode( $barcode );
231     my $issue      = GetItemIssue($itemnumber);
232     my $biblio = GetBiblioFromItemNumber($itemnumber);
233
234     # bad barcode..
235     if ( not $itemnumber ) {
236         $messages->{'BadBarcode'} = $barcode;
237         $dotransfer = 0;
238     }
239
240     # get branches of book...
241     my $hbr = $biblio->{'homebranch'};
242     my $fbr = $biblio->{'holdingbranch'};
243
244     # if is permanent...
245     if ( $hbr && $branches->{$hbr}->{'PE'} ) {
246         $messages->{'IsPermanent'} = $hbr;
247     }
248
249     # can't transfer book if is already there....
250     if ( $fbr eq $tbr ) {
251         $messages->{'DestinationEqualsHolding'} = 1;
252         $dotransfer = 0;
253     }
254
255     # check if it is still issued to someone, return it...
256     if ($issue->{borrowernumber}) {
257         AddReturn( $barcode, $fbr );
258         $messages->{'WasReturned'} = $issue->{borrowernumber};
259     }
260
261     # find reserves.....
262     # That'll save a database query.
263     my ( $resfound, $resrec ) =
264       CheckReserves( $itemnumber );
265     if ( $resfound and not $ignoreRs ) {
266         $resrec->{'ResFound'} = $resfound;
267
268         #         $messages->{'ResFound'} = $resrec;
269         $dotransfer = 1;
270     }
271
272     #actually do the transfer....
273     if ($dotransfer) {
274         ModItemTransfer( $itemnumber, $fbr, $tbr );
275
276         # don't need to update MARC anymore, we do it in batch now
277         $messages->{'WasTransfered'} = 1;
278                 ModDateLastSeen( $itemnumber );
279     }
280     return ( $dotransfer, $messages, $biblio );
281 }
282
283 =head2 CanBookBeIssued
284
285 Check if a book can be issued.
286
287 my ($issuingimpossible,$needsconfirmation) = CanBookBeIssued($borrower,$barcode,$year,$month,$day);
288
289 =over 4
290
291 =item C<$borrower> hash with borrower informations (from GetMemberDetails)
292
293 =item C<$barcode> is the bar code of the book being issued.
294
295 =item C<$year> C<$month> C<$day> contains the date of the return (in case it's forced by "stickyduedate".
296
297 =back
298
299 Returns :
300
301 =over 4
302
303 =item C<$issuingimpossible> a reference to a hash. It contains reasons why issuing is impossible.
304 Possible values are :
305
306 =back
307
308 =head3 INVALID_DATE 
309
310 sticky due date is invalid
311
312 =head3 GNA
313
314 borrower gone with no address
315
316 =head3 CARD_LOST
317
318 borrower declared it's card lost
319
320 =head3 DEBARRED
321
322 borrower debarred
323
324 =head3 UNKNOWN_BARCODE
325
326 barcode unknown
327
328 =head3 NOT_FOR_LOAN
329
330 item is not for loan
331
332 =head3 WTHDRAWN
333
334 item withdrawn.
335
336 =head3 RESTRICTED
337
338 item is restricted (set by ??)
339
340 C<$issuingimpossible> a reference to a hash. It contains reasons why issuing is impossible.
341 Possible values are :
342
343 =head3 DEBT
344
345 borrower has debts.
346
347 =head3 RENEW_ISSUE
348
349 renewing, not issuing
350
351 =head3 ISSUED_TO_ANOTHER
352
353 issued to someone else.
354
355 =head3 RESERVED
356
357 reserved for someone else.
358
359 =head3 INVALID_DATE
360
361 sticky due date is invalid
362
363 =head3 TOO_MANY
364
365 if the borrower borrows to much things
366
367 =cut
368
369 # check if a book can be issued.
370 # returns an array with errors if any
371
372 sub TooMany ($$) {
373     my $borrower        = shift;
374     my $biblionumber = shift;
375     my $cat_borrower    = $borrower->{'categorycode'};
376     my $branch_borrower = $borrower->{'branchcode'};
377     my $dbh             = C4::Context->dbh;
378
379     my $sth =
380       $dbh->prepare('select itemtype from biblioitems where biblionumber = ?');
381     $sth->execute($biblionumber);
382     my $type = $sth->fetchrow;
383     $sth =
384       $dbh->prepare(
385 'select * from issuingrules where categorycode = ? and itemtype = ? and branchcode = ?'
386       );
387
388 #     my $sth2 = $dbh->prepare("select COUNT(*) from issues i, biblioitems s where i.borrowernumber = ? and i.returndate is null and i.itemnumber = s.biblioitemnumber and s.itemtype like ?");
389     my $sth2 =
390       $dbh->prepare(
391 "select COUNT(*) from issues i, biblioitems s1, items s2 where i.borrowernumber = ? and i.returndate is null and i.itemnumber = s2.itemnumber and s1.itemtype like ? and s1.biblioitemnumber = s2.biblioitemnumber"
392       );
393     my $sth3 =
394       $dbh->prepare(
395 'select COUNT(*) from issues where borrowernumber = ? and returndate is null'
396       );
397     my $alreadyissued;
398
399     # check the 3 parameters
400     $sth->execute( $cat_borrower, $type, $branch_borrower );
401     my $result = $sth->fetchrow_hashref;
402
403     #    warn "==>".$result->{maxissueqty};
404
405 # Currently, using defined($result) ie on an entire hash reports whether memory
406 # for that aggregate has ever been allocated. As $result is used all over the place
407 # it would rarely return as undefined.
408     if ( defined( $result->{maxissueqty} ) ) {
409         $sth2->execute( $borrower->{'borrowernumber'}, "%$type%" );
410         my $alreadyissued = $sth2->fetchrow;
411         if ( $result->{'maxissueqty'} <= $alreadyissued ) {
412             return ( "a $alreadyissued / ".( $result->{maxissueqty} + 0 ) );
413         }
414         else {
415             return;
416         }
417     }
418
419     # check for branch=*
420     $sth->execute( $cat_borrower, $type, "" );
421     $result = $sth->fetchrow_hashref;
422     if ( defined( $result->{maxissueqty} ) ) {
423         $sth2->execute( $borrower->{'borrowernumber'}, "%$type%" );
424         my $alreadyissued = $sth2->fetchrow;
425         if ( $result->{'maxissueqty'} <= $alreadyissued ) {
426             return ( "b $alreadyissued / ".( $result->{maxissueqty} + 0 ) );
427         }
428         else {
429             return;
430         }
431     }
432
433     # check for itemtype=*
434     $sth->execute( $cat_borrower, "*", $branch_borrower );
435     $result = $sth->fetchrow_hashref;
436     if ( defined( $result->{maxissueqty} ) ) {
437         $sth3->execute( $borrower->{'borrowernumber'} );
438         my ($alreadyissued) = $sth3->fetchrow;
439         if ( $result->{'maxissueqty'} <= $alreadyissued ) {
440
441 #        warn "HERE : $alreadyissued / ($result->{maxissueqty} for $borrower->{'borrowernumber'}";
442             return ( "c $alreadyissued / " . ( $result->{maxissueqty} + 0 ) );
443         }
444         else {
445             return;
446         }
447     }
448
449     # check for borrowertype=*
450     $sth->execute( "*", $type, $branch_borrower );
451     $result = $sth->fetchrow_hashref;
452     if ( defined( $result->{maxissueqty} ) ) {
453         $sth2->execute( $borrower->{'borrowernumber'}, "%$type%" );
454         my $alreadyissued = $sth2->fetchrow;
455         if ( $result->{'maxissueqty'} <= $alreadyissued ) {
456             return ( "d $alreadyissued / " . ( $result->{maxissueqty} + 0 ) );
457         }
458         else {
459             return;
460         }
461     }
462
463     $sth->execute( "*", "*", $branch_borrower );
464     $result = $sth->fetchrow_hashref;
465     if ( defined( $result->{maxissueqty} ) ) {
466         $sth3->execute( $borrower->{'borrowernumber'} );
467         my $alreadyissued = $sth3->fetchrow;
468         if ( $result->{'maxissueqty'} <= $alreadyissued ) {
469             return ( "e $alreadyissued / " . ( $result->{maxissueqty} + 0 ) );
470         }
471         else {
472             return;
473         }
474     }
475
476     $sth->execute( "*", $type, "" );
477     $result = $sth->fetchrow_hashref;
478     if ( defined( $result->{maxissueqty} ) && $result->{maxissueqty} >= 0 ) {
479         $sth2->execute( $borrower->{'borrowernumber'}, "%$type%" );
480         my $alreadyissued = $sth2->fetchrow;
481         if ( $result->{'maxissueqty'} <= $alreadyissued ) {
482             return ( "f $alreadyissued / " . ( $result->{maxissueqty} + 0 ) );
483         }
484         else {
485             return;
486         }
487     }
488
489     $sth->execute( $cat_borrower, "*", "" );
490     $result = $sth->fetchrow_hashref;
491     if ( defined( $result->{maxissueqty} ) ) {
492         $sth2->execute( $borrower->{'borrowernumber'}, "%$type%" );
493         my $alreadyissued = $sth2->fetchrow;
494         if ( $result->{'maxissueqty'} <= $alreadyissued ) {
495             return ( "g $alreadyissued / " . ( $result->{maxissueqty} + 0 ) );
496         }
497         else {
498             return;
499         }
500     }
501
502     $sth->execute( "*", "*", "" );
503     $result = $sth->fetchrow_hashref;
504     if ( defined( $result->{maxissueqty} ) ) {
505         $sth3->execute( $borrower->{'borrowernumber'} );
506         my $alreadyissued = $sth3->fetchrow;
507         if ( $result->{'maxissueqty'} <= $alreadyissued ) {
508             return ( "h $alreadyissued / " . ( $result->{maxissueqty} + 0 ) );
509         }
510         else {
511             return;
512         }
513     }
514     return;
515 }
516
517 =head2 itemissues
518
519   @issues = &itemissues($biblioitemnumber, $biblio);
520
521 Looks up information about who has borrowed the bookZ<>(s) with the
522 given biblioitemnumber.
523
524 C<$biblio> is ignored.
525
526 C<&itemissues> returns an array of references-to-hash. The keys
527 include the fields from the C<items> table in the Koha database.
528 Additional keys include:
529
530 =over 4
531
532 =item C<date_due>
533
534 If the item is currently on loan, this gives the due date.
535
536 If the item is not on loan, then this is either "Available" or
537 "Cancelled", if the item has been withdrawn.
538
539 =item C<card>
540
541 If the item is currently on loan, this gives the card number of the
542 patron who currently has the item.
543
544 =item C<timestamp0>, C<timestamp1>, C<timestamp2>
545
546 These give the timestamp for the last three times the item was
547 borrowed.
548
549 =item C<card0>, C<card1>, C<card2>
550
551 The card number of the last three patrons who borrowed this item.
552
553 =item C<borrower0>, C<borrower1>, C<borrower2>
554
555 The borrower number of the last three patrons who borrowed this item.
556
557 =back
558
559 =cut
560
561 #'
562 sub itemissues {
563     my ( $bibitem, $biblio ) = @_;
564     my $dbh = C4::Context->dbh;
565
566     # FIXME - If this function die()s, the script will abort, and the
567     # user won't get anything; depending on how far the script has
568     # gotten, the user might get a blank page. It would be much better
569     # to at least print an error message. The easiest way to do this
570     # is to set $SIG{__DIE__}.
571     my $sth =
572       $dbh->prepare("Select * from items where items.biblioitemnumber = ?")
573       || die $dbh->errstr;
574     my $i = 0;
575     my @results;
576
577     $sth->execute($bibitem) || die $sth->errstr;
578
579     while ( my $data = $sth->fetchrow_hashref ) {
580
581         # Find out who currently has this item.
582         # FIXME - Wouldn't it be better to do this as a left join of
583         # some sort? Currently, this code assumes that if
584         # fetchrow_hashref() fails, then the book is on the shelf.
585         # fetchrow_hashref() can fail for any number of reasons (e.g.,
586         # database server crash), not just because no items match the
587         # search criteria.
588         my $sth2 = $dbh->prepare(
589             "SELECT * FROM issues
590                 LEFT JOIN borrowers ON issues.borrowernumber = borrowers.borrowernumber
591                 WHERE itemnumber = ?
592                     AND returndate IS NULL
593             "
594         );
595
596         $sth2->execute( $data->{'itemnumber'} );
597         if ( my $data2 = $sth2->fetchrow_hashref ) {
598             $data->{'date_due'} = $data2->{'date_due'};
599             $data->{'card'}     = $data2->{'cardnumber'};
600             $data->{'borrower'} = $data2->{'borrowernumber'};
601         }
602         else {
603             if ( $data->{'wthdrawn'} eq '1' ) {
604                 $data->{'date_due'} = 'Cancelled';
605             }
606             else {
607                 $data->{'date_due'} = 'Available';
608             }    # else
609         }    # else
610
611         $sth2->finish;
612
613         # Find the last 3 people who borrowed this item.
614         $sth2 = $dbh->prepare(
615             "SELECT * FROM issues, borrowers
616                 LEFT JOIN borrowers ON  issues.borrowernumber = borrowers.borrowernumber
617                 WHERE itemnumber = ?
618                 AND returndate IS NOT NULL
619                 ORDER BY returndate DESC,timestamp DESC"
620         );
621
622 #        $sth2 = $dbh->prepare("
623 #            SELECT *
624 #            FROM issues
625 #                LEFT JOIN borrowers ON issues.borrowernumber = borrowers.borrowernumber
626 #            WHERE   itemnumber = ?
627 #                AND returndate is not NULL
628 #            ORDER BY returndate DESC,timestamp DESC
629 #        ");
630
631         $sth2->execute( $data->{'itemnumber'} );
632         for ( my $i2 = 0 ; $i2 < 2 ; $i2++ )
633         {    # FIXME : error if there is less than 3 pple borrowing this item
634             if ( my $data2 = $sth2->fetchrow_hashref ) {
635                 $data->{"timestamp$i2"} = $data2->{'timestamp'};
636                 $data->{"card$i2"}      = $data2->{'cardnumber'};
637                 $data->{"borrower$i2"}  = $data2->{'borrowernumber'};
638             }    # if
639         }    # for
640
641         $sth2->finish;
642         $results[$i] = $data;
643         $i++;
644     }
645
646     $sth->finish;
647     return (@results);
648 }
649
650 =head2 CanBookBeIssued
651
652 $issuingimpossible, $needsconfirmation = 
653         CanBookBeIssued( $borrower, $barcode, $year, $month, $day, $inprocess );
654
655 C<$issuingimpossible> and C<$needsconfirmation> are some hashref.
656
657 =cut
658
659 sub CanBookBeIssued {
660     my ( $borrower, $barcode, $year, $month, $day, $inprocess ) = @_;
661     my %needsconfirmation;    # filled with problems that needs confirmations
662     my %issuingimpossible;    # filled with problems that causes the issue to be IMPOSSIBLE
663     my $item = GetItem(GetItemnumberFromBarcode( $barcode ));
664     my $issue = GetItemIssue($item->{itemnumber});
665     my $dbh             = C4::Context->dbh;
666
667     #
668     # DUE DATE is OK ?
669     #
670     my ( $duedate, $invalidduedate ) = fixdate( $year, $month, $day );
671     $issuingimpossible{INVALID_DATE} = 1 if ($invalidduedate);
672
673     #
674     # BORROWER STATUS
675     #
676     if ( $borrower->{flags}->{GNA} ) {
677         $issuingimpossible{GNA} = 1;
678     }
679     if ( $borrower->{flags}->{'LOST'} ) {
680         $issuingimpossible{CARD_LOST} = 1;
681     }
682     if ( $borrower->{flags}->{'DBARRED'} ) {
683         $issuingimpossible{DEBARRED} = 1;
684     }
685     if ( Date_to_Days(Today) > 
686         Date_to_Days( split "-", $borrower->{'dateexpiry'} ) )
687     {
688
689         #
690         #if (&Date_Cmp(&ParseDate($borrower->{expiry}),&ParseDate("today"))<0) {
691         $issuingimpossible{EXPIRED} = 1;
692     }
693
694     #
695     # BORROWER STATUS
696     #
697
698     # DEBTS
699     my ($amount) =
700       GetMemberAccountRecords( $borrower->{'borrowernumber'}, $duedate );
701     if ( C4::Context->preference("IssuingInProcess") ) {
702         my $amountlimit = C4::Context->preference("noissuescharge");
703         if ( $amount > $amountlimit && !$inprocess ) {
704             $issuingimpossible{DEBT} = sprintf( "%.2f", $amount );
705         }
706         elsif ( $amount <= $amountlimit && !$inprocess ) {
707             $needsconfirmation{DEBT} = sprintf( "%.2f", $amount );
708         }
709     }
710     else {
711         if ( $amount > 0 ) {
712             $needsconfirmation{DEBT} = $amount;
713         }
714     }
715
716     #
717     # JB34 CHECKS IF BORROWERS DONT HAVE ISSUE TOO MANY BOOKS
718     #
719     my $toomany = TooMany( $borrower, $item->{biblionumber} );
720     $needsconfirmation{TOO_MANY} = $toomany if $toomany;
721
722     #
723     # ITEM CHECKING
724     #
725     unless ( $item->{barcode} ) {
726         $issuingimpossible{UNKNOWN_BARCODE} = 1;
727     }
728     if (   $item->{'notforloan'}
729         && $item->{'notforloan'} > 0 )
730     {
731         $issuingimpossible{NOT_FOR_LOAN} = 1;
732     }
733     if ( $item->{'wthdrawn'} && $item->{'wthdrawn'} == 1 )
734     {
735         $issuingimpossible{WTHDRAWN} = 1;
736     }
737     if (   $item->{'restricted'}
738         && $item->{'restricted'} == 1 )
739     {
740         $issuingimpossible{RESTRICTED} = 1;
741     }
742     if ( C4::Context->preference("IndependantBranches") ) {
743         my $userenv = C4::Context->userenv;
744         if ( ($userenv) && ( $userenv->{flags} != 1 ) ) {
745             $issuingimpossible{NOTSAMEBRANCH} = 1
746               if ( $item->{'holdingbranch'} ne $userenv->{branch} );
747         }
748     }
749
750     #
751     # CHECK IF BOOK ALREADY ISSUED TO THIS BORROWER
752     #
753     if ( $issue->{borrowernumber} && $issue->{borrowernumber} eq $borrower->{'borrowernumber'} )
754     {
755
756         # Already issued to current borrower. Ask whether the loan should
757         # be renewed.
758         my ($CanBookBeRenewed) = CanBookBeRenewed(
759             $borrower->{'borrowernumber'},
760             $item->{'itemnumber'}
761         );
762         if ( $CanBookBeRenewed == 0 ) {    # no more renewals allowed
763             $issuingimpossible{NO_MORE_RENEWALS} = 1;
764         }
765         else {
766
767             #        $needsconfirmation{RENEW_ISSUE} = 1;
768         }
769     }
770     elsif ($issue->{borrowernumber}) {
771
772         # issued to someone else
773         my $currborinfo = GetMemberDetails( $issue->{borrowernumber} );
774
775 #        warn "=>.$currborinfo->{'firstname'} $currborinfo->{'surname'} ($currborinfo->{'cardnumber'})";
776         $needsconfirmation{ISSUED_TO_ANOTHER} =
777 "$currborinfo->{'reservedate'} : $currborinfo->{'firstname'} $currborinfo->{'surname'} ($currborinfo->{'cardnumber'})";
778     }
779
780     # See if the item is on reserve.
781     my ( $restype, $res ) = CheckReserves( $item->{'itemnumber'} );
782     if ($restype) {
783         my $resbor = $res->{'borrowernumber'};
784         if ( $resbor ne $borrower->{'borrowernumber'} && $restype eq "Waiting" )
785         {
786
787             # The item is on reserve and waiting, but has been
788             # reserved by some other patron.
789             my ( $resborrower, $flags ) =
790               GetMemberDetails( $resbor, 0 );
791             my $branches   = GetBranches();
792             my $branchname =
793               $branches->{ $res->{'branchcode'} }->{'branchname'};
794             $needsconfirmation{RESERVE_WAITING} =
795 "$resborrower->{'firstname'} $resborrower->{'surname'} ($resborrower->{'cardnumber'}, $branchname)";
796
797 # CancelReserve(0, $res->{'itemnumber'}, $res->{'borrowernumber'}); Doesn't belong in a checking subroutine.
798         }
799         elsif ( $restype eq "Reserved" ) {
800
801             # The item is on reserve for someone else.
802             my ( $resborrower, $flags ) =
803               GetMemberDetails( $resbor, 0 );
804             my $branches   = GetBranches();
805             my $branchname =
806               $branches->{ $res->{'branchcode'} }->{'branchname'};
807             $needsconfirmation{RESERVED} =
808 "$res->{'reservedate'} : $resborrower->{'firstname'} $resborrower->{'surname'} ($resborrower->{'cardnumber'})";
809         }
810     }
811     if ( C4::Context->preference("LibraryName") eq "Horowhenua Library Trust" )
812     {
813         if ( $borrower->{'categorycode'} eq 'W' ) {
814             my %issuingimpossible;
815             return ( \%issuingimpossible, \%needsconfirmation );
816         }
817         else {
818             return ( \%issuingimpossible, \%needsconfirmation );
819         }
820     }
821     else {
822         return ( \%issuingimpossible, \%needsconfirmation );
823     }
824 }
825
826 =head2 AddIssue
827
828 Issue a book. Does no check, they are done in CanBookBeIssued. If we reach this sub, it means the user confirmed if needed.
829
830 &AddIssue($borrower,$barcode,$date)
831
832 =over 4
833
834 =item C<$borrower> hash with borrower informations (from GetMemberDetails)
835
836 =item C<$barcode> is the bar code of the book being issued.
837
838 =item C<$date> contains the max date of return. calculated if empty.
839
840 AddIssue does the following things :
841 - step 01: check that there is a borrowernumber & a barcode provided
842 - check for RENEWAL (book issued & being issued to the same patron)
843     - renewal YES = Calculate Charge & renew
844     - renewal NO  = 
845         * BOOK ACTUALLY ISSUED ? do a return if book is actually issued (but to someone else)
846         * RESERVE PLACED ?
847             - fill reserve if reserve to this patron
848             - cancel reserve or not, otherwise
849         * TRANSFERT PENDING ?
850             - complete the transfert
851         * ISSUE THE BOOK
852
853 =back
854
855 =cut
856
857 sub AddIssue {
858     my ( $borrower, $barcode, $date, $cancelreserve ) = @_;
859     
860     my $dbh = C4::Context->dbh;
861 my $barcodecheck=CheckValidBarcode($barcode);
862 if ($borrower and $barcode and $barcodecheck ne '0'){
863 #   my ($borrower, $flags) = &GetMemberDetails($borrowernumber, 0);
864     # find which item we issue
865     my $item = GetItem('', $barcode);
866     
867     # get actual issuing if there is one
868     my $actualissue = GetItemIssue( $item->{itemnumber});
869     
870     # get biblioinformation for this item
871     my $biblio = GetBiblioFromItemNumber($item->{itemnumber});
872
873     #
874     # check if we just renew the issue.
875     #
876     if ( $actualissue->{borrowernumber} eq $borrower->{'borrowernumber'} ) {
877         # we renew, do we need to add some charge ?
878         my ( $charge, $itemtype ) = GetIssuingCharges(
879             $item->{'itemnumber'},
880             $borrower->{'borrowernumber'}
881         );
882         if ( $charge > 0 ) {
883             AddIssuingCharge(
884                 $item->{'itemnumber'},
885                 $borrower->{'borrowernumber'}, $charge
886             );
887             $item->{'charge'} = $charge;
888         }
889         &UpdateStats(
890             C4::Context->userenv->{'branch'},
891             'renew',                        $charge,
892             '',                             $item->{'itemnumber'},
893             $biblio->{'itemtype'}, $borrower->{'borrowernumber'}
894         );
895         AddRenewal(
896             $borrower->{'borrowernumber'},
897             $item->{'itemnumber'}
898         );
899     }
900     else {# it's NOT a renewal
901         if ( $actualissue->{borrowernumber}) {
902             # This book is currently on loan, but not to the person
903             # who wants to borrow it now. mark it returned before issuing to the new borrower
904             AddReturn(
905                 $item->{'barcode'},
906                 C4::Context->userenv->{'branch'}
907             );
908         }
909
910         # See if the item is on reserve.
911         my ( $restype, $res ) =
912           CheckReserves( $item->{'itemnumber'} );
913         if ($restype) {
914             my $resbor = $res->{'borrowernumber'};
915             if ( $resbor eq $borrower->{'borrowernumber'} ) {
916
917                 # The item is reserved by the current patron
918                 ModReserveFill($res);
919             }
920             elsif ( $restype eq "Waiting" ) {
921
922                 # warn "Waiting";
923                 # The item is on reserve and waiting, but has been
924                 # reserved by some other patron.
925                 my ( $resborrower, $flags ) = GetMemberDetails( $resbor, 0 );
926                 my $branches   = GetBranches();
927                 my $branchname =
928                   $branches->{ $res->{'branchcode'} }->{'branchname'};
929                 if ($cancelreserve) {
930                     CancelReserve( 0, $res->{'itemnumber'},
931                         $res->{'borrowernumber'} );
932                 }
933                 else {
934
935        # set waiting reserve to first in reserve queue as book isn't waiting now
936                     ModReserve(
937                         1,
938                         $res->{'biblionumber'},
939                         $res->{'borrowernumber'},
940                         $res->{'branchcode'}
941                     );
942                 }
943             }
944             elsif ( $restype eq "Reserved" ) {
945
946                 # warn "Reserved";
947                 # The item is reserved by someone else.
948                 my ( $resborrower, $flags ) =
949                   GetMemberDetails( $resbor, 0 );
950                 my $branches   = GetBranches();
951                 my $branchname =
952                   $branches->{ $res->{'branchcode'} }->{'branchname'};
953                 if ($cancelreserve) { # cancel reserves on this item
954                     CancelReserve( 0, $res->{'itemnumber'},
955                         $res->{'borrowernumber'} );
956                 }
957             }
958         }
959
960         # Starting process for transfer job (checking transfert and validate it if we have one)
961             my ($datesent) = GetTransfers($item->{'itemnumber'});
962             if ($datesent) {
963         #       updating line of branchtranfert to finish it, and changing the to branch value, implement a comment for lisibility of this case (maybe for stats ....)
964             my $sth =
965                     $dbh->prepare(
966                     "UPDATE branchtransfers 
967                         SET datearrived = now(),
968                         tobranch = ?,
969                         comments = 'Forced branchtransfert'
970                     WHERE itemnumber= ? AND datearrived IS NULL"
971                     );
972                     $sth->execute(C4::Context->userenv->{'branch'},$item->{'itemnumber'});
973                     $sth->finish;
974             }
975
976         # Record in the database the fact that the book was issued.
977         my $sth =
978           $dbh->prepare(
979                 "INSERT INTO issues 
980                     (borrowernumber, itemnumber,issuedate, date_due, branchcode)
981                 VALUES (?,?,?,?,?)"
982           );
983         my $loanlength = GetLoanLength(
984             $borrower->{'categorycode'},
985             $biblio->{'itemtype'},
986             $borrower->{'branchcode'}
987         );
988         my $datedue  = time + ($loanlength) * 86400;
989         my @datearr  = localtime($datedue);
990         my $dateduef =
991             ( 1900 + $datearr[5] ) . "-"
992           . ( $datearr[4] + 1 ) . "-"
993           . $datearr[3];
994         if ($date) {
995             $dateduef = $date;
996         }
997         $dateduef=CheckValidDatedue($dateduef,$item->{'itemnumber'},C4::Context->userenv->{'branch'});
998        # if ReturnBeforeExpiry ON the datedue can't be after borrower expirydate
999         if ( C4::Context->preference('ReturnBeforeExpiry')
1000             && $dateduef gt $borrower->{dateexpiry} )
1001         {
1002             $dateduef = $borrower->{dateexpiry};
1003         }
1004         $sth->execute(
1005             $borrower->{'borrowernumber'},
1006             $item->{'itemnumber'},
1007             strftime( "%Y-%m-%d", localtime ),$dateduef, C4::Context->userenv->{'branch'}
1008         );
1009         $sth->finish;
1010         $item->{'issues'}++;
1011         $sth =
1012           $dbh->prepare(
1013             "UPDATE items SET issues=?, holdingbranch=?, itemlost=0, datelastborrowed  = now() WHERE itemnumber=?");
1014         $sth->execute(
1015             $item->{'issues'},
1016             C4::Context->userenv->{'branch'},
1017             $item->{'itemnumber'}
1018         );
1019         $sth->finish;
1020         &ModDateLastSeen( $item->{'itemnumber'} );
1021         # If it costs to borrow this book, charge it to the patron's account.
1022         my ( $charge, $itemtype ) = GetIssuingCharges(
1023             $item->{'itemnumber'},
1024             $borrower->{'borrowernumber'}
1025         );
1026         if ( $charge > 0 ) {
1027             AddIssuingCharge(
1028                 $item->{'itemnumber'},
1029                 $borrower->{'borrowernumber'}, $charge
1030             );
1031             $item->{'charge'} = $charge;
1032         }
1033
1034         # Record the fact that this book was issued.
1035         &UpdateStats(
1036             C4::Context->userenv->{'branch'},
1037             'issue',                        $charge,
1038             '',                             $item->{'itemnumber'},
1039             $item->{'itemtype'}, $borrower->{'borrowernumber'}
1040         );
1041     }
1042     
1043     &logaction(C4::Context->userenv->{'number'},"CIRCULATION","ISSUE",$borrower->{'borrowernumber'},$biblio->{'biblionumber'}) 
1044         if C4::Context->preference("IssueLog");
1045   }  
1046 }
1047
1048 =head2 GetLoanLength
1049
1050 Get loan length for an itemtype, a borrower type and a branch
1051
1052 my $loanlength = &GetLoanLength($borrowertype,$itemtype,branchcode)
1053
1054 =cut
1055
1056 sub GetLoanLength {
1057     my ( $borrowertype, $itemtype, $branchcode ) = @_;
1058     my $dbh = C4::Context->dbh;
1059     my $sth =
1060       $dbh->prepare(
1061 "select issuelength from issuingrules where categorycode=? and itemtype=? and branchcode=?"
1062       );
1063
1064 # try to find issuelength & return the 1st available.
1065 # check with borrowertype, itemtype and branchcode, then without one of those parameters
1066     $sth->execute( $borrowertype, $itemtype, $branchcode );
1067     my $loanlength = $sth->fetchrow_hashref;
1068     return $loanlength->{issuelength}
1069       if defined($loanlength) && $loanlength->{issuelength} ne 'NULL';
1070
1071     $sth->execute( $borrowertype, $itemtype, "" );
1072     $loanlength = $sth->fetchrow_hashref;
1073     return $loanlength->{issuelength}
1074       if defined($loanlength) && $loanlength->{issuelength} ne 'NULL';
1075
1076     $sth->execute( $borrowertype, "*", $branchcode );
1077     $loanlength = $sth->fetchrow_hashref;
1078     return $loanlength->{issuelength}
1079       if defined($loanlength) && $loanlength->{issuelength} ne 'NULL';
1080
1081     $sth->execute( "*", $itemtype, $branchcode );
1082     $loanlength = $sth->fetchrow_hashref;
1083     return $loanlength->{issuelength}
1084       if defined($loanlength) && $loanlength->{issuelength} ne 'NULL';
1085
1086     $sth->execute( $borrowertype, "*", "" );
1087     $loanlength = $sth->fetchrow_hashref;
1088     return $loanlength->{issuelength}
1089       if defined($loanlength) && $loanlength->{issuelength} ne 'NULL';
1090
1091     $sth->execute( "*", "*", $branchcode );
1092     $loanlength = $sth->fetchrow_hashref;
1093     return $loanlength->{issuelength}
1094       if defined($loanlength) && $loanlength->{issuelength} ne 'NULL';
1095
1096     $sth->execute( "*", $itemtype, "" );
1097     $loanlength = $sth->fetchrow_hashref;
1098     return $loanlength->{issuelength}
1099       if defined($loanlength) && $loanlength->{issuelength} ne 'NULL';
1100
1101     $sth->execute( "*", "*", "" );
1102     $loanlength = $sth->fetchrow_hashref;
1103     return $loanlength->{issuelength}
1104       if defined($loanlength) && $loanlength->{issuelength} ne 'NULL';
1105
1106     # if no rule is set => 21 days (hardcoded)
1107     return 21;
1108 }
1109
1110 =head2 AddReturn
1111
1112 ($doreturn, $messages, $iteminformation, $borrower) =
1113     &AddReturn($barcode, $branch);
1114
1115 Returns a book.
1116
1117 C<$barcode> is the bar code of the book being returned. C<$branch> is
1118 the code of the branch where the book is being returned.
1119
1120 C<&AddReturn> returns a list of four items:
1121
1122 C<$doreturn> is true iff the return succeeded.
1123
1124 C<$messages> is a reference-to-hash giving the reason for failure:
1125
1126 =over 4
1127
1128 =item C<BadBarcode>
1129
1130 No item with this barcode exists. The value is C<$barcode>.
1131
1132 =item C<NotIssued>
1133
1134 The book is not currently on loan. The value is C<$barcode>.
1135
1136 =item C<IsPermanent>
1137
1138 The book's home branch is a permanent collection. If you have borrowed
1139 this book, you are not allowed to return it. The value is the code for
1140 the book's home branch.
1141
1142 =item C<wthdrawn>
1143
1144 This book has been withdrawn/cancelled. The value should be ignored.
1145
1146 =item C<ResFound>
1147
1148 The item was reserved. The value is a reference-to-hash whose keys are
1149 fields from the reserves table of the Koha database, and
1150 C<biblioitemnumber>. It also has the key C<ResFound>, whose value is
1151 either C<Waiting>, C<Reserved>, or 0.
1152
1153 =back
1154
1155 C<$borrower> is a reference-to-hash, giving information about the
1156 patron who last borrowed the book.
1157
1158 =cut
1159
1160 sub AddReturn {
1161     my ( $barcode, $branch ) = @_;
1162     my $dbh      = C4::Context->dbh;
1163     my $messages;
1164     my $doreturn = 1;
1165     my $borrower;
1166     my $validTransfert = 0;
1167     my $reserveDone = 0;
1168     
1169     # get information on item
1170     my $iteminformation = GetItemIssue( GetItemnumberFromBarcode($barcode));
1171     unless ($iteminformation->{'itemnumber'} ) {
1172         $messages->{'BadBarcode'} = $barcode;
1173         $doreturn = 0;
1174     } else {
1175         # find the borrower
1176         if ( ( not $iteminformation->{borrowernumber} ) && $doreturn ) {
1177             $messages->{'NotIssued'} = $barcode;
1178             $doreturn = 0;
1179         }
1180     
1181         # check if the book is in a permanent collection....
1182         my $hbr      = $iteminformation->{'homebranch'};
1183         my $branches = GetBranches();
1184         if ( $hbr && $branches->{$hbr}->{'PE'} ) {
1185             $messages->{'IsPermanent'} = $hbr;
1186         }
1187     
1188         # check that the book has been cancelled
1189         if ( $iteminformation->{'wthdrawn'} ) {
1190             $messages->{'wthdrawn'} = 1;
1191             $doreturn = 0;
1192         }
1193     
1194     #     new op dev : if the book returned in an other branch update the holding branch
1195     
1196     # update issues, thereby returning book (should push this out into another subroutine
1197         $borrower = C4::Members::GetMemberDetails( $iteminformation->{borrowernumber}, 0 );
1198     
1199     # case of a return of document (deal with issues and holdingbranch)
1200     
1201         if ($doreturn) {
1202             my $sth =
1203             $dbh->prepare(
1204     "UPDATE issues SET returndate = now() WHERE (borrowernumber = ?) AND (itemnumber = ?) AND (returndate IS NULL)"
1205             );
1206             $sth->execute( $borrower->{'borrowernumber'},
1207                 $iteminformation->{'itemnumber'} );
1208             $messages->{'WasReturned'} = 1;    # FIXME is the "= 1" right?
1209         }
1210     
1211     # continue to deal with returns cases, but not only if we have an issue
1212     
1213     # the holdingbranch is updated if the document is returned in an other location .
1214     if ( $iteminformation->{'holdingbranch'} ne C4::Context->userenv->{'branch'} )
1215             {
1216                     UpdateHoldingbranch(C4::Context->userenv->{'branch'},$iteminformation->{'itemnumber'});     
1217     #           reload iteminformation holdingbranch with the userenv value
1218                     $iteminformation->{'holdingbranch'} = C4::Context->userenv->{'branch'};
1219             }
1220         ModDateLastSeen( $iteminformation->{'itemnumber'} );
1221         ($borrower) = C4::Members::GetMemberDetails( $iteminformation->{borrowernumber}, 0 );
1222         
1223         # fix up the accounts.....
1224         if ( $iteminformation->{'itemlost'} ) {
1225             $messages->{'WasLost'} = 1;
1226         }
1227     
1228     # # # # # # # # # # # # # # # # # # # # # # # # # # # # # # # # # # # # # # #
1229     #     check if we have a transfer for this document
1230         my ($datesent,$frombranch,$tobranch) = GetTransfers( $iteminformation->{'itemnumber'} );
1231     
1232     #     if we have a transfer to do, we update the line of transfers with the datearrived
1233         if ($datesent) {
1234             if ( $tobranch eq C4::Context->userenv->{'branch'} ) {
1235                     my $sth =
1236                     $dbh->prepare(
1237                             "UPDATE branchtransfers SET datearrived = now() WHERE itemnumber= ? AND datearrived IS NULL"
1238                     );
1239                     $sth->execute( $iteminformation->{'itemnumber'} );
1240                     $sth->finish;
1241     #         now we check if there is a reservation with the validate of transfer if we have one, we can         set it with the status 'W'
1242             ModReserveStatus( $iteminformation->{'itemnumber'},'W' );
1243             }
1244         else {
1245             $messages->{'WrongTransfer'} = $tobranch;
1246             $messages->{'WrongTransferItem'} = $iteminformation->{'itemnumber'};
1247         }
1248         $validTransfert = 1;
1249         }
1250     
1251     # # # # # # # # # # # # # # # # # # # # # # # # # # # # # # # # # # # # # # # # 
1252         # fix up the accounts.....
1253         if ($iteminformation->{'itemlost'}) {
1254                 FixAccountForLostAndReturned($iteminformation, $borrower);
1255                 $messages->{'WasLost'} = 1;
1256         }
1257         # fix up the overdues in accounts...
1258         FixOverduesOnReturn( $borrower->{'borrowernumber'},
1259             $iteminformation->{'itemnumber'} );
1260     
1261     # find reserves.....
1262     #     if we don't have a reserve with the status W, we launch the Checkreserves routine
1263         my ( $resfound, $resrec ) =
1264         C4::Reserves::CheckReserves( $iteminformation->{'itemnumber'} );
1265         if ($resfound) {
1266             $resrec->{'ResFound'}   = $resfound;
1267             $messages->{'ResFound'} = $resrec;
1268             $reserveDone = 1;
1269         }
1270     
1271         # update stats?
1272         # Record the fact that this book was returned.
1273         UpdateStats(
1274             $branch, 'return', '0', '',
1275             $iteminformation->{'itemnumber'},
1276             $iteminformation->{'itemtype'},
1277             $borrower->{'borrowernumber'}
1278         );
1279         
1280         &logaction(C4::Context->userenv->{'number'},"CIRCULATION","RETURN",$iteminformation->{borrowernumber},$iteminformation->{'biblionumber'}) 
1281             if C4::Context->preference("ReturnLog");
1282         
1283         #adding message if holdingbranch is non equal a userenv branch to return the document to homebranch
1284         #we check, if we don't have reserv or transfert for this document, if not, return it to homebranch .
1285         
1286         if ( ($iteminformation->{'holdingbranch'} ne $iteminformation->{'homebranch'}) and not $messages->{'WrongTransfer'} and ($validTransfert ne 1) and ($reserveDone ne 1) ){
1287                     if (C4::Context->preference("AutomaticItemReturn") == 1) {
1288                     ModItemTransfer($iteminformation->{'itemnumber'}, C4::Context->userenv->{'branch'}, $iteminformation->{'homebranch'});
1289                     $messages->{'WasTransfered'} = 1;
1290                     warn "was transfered";
1291                     }
1292         }
1293     }
1294     return ( $doreturn, $messages, $iteminformation, $borrower );
1295 }
1296
1297 =head2 FixOverduesOnReturn
1298
1299     &FixOverduesOnReturn($brn,$itm);
1300
1301 C<$brn> borrowernumber
1302
1303 C<$itm> itemnumber
1304
1305 internal function, called only by AddReturn
1306
1307 =cut
1308
1309 sub FixOverduesOnReturn {
1310     my ( $borrowernumber, $item ) = @_;
1311     my $dbh = C4::Context->dbh;
1312
1313     # check for overdue fine
1314     my $sth =
1315       $dbh->prepare(
1316 "SELECT * FROM accountlines WHERE (borrowernumber = ?) AND (itemnumber = ?) AND (accounttype='FU' OR accounttype='O')"
1317       );
1318     $sth->execute( $borrowernumber, $item );
1319
1320     # alter fine to show that the book has been returned
1321     if ( my $data = $sth->fetchrow_hashref ) {
1322         my $usth =
1323           $dbh->prepare(
1324 "UPDATE accountlines SET accounttype='F' WHERE (borrowernumber = ?) AND (itemnumber = ?) AND (accountno = ?)"
1325           );
1326         $usth->execute( $borrowernumber, $item, $data->{'accountno'} );
1327         $usth->finish();
1328     }
1329     $sth->finish();
1330     return;
1331 }
1332
1333 =head2 FixAccountForLostAndReturned
1334
1335         &FixAccountForLostAndReturned($iteminfo,$borrower);
1336
1337 Calculates the charge for a book lost and returned (Not exported & used only once)
1338
1339 C<$iteminfo> is a hashref to iteminfo. Only {itemnumber} is used.
1340
1341 C<$borrower> is a hashref to borrower. Only {borrowernumber is used.
1342
1343 Internal function, called by AddReturn
1344
1345 =cut
1346
1347 sub FixAccountForLostAndReturned {
1348         my ($iteminfo, $borrower) = @_;
1349         my %env;
1350         my $dbh = C4::Context->dbh;
1351         my $itm = $iteminfo->{'itemnumber'};
1352         # check for charge made for lost book
1353         my $sth = $dbh->prepare("SELECT * FROM accountlines WHERE (itemnumber = ?) AND (accounttype='L' OR accounttype='Rep') ORDER BY date DESC");
1354         $sth->execute($itm);
1355         if (my $data = $sth->fetchrow_hashref) {
1356         # writeoff this amount
1357                 my $offset;
1358                 my $amount = $data->{'amount'};
1359                 my $acctno = $data->{'accountno'};
1360                 my $amountleft;
1361                 if ($data->{'amountoutstanding'} == $amount) {
1362                 $offset = $data->{'amount'};
1363                 $amountleft = 0;
1364                 } else {
1365                 $offset = $amount - $data->{'amountoutstanding'};
1366                 $amountleft = $data->{'amountoutstanding'} - $amount;
1367                 }
1368                 my $usth = $dbh->prepare("UPDATE accountlines SET accounttype = 'LR',amountoutstanding='0'
1369                         WHERE (borrowernumber = ?)
1370                         AND (itemnumber = ?) AND (accountno = ?) ");
1371                 $usth->execute($data->{'borrowernumber'},$itm,$acctno);
1372                 $usth->finish;
1373         #check if any credit is left if so writeoff other accounts
1374                 my $nextaccntno = getnextacctno(\%env,$data->{'borrowernumber'},$dbh);
1375                 if ($amountleft < 0){
1376                 $amountleft*=-1;
1377                 }
1378                 if ($amountleft > 0){
1379                 my $msth = $dbh->prepare("SELECT * FROM accountlines WHERE (borrowernumber = ?)
1380                                                         AND (amountoutstanding >0) ORDER BY date");
1381                 $msth->execute($data->{'borrowernumber'});
1382         # offset transactions
1383                 my $newamtos;
1384                 my $accdata;
1385                 while (($accdata=$msth->fetchrow_hashref) and ($amountleft>0)){
1386                         if ($accdata->{'amountoutstanding'} < $amountleft) {
1387                         $newamtos = 0;
1388                         $amountleft -= $accdata->{'amountoutstanding'};
1389                         }  else {
1390                         $newamtos = $accdata->{'amountoutstanding'} - $amountleft;
1391                         $amountleft = 0;
1392                         }
1393                         my $thisacct = $accdata->{'accountno'};
1394                         my $usth = $dbh->prepare("UPDATE accountlines SET amountoutstanding= ?
1395                                         WHERE (borrowernumber = ?)
1396                                         AND (accountno=?)");
1397                         $usth->execute($newamtos,$data->{'borrowernumber'},'$thisacct');
1398                         $usth->finish;
1399                         $usth = $dbh->prepare("INSERT INTO accountoffsets
1400                                 (borrowernumber, accountno, offsetaccount,  offsetamount)
1401                                 VALUES
1402                                 (?,?,?,?)");
1403                         $usth->execute($data->{'borrowernumber'},$accdata->{'accountno'},$nextaccntno,$newamtos);
1404                         $usth->finish;
1405                 }
1406                 $msth->finish;
1407                 }
1408                 if ($amountleft > 0){
1409                         $amountleft*=-1;
1410                 }
1411                 my $desc="Book Returned ".$iteminfo->{'barcode'};
1412                 $usth = $dbh->prepare("INSERT INTO accountlines
1413                         (borrowernumber,accountno,date,amount,description,accounttype,amountoutstanding)
1414                         VALUES (?,?,now(),?,?,'CR',?)");
1415                 $usth->execute($data->{'borrowernumber'},$nextaccntno,0-$amount,$desc,$amountleft);
1416                 $usth->finish;
1417                 $usth = $dbh->prepare("INSERT INTO accountoffsets
1418                         (borrowernumber, accountno, offsetaccount,  offsetamount)
1419                         VALUES (?,?,?,?)");
1420                 $usth->execute($borrower->{'borrowernumber'},$data->{'accountno'},$nextaccntno,$offset);
1421                 $usth->finish;
1422                 $usth = $dbh->prepare("UPDATE items SET paidfor='' WHERE itemnumber=?");
1423                 $usth->execute($itm);
1424                 $usth->finish;
1425         }
1426         $sth->finish;
1427         return;
1428 }
1429
1430 =head2 GetItemIssue
1431
1432 $issues = &GetItemIssue($itemnumber);
1433
1434 Returns patrons currently having a book. nothing if item is not issued atm
1435
1436 C<$itemnumber> is the itemnumber
1437
1438 Returns an array of hashes
1439 =cut
1440
1441 sub GetItemIssue {
1442     my ( $itemnumber) = @_;
1443     return unless $itemnumber;
1444     my $dbh = C4::Context->dbh;
1445     my @GetItemIssues;
1446     
1447     # get today date
1448     my $today = POSIX::strftime("%Y%m%d", localtime);
1449
1450     my $sth = $dbh->prepare(
1451         "SELECT * FROM issues 
1452         LEFT JOIN items ON issues.itemnumber=items.itemnumber
1453     WHERE
1454     issues.itemnumber=?  AND returndate IS NULL ");
1455     $sth->execute($itemnumber);
1456     my $data = $sth->fetchrow_hashref;
1457     my $datedue = $data->{'date_due'};
1458     $datedue =~ s/-//g;
1459     if ( $datedue < $today ) {
1460         $data->{'overdue'} = 1;
1461     }
1462     $data->{'itemnumber'} = $itemnumber; # fill itemnumber, in case item is not on issue
1463     $sth->finish;
1464     return ($data);
1465 }
1466
1467 =head2 GetItemIssues
1468
1469 $issues = &GetItemIssues($itemnumber, $history);
1470
1471 Returns patrons that have issued a book
1472
1473 C<$itemnumber> is the itemnumber
1474 C<$history> is 0 if you want actuel "issuer" (if it exist) and 1 if you want issues history
1475
1476 Returns an array of hashes
1477 =cut
1478
1479 sub GetItemIssues {
1480     my ( $itemnumber,$history ) = @_;
1481     my $dbh = C4::Context->dbh;
1482     my @GetItemIssues;
1483     
1484     # get today date
1485     my $today = POSIX::strftime("%Y%m%d", localtime);
1486
1487     my $sth = $dbh->prepare(
1488         "SELECT * FROM issues 
1489     WHERE
1490     itemnumber=?".($history?"":" AND returndate IS NULL ").
1491     "ORDER BY issues.date_due DESC"
1492     );
1493     $sth->execute($itemnumber);
1494     while ( my $data = $sth->fetchrow_hashref ) {
1495         my $datedue = $data->{'date_due'};
1496         $datedue =~ s/-//g;
1497         if ( $datedue < $today ) {
1498             $data->{'overdue'} = 1;
1499         }
1500         my $itemnumber = $data->{'itemnumber'};
1501
1502         push @GetItemIssues, $data;
1503     }
1504     $sth->finish;
1505     return ( \@GetItemIssues );
1506 }
1507
1508 =head2 GetBiblioIssues
1509
1510 $issues = GetBiblioIssues($biblionumber);
1511
1512 this function get all issues from a biblionumber.
1513
1514 Return:
1515 C<$issues> is a reference to array which each value is ref-to-hash. This ref-to-hash containts all column from
1516 tables issues and the firstname,surname & cardnumber from borrowers.
1517
1518 =cut
1519
1520 sub GetBiblioIssues {
1521     my $biblionumber = shift;
1522     return undef unless $biblionumber;
1523     my $dbh   = C4::Context->dbh;
1524     my $query = "
1525         SELECT issues.*,biblio.biblionumber,biblio.title, biblio.author,borrowers.cardnumber,borrowers.surname,borrowers.firstname
1526         FROM issues
1527             LEFT JOIN borrowers ON borrowers.borrowernumber = issues.borrowernumber
1528             LEFT JOIN items ON issues.itemnumber = items.itemnumber
1529             LEFT JOIN biblioitems ON items.itemnumber = biblioitems.biblioitemnumber
1530             LEFT JOIN biblio ON biblio.biblionumber = items.biblioitemnumber
1531         WHERE biblio.biblionumber = ?
1532         ORDER BY issues.timestamp
1533     ";
1534     my $sth = $dbh->prepare($query);
1535     $sth->execute($biblionumber);
1536
1537     my @issues;
1538     while ( my $data = $sth->fetchrow_hashref ) {
1539         push @issues, $data;
1540     }
1541     return \@issues;
1542 }
1543
1544 =head2 CanBookBeRenewed
1545
1546 $ok = &CanBookBeRenewed($borrowernumber, $itemnumber);
1547
1548 Find out whether a borrowed item may be renewed.
1549
1550 C<$dbh> is a DBI handle to the Koha database.
1551
1552 C<$borrowernumber> is the borrower number of the patron who currently
1553 has the item on loan.
1554
1555 C<$itemnumber> is the number of the item to renew.
1556
1557 C<$CanBookBeRenewed> returns a true value iff the item may be renewed. The
1558 item must currently be on loan to the specified borrower; renewals
1559 must be allowed for the item's type; and the borrower must not have
1560 already renewed the loan.
1561
1562 =cut
1563
1564 sub CanBookBeRenewed {
1565
1566     # check renewal status
1567     my ( $borrowernumber, $itemnumber ) = @_;
1568     my $dbh       = C4::Context->dbh;
1569     my $renews    = 1;
1570     my $renewokay = 0;
1571
1572     # Look in the issues table for this item, lent to this borrower,
1573     # and not yet returned.
1574
1575     # FIXME - I think this function could be redone to use only one SQL call.
1576     my $sth1 = $dbh->prepare(
1577         "SELECT * FROM issues
1578             WHERE borrowernumber = ?
1579             AND itemnumber = ?
1580             AND returndate IS NULL"
1581     );
1582     $sth1->execute( $borrowernumber, $itemnumber );
1583     if ( my $data1 = $sth1->fetchrow_hashref ) {
1584
1585         # Found a matching item
1586
1587         # See if this item may be renewed. This query is convoluted
1588         # because it's a bit messy: given the item number, we need to find
1589         # the biblioitem, which gives us the itemtype, which tells us
1590         # whether it may be renewed.
1591         my $sth2 = $dbh->prepare(
1592             "SELECT renewalsallowed FROM items
1593                 LEFT JOIN biblioitems on items.biblioitemnumber = biblioitems.biblioitemnumber
1594                 LEFT JOIN itemtypes ON biblioitems.itemtype = itemtypes.itemtype
1595                 WHERE items.itemnumber = ?
1596                 "
1597         );
1598         $sth2->execute($itemnumber);
1599         if ( my $data2 = $sth2->fetchrow_hashref ) {
1600             $renews = $data2->{'renewalsallowed'};
1601         }
1602         if ( $renews && $renews >= $data1->{'renewals'} ) {
1603             $renewokay = 1;
1604         }
1605         $sth2->finish;
1606         my ( $resfound, $resrec ) = C4::Reserves::CheckReserves($itemnumber);
1607         if ($resfound) {
1608             $renewokay = 0;
1609         }
1610
1611     }
1612     $sth1->finish;
1613     return ($renewokay);
1614 }
1615
1616 =head2 AddRenewal
1617
1618 &AddRenewal($borrowernumber, $itemnumber, $datedue);
1619
1620 Renews a loan.
1621
1622 C<$borrowernumber> is the borrower number of the patron who currently
1623 has the item.
1624
1625 C<$itemnumber> is the number of the item to renew.
1626
1627 C<$datedue> can be used to set the due date. If C<$datedue> is the
1628 empty string, C<&AddRenewal> will calculate the due date automatically
1629 from the book's item type. If you wish to set the due date manually,
1630 C<$datedue> should be in the form YYYY-MM-DD.
1631
1632 =cut
1633
1634 sub AddRenewal {
1635
1636     my ( $borrowernumber, $itemnumber, $branch ,$datedue ) = @_;
1637     my $dbh = C4::Context->dbh;
1638
1639     # If the due date wasn't specified, calculate it by adding the
1640     # book's loan length to today's date.
1641     if ( $datedue eq "" ) {
1642
1643         my $biblio = GetBiblioFromItemNumber($itemnumber);
1644         my $borrower = GetMemberDetails( $borrowernumber, 0 );
1645         my $loanlength = GetLoanLength(
1646             $borrower->{'categorycode'},
1647             $biblio->{'itemtype'},
1648             $borrower->{'branchcode'}
1649         );
1650         my ( $due_year, $due_month, $due_day ) =
1651           Add_Delta_DHMS( Today_and_Now(), $loanlength, 0, 0, 0 );
1652         $datedue = "$due_year-$due_month-$due_day";
1653         $datedue=CheckValidDatedue($datedue,$itemnumber,$branch);
1654     }
1655
1656     # Find the issues record for this book
1657     my $sth =
1658       $dbh->prepare("SELECT * FROM issues
1659                         WHERE borrowernumber=? 
1660                         AND itemnumber=? 
1661                         AND returndate IS NULL"
1662       );
1663     $sth->execute( $borrowernumber, $itemnumber );
1664     my $issuedata = $sth->fetchrow_hashref;
1665     $sth->finish;
1666
1667     # Update the issues record to have the new due date, and a new count
1668     # of how many times it has been renewed.
1669     my $renews = $issuedata->{'renewals'} + 1;
1670     $sth = $dbh->prepare("UPDATE issues SET date_due = ?, renewals = ?
1671                             WHERE borrowernumber=? 
1672                             AND itemnumber=? 
1673                             AND returndate IS NULL"
1674     );
1675     $sth->execute( $datedue, $renews, $borrowernumber, $itemnumber );
1676     $sth->finish;
1677
1678     # Log the renewal
1679     UpdateStats( C4::Context->userenv->{'branchcode'}, 'renew', '', '', $itemnumber );
1680
1681     # Charge a new rental fee, if applicable?
1682     my ( $charge, $type ) = GetIssuingCharges( $itemnumber, $borrowernumber );
1683     if ( $charge > 0 ) {
1684         my $accountno = getnextacctno( $borrowernumber );
1685         my $item = GetBiblioFromItemNumber($itemnumber);
1686         $sth = $dbh->prepare(
1687                 "INSERT INTO accountlines
1688                     (borrowernumber,accountno,date,amount,
1689                         description,accounttype,amountoutstanding,
1690                     itemnumber)
1691                     VALUES (?,?,now(),?,?,?,?,?)"
1692         );
1693         $sth->execute( $borrowernumber, $accountno, $charge,
1694             "Renewal of Rental Item $item->{'title'} $item->{'barcode'}",
1695             'Rent', $charge, $itemnumber );
1696         $sth->finish;
1697     }
1698 }
1699
1700 =head2 GetIssuingCharges
1701
1702 ($charge, $item_type) = &GetIssuingCharges($itemnumber, $borrowernumber);
1703
1704 Calculate how much it would cost for a given patron to borrow a given
1705 item, including any applicable discounts.
1706
1707 C<$itemnumber> is the item number of item the patron wishes to borrow.
1708
1709 C<$borrowernumber> is the patron's borrower number.
1710
1711 C<&GetIssuingCharges> returns two values: C<$charge> is the rental charge,
1712 and C<$item_type> is the code for the item's item type (e.g., C<VID>
1713 if it's a video).
1714
1715 =cut
1716
1717 sub GetIssuingCharges {
1718
1719     # calculate charges due
1720     my ( $itemnumber, $borrowernumber ) = @_;
1721     my $charge = 0;
1722     my $dbh    = C4::Context->dbh;
1723     my $item_type;
1724
1725     # Get the book's item type and rental charge (via its biblioitem).
1726     my $sth1 = $dbh->prepare(
1727         "SELECT itemtypes.itemtype,rentalcharge FROM items
1728             LEFT JOIN biblioitems ON biblioitems.biblioitemnumber = items.biblioitemnumber
1729             LEFT JOIN itemtypes ON biblioitems.itemtype = itemtypes.itemtype
1730             WHERE items.itemnumber =?
1731         "
1732     );
1733     $sth1->execute($itemnumber);
1734     if ( my $data1 = $sth1->fetchrow_hashref ) {
1735         $item_type = $data1->{'itemtype'};
1736         $charge    = $data1->{'rentalcharge'};
1737         my $q2 = "SELECT rentaldiscount FROM borrowers
1738             LEFT JOIN issuingrules ON borrowers.categorycode = issuingrules.categorycode
1739             WHERE borrowers.borrowernumber = ?
1740             AND issuingrules.itemtype = ?";
1741         my $sth2 = $dbh->prepare($q2);
1742         $sth2->execute( $borrowernumber, $item_type );
1743         if ( my $data2 = $sth2->fetchrow_hashref ) {
1744             my $discount = $data2->{'rentaldiscount'};
1745             if ( $discount eq 'NULL' ) {
1746                 $discount = 0;
1747             }
1748             $charge = ( $charge * ( 100 - $discount ) ) / 100;
1749         }
1750         $sth2->finish;
1751     }
1752
1753     $sth1->finish;
1754     return ( $charge, $item_type );
1755 }
1756
1757 =head2 AddIssuingCharge
1758
1759 &AddIssuingCharge( $itemno, $borrowernumber, $charge )
1760
1761 =cut
1762
1763 sub AddIssuingCharge {
1764     my ( $itemnumber, $borrowernumber, $charge ) = @_;
1765     my $dbh = C4::Context->dbh;
1766     my $nextaccntno = getnextacctno( $borrowernumber );
1767     my $query ="
1768         INSERT INTO accountlines
1769             (borrowernumber, itemnumber, accountno,
1770             date, amount, description, accounttype,
1771             amountoutstanding)
1772         VALUES (?, ?, ?,now(), ?, 'Rental', 'Rent',?)
1773     ";
1774     my $sth = $dbh->prepare($query);
1775     $sth->execute( $borrowernumber, $itemnumber, $nextaccntno, $charge, $charge );
1776     $sth->finish;
1777 }
1778
1779 =head2 GetTransfers
1780
1781 GetTransfers($itemnumber);
1782
1783 =cut
1784
1785 sub GetTransfers {
1786     my ($itemnumber) = @_;
1787
1788     my $dbh = C4::Context->dbh;
1789
1790     my $query = '
1791         SELECT datesent,
1792                frombranch,
1793                tobranch
1794         FROM branchtransfers
1795         WHERE itemnumber = ?
1796           AND datearrived IS NULL
1797         ';
1798     my $sth = $dbh->prepare($query);
1799     $sth->execute($itemnumber);
1800     my @row = $sth->fetchrow_array();
1801     $sth->finish;
1802     return @row;
1803 }
1804
1805
1806 =head2 GetTransfersFromTo
1807
1808 @results = GetTransfersFromTo($frombranch,$tobranch);
1809
1810 Returns the list of pending transfers between $from and $to branch
1811
1812 =cut
1813
1814 sub GetTransfersFromTo {
1815     my ( $frombranch, $tobranch ) = @_;
1816     return unless ( $frombranch && $tobranch );
1817     my $dbh   = C4::Context->dbh;
1818     my $query = "
1819         SELECT itemnumber,datesent,frombranch
1820         FROM   branchtransfers
1821         WHERE  frombranch=?
1822           AND  tobranch=?
1823           AND datearrived IS NULL
1824     ";
1825     my $sth = $dbh->prepare($query);
1826     $sth->execute( $frombranch, $tobranch );
1827     my @gettransfers;
1828
1829     while ( my $data = $sth->fetchrow_hashref ) {
1830         push @gettransfers, $data;
1831     }
1832     $sth->finish;
1833     return (@gettransfers);
1834 }
1835
1836 =head2 DeleteTransfer
1837
1838 &DeleteTransfer($itemnumber);
1839
1840 =cut
1841
1842 sub DeleteTransfer {
1843     my ($itemnumber) = @_;
1844     my $dbh          = C4::Context->dbh;
1845     my $sth          = $dbh->prepare(
1846         "DELETE FROM branchtransfers
1847          WHERE itemnumber=?
1848          AND datearrived IS NULL "
1849     );
1850     $sth->execute($itemnumber);
1851     $sth->finish;
1852 }
1853
1854 =head2 AnonymiseIssueHistory
1855
1856 $rows = AnonymiseIssueHistory($borrowernumber,$date)
1857
1858 This function write NULL instead of C<$borrowernumber> given on input arg into the table issues.
1859 if C<$borrowernumber> is not set, it will delete the issue history for all borrower older than C<$date>.
1860
1861 return the number of affected rows.
1862
1863 =cut
1864
1865 sub AnonymiseIssueHistory {
1866     my $date           = shift;
1867     my $borrowernumber = shift;
1868     my $dbh            = C4::Context->dbh;
1869     my $query          = "
1870         UPDATE issues
1871         SET    borrowernumber = NULL
1872         WHERE  returndate < '".$date."'
1873           AND borrowernumber IS NOT NULL
1874     ";
1875     $query .= " AND borrowernumber = '".$borrowernumber."'" if defined $borrowernumber;
1876     my $rows_affected = $dbh->do($query);
1877     return $rows_affected;
1878 }
1879
1880 =head2 updateWrongTransfer
1881
1882 $items = updateWrongTransfer($itemNumber,$borrowernumber,$waitingAtLibrary,$FromLibrary);
1883
1884 This function validate the line of brachtransfer but with the wrong destination (mistake from a librarian ...), and create a new line in branchtransfer from the actual library to the original library of reservation 
1885
1886 =cut
1887
1888 sub updateWrongTransfer {
1889         my ( $itemNumber,$waitingAtLibrary,$FromLibrary ) = @_;
1890         my $dbh = C4::Context->dbh;     
1891 # first step validate the actual line of transfert .
1892         my $sth =
1893                 $dbh->prepare(
1894                         "update branchtransfers set datearrived = now(),tobranch=?,comments='wrongtransfer' where itemnumber= ? AND datearrived IS NULL"
1895                 );
1896                 $sth->execute($FromLibrary,$itemNumber);
1897                 $sth->finish;
1898
1899 # second step create a new line of branchtransfer to the right location .
1900         ModItemTransfer($itemNumber, $FromLibrary, $waitingAtLibrary);
1901
1902 #third step changing holdingbranch of item
1903         UpdateHoldingbranch($FromLibrary,$itemNumber);
1904 }
1905
1906 =head2 UpdateHoldingbranch
1907
1908 $items = UpdateHoldingbranch($branch,$itmenumber);
1909 Simple methode for updating hodlingbranch in items BDD line
1910 =cut
1911
1912 sub UpdateHoldingbranch {
1913         my ( $branch,$itmenumber ) = @_;
1914         my $dbh = C4::Context->dbh;     
1915 # first step validate the actual line of transfert .
1916         my $sth =
1917                 $dbh->prepare(
1918                         "update items set holdingbranch = ? where itemnumber= ?"
1919                 );
1920                 $sth->execute($branch,$itmenumber);
1921                 $sth->finish;
1922         
1923         
1924 }
1925 =head2 CheckValidDatedue
1926
1927 $newdatedue = CheckValidDatedue($date_due,$itemnumber,$branchcode);
1928 this function return a new date due after checked if it's a repeatable or special holiday
1929 C<$date_due>   = returndate calculate with no day check
1930 C<$itemnumber>  = itemnumber
1931 C<$branchcode>  = localisation of issue 
1932 =cut
1933 sub CheckValidDatedue{
1934 my ($date_due,$itemnumber,$branchcode)=@_;
1935 my @datedue=split('-',$date_due);
1936 my $years=$datedue[0];
1937 my $month=$datedue[1];
1938 my $day=$datedue[2];
1939 my $dow;
1940 for (my $i=0;$i<2;$i++){
1941         $dow=Day_of_Week($years,$month,$day);
1942         ($dow=0) if ($dow>6);
1943         my $result=CheckRepeatableHolidays($itemnumber,$dow,$branchcode);
1944         my $countspecial=CheckSpecialHolidays($years,$month,$day,$itemnumber,$branchcode);
1945         my $countspecialrepeatable=CheckRepeatableSpecialHolidays($month,$day,$itemnumber,$branchcode);
1946                 if (($result ne '0') or ($countspecial ne '0') or ($countspecialrepeatable ne '0') ){
1947                 $i=0;
1948                 (($years,$month,$day) = Add_Delta_Days($years,$month,$day, 1))if ($i ne '1');
1949                 }
1950         }
1951 my $newdatedue=$years."-".$month."-".$day;
1952 return $newdatedue;
1953 }
1954 =head2 CheckRepeatableHolidays
1955
1956 $countrepeatable = CheckRepeatableHoliday($itemnumber,$week_day,$branchcode);
1957 this function check if the date due is a repeatable holiday
1958 C<$date_due>   = returndate calculate with no day check
1959 C<$itemnumber>  = itemnumber
1960 C<$branchcode>  = localisation of issue 
1961
1962 =cut
1963
1964 sub CheckRepeatableHolidays{
1965 my($itemnumber,$week_day,$branchcode)=@_;
1966 my $dbh = C4::Context->dbh;
1967 my $query = qq|SELECT count(*)  
1968         FROM repeatable_holidays 
1969         WHERE branchcode=?
1970         AND weekday=?|;
1971 my $sth = $dbh->prepare($query);
1972 $sth->execute($branchcode,$week_day);
1973 my $result=$sth->fetchrow;
1974 $sth->finish;
1975 return $result;
1976 }
1977
1978
1979 =head2 CheckSpecialHolidays
1980
1981 $countspecial = CheckSpecialHolidays($years,$month,$day,$itemnumber,$branchcode);
1982 this function check if the date is a special holiday
1983 C<$years>   = the years of datedue
1984 C<$month>   = the month of datedue
1985 C<$day>     = the day of datedue
1986 C<$itemnumber>  = itemnumber
1987 C<$branchcode>  = localisation of issue 
1988 =cut
1989 sub CheckSpecialHolidays{
1990 my ($years,$month,$day,$itemnumber,$branchcode) = @_;
1991 my $dbh = C4::Context->dbh;
1992 my $query=qq|SELECT count(*) 
1993              FROM `special_holidays`
1994              WHERE year=?
1995              AND month=?
1996              AND day=?
1997              AND branchcode=?
1998             |;
1999 my $sth = $dbh->prepare($query);
2000 $sth->execute($years,$month,$day,$branchcode);
2001 my $countspecial=$sth->fetchrow ;
2002 $sth->finish;
2003 return $countspecial;
2004 }
2005
2006 =head2 CheckRepeatableSpecialHolidays
2007
2008 $countspecial = CheckRepeatableSpecialHolidays($month,$day,$itemnumber,$branchcode);
2009 this function check if the date is a repeatble special holidays
2010 C<$month>   = the month of datedue
2011 C<$day>     = the day of datedue
2012 C<$itemnumber>  = itemnumber
2013 C<$branchcode>  = localisation of issue 
2014 =cut
2015 sub CheckRepeatableSpecialHolidays{
2016 my ($month,$day,$itemnumber,$branchcode) = @_;
2017 my $dbh = C4::Context->dbh;
2018 my $query=qq|SELECT count(*) 
2019              FROM `repeatable_holidays`
2020              WHERE month=?
2021              AND day=?
2022              AND branchcode=?
2023             |;
2024 my $sth = $dbh->prepare($query);
2025 $sth->execute($month,$day,$branchcode);
2026 my $countspecial=$sth->fetchrow ;
2027 $sth->finish;
2028 return $countspecial;
2029 }
2030
2031
2032
2033 sub CheckValidBarcode{
2034 my ($barcode) = @_;
2035 my $dbh = C4::Context->dbh;
2036 my $query=qq|SELECT count(*) 
2037              FROM items 
2038              WHERE barcode=?
2039             |;
2040 my $sth = $dbh->prepare($query);
2041 $sth->execute($barcode);
2042 my $exist=$sth->fetchrow ;
2043 $sth->finish;
2044 return $exist;
2045 }
2046
2047 1;
2048
2049 __END__
2050
2051 =head1 AUTHOR
2052
2053 Koha Developement team <info@koha.org>
2054
2055 =cut
2056