help.pl - bugfix module usage (HTML::Template::Pro)
[koha.git] / C4 / Acquisition.pm
1 package C4::Acquisition;
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
21 use strict;
22 use C4::Context;
23 use C4::Dates qw(format_date);
24 use MARC::Record;
25 use C4::Suggestions;
26 use Time::localtime;
27
28 use vars qw($VERSION @ISA @EXPORT);
29
30 BEGIN {
31         # set the version for version checking
32         $VERSION = 3.01;
33         require Exporter;
34         @ISA    = qw(Exporter);
35         @EXPORT = qw(
36                 &GetBasket &NewBasket &CloseBasket
37                 &GetPendingOrders &GetOrder &GetOrders
38                 &GetOrderNumber &GetLateOrders &NewOrder &DelOrder
39                 &SearchOrder &GetHistory &GetRecentAcqui
40                 &ModOrder &ModReceiveOrder &ModOrderBiblioNumber
41                 &GetParcels &GetParcel
42         );
43 }
44
45 # used in receiveorder subroutine
46 # to provide library specific handling
47 my $library_name = C4::Context->preference("LibraryName");
48
49 =head1 NAME
50
51 C4::Acquisition - Koha functions for dealing with orders and acquisitions
52
53 =head1 SYNOPSIS
54
55 use C4::Acquisition;
56
57 =head1 DESCRIPTION
58
59 The functions in this module deal with acquisitions, managing book
60 orders, basket and parcels.
61
62 =head1 FUNCTIONS
63
64 =over 2
65
66 =head2 FUNCTIONS ABOUT BASKETS
67
68 =over 2
69
70 =head3 GetBasket
71
72 =over 4
73
74 $aqbasket = &GetBasket($basketnumber);
75
76 get all basket informations in aqbasket for a given basket
77
78 return :
79 informations for a given basket returned as a hashref.
80
81 =back
82
83 =back
84
85 =cut
86
87 sub GetBasket {
88     my ($basketno) = @_;
89     my $dbh        = C4::Context->dbh;
90     my $query = "
91         SELECT  aqbasket.*,
92                 concat( b.firstname,' ',b.surname) AS authorisedbyname,
93                 b.branchcode AS branch
94         FROM    aqbasket
95         LEFT JOIN borrowers b ON aqbasket.authorisedby=b.borrowernumber
96         WHERE basketno=?
97     ";
98     my $sth=$dbh->prepare($query);
99     $sth->execute($basketno);
100     my $basket = $sth->fetchrow_hashref;
101         return ( $basket );
102 }
103
104 #------------------------------------------------------------#
105
106 =head3 NewBasket
107
108 =over 4
109
110 $basket = &NewBasket();
111
112 Create a new basket in aqbasket table
113
114 =back
115
116 =cut
117
118 # FIXME : this function seems to be unused.
119
120 sub NewBasket {
121     my ( $booksellerid, $authorisedby ) = @_;
122     my $dbh = C4::Context->dbh;
123     my $query = "
124         INSERT INTO aqbasket
125                 (creationdate,booksellerid,authorisedby)
126         VALUES  (now(),'$booksellerid','$authorisedby')
127     ";
128     my $sth =
129       $dbh->do($query);
130
131 #find & return basketno MYSQL dependant, but $dbh->last_insert_id always returns null :-(
132     my $basket = $dbh->{'mysql_insertid'};
133     return $basket;
134 }
135
136 #------------------------------------------------------------#
137
138 =head3 CloseBasket
139
140 =over 4
141
142 &CloseBasket($basketno);
143
144 close a basket (becomes unmodifiable,except for recieves)
145
146 =back
147
148 =cut
149
150 sub CloseBasket {
151     my ($basketno) = @_;
152     my $dbh        = C4::Context->dbh;
153     my $query = "
154         UPDATE aqbasket
155         SET    closedate=now()
156         WHERE  basketno=?
157     ";
158     my $sth = $dbh->prepare($query);
159     $sth->execute($basketno);
160 }
161
162 #------------------------------------------------------------#
163
164 =back
165
166 =head2 FUNCTIONS ABOUT ORDERS
167
168 =over 2
169
170 =cut
171
172 #------------------------------------------------------------#
173
174 =head3 GetPendingOrders
175
176 =over 4
177
178 $orders = &GetPendingOrders($booksellerid, $grouped);
179
180 Finds pending orders from the bookseller with the given ID. Ignores
181 completed and cancelled orders.
182
183 C<$orders> is a reference-to-array; each element is a
184 reference-to-hash with the following fields:
185 C<$grouped> is a boolean that, if set to 1 will group all order lines of the same basket
186 in a single result line 
187
188 =over 2
189
190 =item C<authorizedby>
191
192 =item C<entrydate>
193
194 =item C<basketno>
195
196 These give the value of the corresponding field in the aqorders table
197 of the Koha database.
198
199 =back
200
201 =back
202
203 Results are ordered from most to least recent.
204
205 =cut
206
207 sub GetPendingOrders {
208     my ($supplierid,$grouped) = @_;
209     my $dbh = C4::Context->dbh;
210     my $strsth = "
211         SELECT    ".($grouped?"count(*),":"")."aqbasket.basketno,
212                     surname,firstname,aqorders.*,
213                     aqbasket.closedate, aqbasket.creationdate
214         FROM      aqorders
215         LEFT JOIN aqbasket ON aqbasket.basketno=aqorders.basketno
216         LEFT JOIN borrowers ON aqbasket.authorisedby=borrowers.borrowernumber
217         WHERE booksellerid=?
218             AND (quantity > quantityreceived OR quantityreceived is NULL)
219             AND datecancellationprinted IS NULL
220             AND (to_days(now())-to_days(closedate) < 180 OR closedate IS NULL)
221     ";
222     ## FIXME  Why 180 days ???
223     if ( C4::Context->preference("IndependantBranches") ) {
224         my $userenv = C4::Context->userenv;
225         if ( ($userenv) && ( $userenv->{flags} != 1 ) ) {
226             $strsth .=
227                 " and (borrowers.branchcode = '"
228               . $userenv->{branch}
229               . "' or borrowers.branchcode ='')";
230         }
231     }
232     $strsth .= " group by aqbasket.basketno" if $grouped;
233     $strsth .= " order by aqbasket.basketno";
234
235     my $sth = $dbh->prepare($strsth);
236     $sth->execute($supplierid);
237     my $results = $sth->fetchall_arrayref({});
238     $sth->finish;
239     return $results;
240 }
241
242 #------------------------------------------------------------#
243
244 =head3 GetOrders
245
246 =over 4
247
248 @orders = &GetOrders($basketnumber, $orderby);
249
250 Looks up the pending (non-cancelled) orders with the given basket
251 number. If C<$booksellerID> is non-empty, only orders from that seller
252 are returned.
253
254 return :
255 C<&basket> returns a two-element array. C<@orders> is an array of
256 references-to-hash, whose keys are the fields from the aqorders,
257 biblio, and biblioitems tables in the Koha database.
258
259 =back
260
261 =cut
262
263 sub GetOrders {
264     my ( $basketno, $orderby ) = @_;
265     my $dbh   = C4::Context->dbh;
266     my $query  ="
267          SELECT  aqorderbreakdown.*,
268                 biblio.*,biblioitems.publishercode,
269                 aqorders.*,
270                 aqbookfund.bookfundname,
271                 biblio.title
272         FROM    aqorders
273             LEFT JOIN aqorderbreakdown ON aqorders.ordernumber=aqorderbreakdown.ordernumber
274             LEFT JOIN aqbookfund       ON aqbookfund.bookfundid=aqorderbreakdown.bookfundid
275             LEFT JOIN biblio           ON biblio.biblionumber=aqorders.biblionumber
276             LEFT JOIN biblioitems      ON biblioitems.biblionumber=biblio.biblionumber
277         WHERE   basketno=?
278             AND (datecancellationprinted IS NULL OR datecancellationprinted='0000-00-00')
279     ";
280
281     $orderby = "biblioitems.publishercode,biblio.title" unless $orderby;
282     $query .= " ORDER BY $orderby";
283     my $sth = $dbh->prepare($query);
284     $sth->execute($basketno);
285     my @results;
286
287     while ( my $data = $sth->fetchrow_hashref ) {
288         push @results, $data;
289     }
290     $sth->finish;
291     return @results;
292 }
293
294 #------------------------------------------------------------#
295
296 =head3 GetOrderNumber
297
298 =over 4
299
300 $ordernumber = &GetOrderNumber($biblioitemnumber, $biblionumber);
301
302 Looks up the ordernumber with the given biblionumber and biblioitemnumber.
303
304 Returns the number of this order.
305
306 =item C<$ordernumber> is the order number.
307
308 =back
309
310 =cut
311 sub GetOrderNumber {
312     my ( $biblionumber,$biblioitemnumber ) = @_;
313     my $dbh = C4::Context->dbh;
314     my $query = "
315         SELECT ordernumber
316         FROM   aqorders
317         WHERE  biblionumber=?
318         AND    biblioitemnumber=?
319     ";
320     my $sth = $dbh->prepare($query);
321     $sth->execute( $biblionumber, $biblioitemnumber );
322
323     return $sth->fetchrow;
324 }
325
326 #------------------------------------------------------------#
327
328 =head3 GetOrder
329
330 =over 4
331
332 $order = &GetOrder($ordernumber);
333
334 Looks up an order by order number.
335
336 Returns a reference-to-hash describing the order. The keys of
337 C<$order> are fields from the biblio, biblioitems, aqorders, and
338 aqorderbreakdown tables of the Koha database.
339
340 =back
341
342 =cut
343
344 sub GetOrder {
345     my ($ordnum) = @_;
346     my $dbh      = C4::Context->dbh;
347     my $query = "
348         SELECT *
349         FROM   aqorders
350         LEFT JOIN aqorderbreakdown ON aqorders.ordernumber=aqorderbreakdown.ordernumber
351         LEFT JOIN biblio on           biblio.biblionumber=aqorders.biblionumber
352         LEFT JOIN biblioitems on       biblioitems.biblionumber=aqorders.biblionumber
353         WHERE aqorders.ordernumber=?
354
355     ";
356     my $sth= $dbh->prepare($query);
357     $sth->execute($ordnum);
358     my $data = $sth->fetchrow_hashref;
359     $sth->finish;
360     return $data;
361 }
362
363 #------------------------------------------------------------#
364
365 =head3 NewOrder
366
367 =over 4
368
369   &NewOrder($basket, $biblionumber, $title, $quantity, $listprice,
370     $booksellerid, $who, $notes, $bookfund, $biblioitemnumber, $rrp,
371     $ecost, $gst, $budget, $unitprice, $subscription,
372     $booksellerinvoicenumber, $purchaseorder);
373
374 Adds a new order to the database. Any argument that isn't described
375 below is the new value of the field with the same name in the aqorders
376 table of the Koha database.
377
378 C<$ordnum> is a "minimum order number." After adding the new entry to
379 the aqorders table, C<&neworder> finds the first entry in aqorders
380 with order number greater than or equal to C<$ordnum>, and adds an
381 entry to the aqorderbreakdown table, with the order number just found,
382 and the book fund ID of the newly-added order.
383
384 C<$budget> is effectively ignored.
385
386 C<$subscription> may be either "yes", or anything else for "no".
387
388 =back
389
390 =cut
391
392 sub NewOrder {
393    my (
394         $basketno,  $bibnum,       $title,        $quantity,
395         $listprice, $booksellerid, $authorisedby, $notes,
396         $bookfund,  $bibitemnum,   $rrp,          $ecost,
397         $gst,       $budget,       $cost,         $sub,
398         $invoice,   $sort1,        $sort2,        $purchaseorder
399       )
400       = @_;
401
402     my $year  = localtime->year() + 1900;
403     my $month = localtime->mon() + 1;       # months starts at 0, add 1
404
405     if ( !$budget || $budget eq 'now' ) {
406         $budget = "now()";
407     }
408
409     # if month is july or more, budget start is 1 jul, next year.
410     elsif ( $month >= '7' ) {
411         ++$year;                            # add 1 to year , coz its next year
412         $budget = "'$year-07-01'";
413     }
414     else {
415
416         # START OF NEW BUDGET, 1ST OF JULY, THIS YEAR
417         $budget = "'$year-07-01'";
418     }
419
420     if ( $sub eq 'yes' ) {
421         $sub = 1;
422     }
423     else {
424         $sub = 0;
425     }
426
427     # if $basket empty, it's also a new basket, create it
428     unless ($basketno) {
429         $basketno = NewBasket( $booksellerid, $authorisedby );
430     }
431
432     my $dbh = C4::Context->dbh;
433     my $query = "
434         INSERT INTO aqorders
435            ( biblionumber,title,basketno,quantity,listprice,notes,
436            biblioitemnumber,rrp,ecost,gst,unitprice,subscription,sort1,sort2,budgetdate,entrydate,purchaseordernumber)
437         VALUES (?,?,?,?,?,?,?,?,?,?,?,?,?,?,$budget,now(),? )
438     ";
439     my $sth = $dbh->prepare($query);
440
441     $sth->execute(
442         $bibnum, $title,      $basketno, $quantity, $listprice,
443         $notes,  $bibitemnum, $rrp,      $ecost,    $gst,
444         $cost,   $sub,        $sort1,    $sort2,        $purchaseorder
445     );
446     $sth->finish;
447
448     #get ordnum MYSQL dependant, but $dbh->last_insert_id returns null
449     my $ordnum = $dbh->{'mysql_insertid'};
450     $query = "
451         INSERT INTO aqorderbreakdown (ordernumber,bookfundid)
452         VALUES (?,?)
453     ";
454     $sth = $dbh->prepare($query);
455     $sth->execute( $ordnum, $bookfund );
456     $sth->finish;
457     return ( $basketno, $ordnum );
458 }
459
460 #------------------------------------------------------------#
461
462 =head3 ModOrder
463
464 =over 4
465
466 &ModOrder($title, $ordernumber, $quantity, $listprice,
467     $biblionumber, $basketno, $supplier, $who, $notes,
468     $bookfundid, $bibitemnum, $rrp, $ecost, $gst, $budget,
469     $unitprice, $booksellerinvoicenumber);
470
471 Modifies an existing order. Updates the order with order number
472 C<$ordernumber> and biblionumber C<$biblionumber>. All other arguments
473 update the fields with the same name in the aqorders table of the Koha
474 database.
475
476 Entries with order number C<$ordernumber> in the aqorderbreakdown
477 table are also updated to the new book fund ID.
478
479 =back
480
481 =cut
482
483 sub ModOrder {
484     my (
485         $title,      $ordnum,   $quantity, $listprice, $bibnum,
486         $basketno,   $supplier, $who,      $notes,     $bookfund,
487         $bibitemnum, $rrp,      $ecost,    $gst,       $budget,
488         $cost,       $invoice,  $sort1,    $sort2,     $purchaseorder
489       )
490       = @_;
491     my $dbh = C4::Context->dbh;
492     my $query = "
493         UPDATE aqorders
494         SET    title=?,
495                quantity=?,listprice=?,basketno=?,
496                rrp=?,ecost=?,unitprice=?,booksellerinvoicenumber=?,
497                notes=?,sort1=?, sort2=?, purchaseordernumber=?
498         WHERE  ordernumber=? AND biblionumber=?
499     ";
500     my $sth = $dbh->prepare($query);
501     $sth->execute(
502         $title, $quantity, $listprice, $basketno, $rrp,
503         $ecost, $cost,     $invoice,   $notes,    $sort1,
504         $sort2, $purchaseorder,
505                 $ordnum,   $bibnum
506     );
507     $sth->finish;
508     $query = "
509         UPDATE aqorderbreakdown
510         SET    bookfundid=?
511         WHERE  ordernumber=?
512     ";
513     $sth = $dbh->prepare($query);
514
515     unless ( $sth->execute( $bookfund, $ordnum ) )
516     {    # zero rows affected [Bug 734]
517         my $query ="
518             INSERT INTO aqorderbreakdown
519                      (ordernumber,bookfundid)
520             VALUES   (?,?)
521         ";
522         $sth = $dbh->prepare($query);
523         $sth->execute( $ordnum, $bookfund );
524     }
525     $sth->finish;
526 }
527
528 #------------------------------------------------------------#
529
530 =head3 ModOrderBiblioNumber
531
532 =over 4
533
534 &ModOrderBiblioNumber($biblioitemnumber,$ordnum, $biblionumber);
535
536 Modifies the biblioitemnumber for an existing order.
537 Updates the order with order number C<$ordernum> and biblionumber C<$biblionumber>.
538
539 =back
540
541 =cut
542
543 sub ModOrderBiblioNumber {
544     my ($biblioitemnumber,$ordnum, $biblionumber) = @_;
545     my $dbh = C4::Context->dbh;
546     my $query = "
547       UPDATE aqorders
548       SET    biblioitemnumber = ?
549       WHERE  ordernumber = ?
550       AND biblionumber =  ?";
551     my $sth = $dbh->prepare($query);
552     $sth->execute( $biblioitemnumber, $ordnum, $biblionumber );
553 }
554
555 #------------------------------------------------------------#
556
557 =head3 ModReceiveOrder
558
559 =over 4
560
561 &ModReceiveOrder($biblionumber, $ordernumber, $quantityreceived, $user,
562     $unitprice, $booksellerinvoicenumber, $biblioitemnumber,
563     $freight, $bookfund, $rrp);
564
565 Updates an order, to reflect the fact that it was received, at least
566 in part. All arguments not mentioned below update the fields with the
567 same name in the aqorders table of the Koha database.
568
569 If a partial order is received, splits the order into two.  The received
570 portion must have a booksellerinvoicenumber.  
571
572 Updates the order with bibilionumber C<$biblionumber> and ordernumber
573 C<$ordernumber>.
574
575 Also updates the book fund ID in the aqorderbreakdown table.
576
577 =back
578
579 =cut
580
581
582 sub ModReceiveOrder {
583     my (
584         $biblionumber,    $ordnum,  $quantrec, $user, $cost,
585         $invoiceno, $freight, $rrp, $bookfund, $datereceived
586       )
587       = @_;
588     my $dbh = C4::Context->dbh;
589 #     warn "DATE BEFORE : $daterecieved";
590 #    $daterecieved=POSIX::strftime("%Y-%m-%d",CORE::localtime) unless $daterecieved;
591 #     warn "DATE REC : $daterecieved";
592         $datereceived = C4::Dates->output('iso') unless $datereceived;
593     my $suggestionid = GetSuggestionFromBiblionumber( $dbh, $biblionumber );
594     if ($suggestionid) {
595         ModStatus( $suggestionid, 'AVAILABLE', '', $biblionumber );
596     }
597     # Allows libraries to change their bookfund during receiving orders
598     # allows them to adjust budgets
599     if ( C4::Context->preference("LooseBudgets") && $bookfund ) {
600         my $query = "
601             UPDATE aqorderbreakdown
602             SET    bookfundid=?
603             WHERE  ordernumber=?
604         ";
605         my $sth = $dbh->prepare($query);
606         $sth->execute( $bookfund, $ordnum );
607         $sth->finish;
608     }
609    
610         my $sth=$dbh->prepare("SELECT * FROM aqorders  LEFT JOIN aqorderbreakdown ON aqorders.ordernumber=aqorderbreakdown.ordernumber
611                                                         WHERE biblionumber=? AND aqorders.ordernumber=?");
612     $sth->execute($biblionumber,$ordnum);
613     my $order = $sth->fetchrow_hashref();
614     $sth->finish();
615         
616         if ( $order->{quantity} > $quantrec ) {
617         $sth=$dbh->prepare("update aqorders 
618                                                         set quantityreceived=?,datereceived=?,booksellerinvoicenumber=?, 
619                                                                 unitprice=?,freight=?,rrp=?,quantity=?
620                             where biblionumber=? and ordernumber=?");
621         $sth->execute($quantrec,$datereceived,$invoiceno,$cost,$freight,$rrp,$quantrec,$biblionumber,$ordnum);
622         $sth->finish;
623         # create a new order for the remaining items, and set its bookfund.
624         my $newOrder = NewOrder($order->{'basketno'},$order->{'biblionumber'},$order->{'title'}, $order->{'quantity'} - $quantrec,    
625                     $order->{'listprice'},$order->{'booksellerid'},$order->{'authorisedby'},$order->{'notes'},   
626                     $order->{'bookfundid'},$order->{'biblioitemnumber'},$order->{'rrp'},$order->{'ecost'},$order->{'gst'},
627                     $order->{'budget'},$order->{'unitcost'},$order->{'sub'},'',$order->{'sort1'},$order->{'sort2'},$order->{'purchaseordernumber'});
628     
629         $sth=$dbh->prepare(" insert into aqorderbreakdown (ordernumber, branchcode, bookfundid) values (?,?,?)"); 
630         $sth->execute($newOrder,$order->{branch},$order->{bookfundid});
631     } else {
632         $sth=$dbh->prepare("update aqorders 
633                                                         set quantityreceived=?,datereceived=?,booksellerinvoicenumber=?, 
634                                                                 unitprice=?,freight=?,rrp=?
635                             where biblionumber=? and ordernumber=?");
636         $sth->execute($quantrec,$datereceived,$invoiceno,$cost,$freight,$rrp,$biblionumber,$ordnum);
637         $sth->finish;
638     }
639     return $datereceived;
640 }
641 #------------------------------------------------------------#
642
643 =head3 SearchOrder
644
645 @results = &SearchOrder($search, $biblionumber, $complete);
646
647 Searches for orders.
648
649 C<$search> may take one of several forms: if it is an ISBN,
650 C<&ordersearch> returns orders with that ISBN. If C<$search> is an
651 order number, C<&ordersearch> returns orders with that order number
652 and biblionumber C<$biblionumber>. Otherwise, C<$search> is considered
653 to be a space-separated list of search terms; in this case, all of the
654 terms must appear in the title (matching the beginning of title
655 words).
656
657 If C<$complete> is C<yes>, the results will include only completed
658 orders. In any case, C<&ordersearch> ignores cancelled orders.
659
660 C<&ordersearch> returns an array.
661 C<@results> is an array of references-to-hash with the following keys:
662
663 =over 4
664
665 =item C<author>
666
667 =item C<seriestitle>
668
669 =item C<branchcode>
670
671 =item C<bookfundid>
672
673 =back
674
675 =cut
676
677 sub SearchOrder {
678     my ( $search, $id, $biblionumber, $catview ) = @_;
679     my $dbh = C4::Context->dbh;
680     my @data = split( ' ', $search );
681     my @searchterms;
682     if ($id) {
683         @searchterms = ($id);
684     }
685     map { push( @searchterms, "$_%", "%$_%" ) } @data;
686     push( @searchterms, $search, $search, $biblionumber );
687     my $query;
688   ### FIXME  THIS CAN raise a problem if more THAN ONE biblioitem is linked to one biblio  
689     if ($id) {  
690         $query =
691           "SELECT *,biblio.title 
692            FROM aqorders 
693            LEFT JOIN biblio ON aqorders.biblionumber=biblio.biblionumber 
694            LEFT JOIN biblioitems ON biblioitems.biblionumber=biblio.biblionumber 
695            LEFT JOIN aqbasket ON aqorders.basketno = aqbasket.basketno
696             WHERE aqbasket.booksellerid = ?
697             AND ((datecancellationprinted is NULL)
698             OR (datecancellationprinted = '0000-00-00'))
699             AND (("
700           . (
701             join( " AND ",
702                 map { "(biblio.title like ? or biblio.title like ?)" } @data )
703           )
704           . ") OR biblioitems.isbn=? OR (aqorders.ordernumber=? AND aqorders.biblionumber=?)) ";
705
706     }
707     else {
708         $query =
709           " SELECT *,biblio.title
710             FROM   aqorders
711             LEFT JOIN biblio ON biblio.biblionumber=aqorders.biblionumber
712             LEFT JOIN aqbasket on aqorders.basketno=aqbasket.basketno
713             LEFT JOIN biblioitems ON biblioitems.biblionumber=biblio.biblionumber      
714             WHERE  ((datecancellationprinted is NULL)
715             OR     (datecancellationprinted = '0000-00-00'))
716             AND    (aqorders.quantityreceived < aqorders.quantity OR aqorders.quantityreceived is NULL)
717             AND (("
718           . (
719             join( " AND ",
720                 map { "(biblio.title like ? OR biblio.title like ?)" } @data )
721           )
722           . ") or biblioitems.isbn=? OR (aqorders.ordernumber=? AND aqorders.biblionumber=?)) ";
723     }
724     $query .= " GROUP BY aqorders.ordernumber";
725     ### $query
726     my $sth = $dbh->prepare($query);
727     $sth->execute(@searchterms);
728     my @results = ();
729     my $query2 = "
730         SELECT *
731         FROM   biblio
732         WHERE  biblionumber=?
733     ";
734     my $sth2 = $dbh->prepare($query2);
735     my $query3 = "
736         SELECT *
737         FROM   aqorderbreakdown
738         WHERE  ordernumber=?
739     ";
740     my $sth3 = $dbh->prepare($query3);
741
742     while ( my $data = $sth->fetchrow_hashref ) {
743         $sth2->execute( $data->{'biblionumber'} );
744         my $data2 = $sth2->fetchrow_hashref;
745         $data->{'author'}      = $data2->{'author'};
746         $data->{'seriestitle'} = $data2->{'seriestitle'};
747         $sth3->execute( $data->{'ordernumber'} );
748         my $data3 = $sth3->fetchrow_hashref;
749         $data->{'branchcode'} = $data3->{'branchcode'};
750         $data->{'bookfundid'} = $data3->{'bookfundid'};
751         push( @results, $data );
752     }
753     ### @results
754     $sth->finish;
755     $sth2->finish;
756     $sth3->finish;
757     return @results;
758 }
759
760 #------------------------------------------------------------#
761
762 =head3 DelOrder
763
764 =over 4
765
766 &DelOrder($biblionumber, $ordernumber);
767
768 Cancel the order with the given order and biblio numbers. It does not
769 delete any entries in the aqorders table, it merely marks them as
770 cancelled.
771
772 =back
773
774 =cut
775
776 sub DelOrder {
777     my ( $bibnum, $ordnum ) = @_;
778     my $dbh = C4::Context->dbh;
779     my $query = "
780         UPDATE aqorders
781         SET    datecancellationprinted=now()
782         WHERE  biblionumber=? AND ordernumber=?
783     ";
784     my $sth = $dbh->prepare($query);
785     $sth->execute( $bibnum, $ordnum );
786     $sth->finish;
787 }
788
789
790 =back
791
792 =head2 FUNCTIONS ABOUT PARCELS
793
794 =over 2
795
796 =cut
797
798 #------------------------------------------------------------#
799
800 =head3 GetParcel
801
802 =over 4
803
804 @results = &GetParcel($booksellerid, $code, $date);
805
806 Looks up all of the received items from the supplier with the given
807 bookseller ID at the given date, for the given code (bookseller Invoice number). Ignores cancelled and completed orders.
808
809 C<@results> is an array of references-to-hash. The keys of each element are fields from
810 the aqorders, biblio, and biblioitems tables of the Koha database.
811
812 C<@results> is sorted alphabetically by book title.
813
814 =back
815
816 =cut
817
818 sub GetParcel {
819     #gets all orders from a certain supplier, orders them alphabetically
820     my ( $supplierid, $code, $datereceived ) = @_;
821     my $dbh     = C4::Context->dbh;
822     my @results = ();
823     $code .= '%'
824       if $code;  # add % if we search on a given code (otherwise, let him empty)
825     my $strsth ="
826         SELECT  authorisedby,
827                 creationdate,
828                 aqbasket.basketno,
829                 closedate,surname,
830                 firstname,
831                 aqorders.biblionumber,
832                 aqorders.title,
833                 aqorders.ordernumber,
834                 aqorders.quantity,
835                 aqorders.quantityreceived,
836                 aqorders.unitprice,
837                 aqorders.listprice,
838                 aqorders.rrp,
839                 aqorders.ecost
840         FROM aqorders 
841         LEFT JOIN aqbasket ON aqbasket.basketno=aqorders.basketno
842         LEFT JOIN borrowers ON aqbasket.authorisedby=borrowers.borrowernumber
843         WHERE 
844             aqbasket.booksellerid=?
845             AND aqorders.booksellerinvoicenumber LIKE  \"$code\"
846             AND aqorders.datereceived= \'$datereceived\'";
847
848     if ( C4::Context->preference("IndependantBranches") ) {
849         my $userenv = C4::Context->userenv;
850         if ( ($userenv) && ( $userenv->{flags} != 1 ) ) {
851             $strsth .=
852                 " AND (borrowers.branchcode = '"
853               . $userenv->{branch}
854               . "' OR borrowers.branchcode ='')";
855         }
856     }
857     $strsth .= " ORDER BY aqbasket.basketno";
858     ### parcelinformation : $strsth
859  #   warn "STH : $strsth";
860     my $sth = $dbh->prepare($strsth);
861     $sth->execute($supplierid);
862     while ( my $data = $sth->fetchrow_hashref ) {
863         push( @results, $data );
864     }
865     ### countparcelbiblio: scalar(@results)
866     $sth->finish;
867
868     return @results;
869 }
870
871 #------------------------------------------------------------#
872
873 =head3 GetParcels
874
875 =over 4
876
877 $results = &GetParcels($bookseller, $order, $code, $datefrom, $dateto);
878 get a lists of parcels.
879
880 * Input arg :
881
882 =item $bookseller
883 is the bookseller this function has to get parcels.
884
885 =item $order
886 To know on what criteria the results list has to be ordered.
887
888 =item $code
889 is the booksellerinvoicenumber.
890
891 =item $datefrom & $dateto
892 to know on what date this function has to filter its search.
893
894 * return:
895 a pointer on a hash list containing parcel informations as such :
896
897 =item Creation date
898
899 =item Last operation
900
901 =item Number of biblio
902
903 =item Number of items
904
905 =back
906
907 =cut
908
909 sub GetParcels {
910     my ($bookseller,$order, $code, $datefrom, $dateto) = @_;
911     my $dbh    = C4::Context->dbh;
912     my $strsth ="
913         SELECT  aqorders.booksellerinvoicenumber,
914                 datereceived,purchaseordernumber,
915                 count(DISTINCT biblionumber) AS biblio,
916                 sum(quantity) AS itemsexpected,
917                 sum(quantityreceived) AS itemsreceived
918         FROM   aqorders LEFT JOIN aqbasket ON aqbasket.basketno = aqorders.basketno
919         WHERE aqbasket.booksellerid = $bookseller and datereceived IS NOT NULL
920     ";
921
922     $strsth .= "and aqorders.booksellerinvoicenumber like \"$code%\" " if ($code);
923
924     $strsth .= "and datereceived >=" . $dbh->quote($datefrom) . " " if ($datefrom);
925
926     $strsth .= "and datereceived <=" . $dbh->quote($dateto) . " " if ($dateto);
927
928     $strsth .= "group by aqorders.booksellerinvoicenumber,datereceived ";
929     $strsth .= "order by $order " if ($order);
930 ### $strsth
931     my $sth = $dbh->prepare($strsth);
932
933     $sth->execute;
934     my $results = $sth->fetchall_arrayref({});
935     $sth->finish;
936     return @$results;
937 }
938
939 #------------------------------------------------------------#
940
941 =head3 GetLateOrders
942
943 =over 4
944
945 @results = &GetLateOrders;
946
947 Searches for bookseller with late orders.
948
949 return:
950 the table of supplier with late issues. This table is full of hashref.
951
952 =back
953
954 =cut
955
956 sub GetLateOrders {
957     my $delay      = shift;
958     my $supplierid = shift;
959     my $branch     = shift;
960
961     my $dbh = C4::Context->dbh;
962
963     #BEWARE, order of parenthesis and LEFT JOIN is important for speed
964     my $strsth;
965     my $dbdriver = C4::Context->config("db_scheme") || "mysql";
966
967     #    warn " $dbdriver";
968     if ( $dbdriver eq "mysql" ) {
969         $strsth = "
970             SELECT aqbasket.basketno,aqorders.ordernumber,
971                 DATE(aqbasket.closedate) AS orderdate,
972                 aqorders.quantity - IFNULL(aqorders.quantityreceived,0) AS quantity,
973                 aqorders.rrp AS unitpricesupplier,
974                 aqorders.ecost AS unitpricelib,
975                 (aqorders.quantity - IFNULL(aqorders.quantityreceived,0)) * aqorders.rrp AS subtotal,
976                 aqbookfund.bookfundname AS budget,
977                 borrowers.branchcode AS branch,
978                 aqbooksellers.name AS supplier,
979                 aqorders.title,
980                 biblio.author,
981                 biblioitems.publishercode AS publisher,
982                 biblioitems.publicationyear,
983                 DATEDIFF(CURDATE( ),closedate) AS latesince
984             FROM  (((
985                 (aqorders LEFT JOIN biblio ON biblio.biblionumber = aqorders.biblionumber)
986             LEFT JOIN biblioitems ON  biblioitems.biblionumber=biblio.biblionumber)
987             LEFT JOIN aqorderbreakdown ON aqorders.ordernumber = aqorderbreakdown.ordernumber)
988             LEFT JOIN aqbookfund ON aqorderbreakdown.bookfundid = aqbookfund.bookfundid),
989             (aqbasket LEFT JOIN borrowers ON aqbasket.authorisedby = borrowers.borrowernumber)
990             LEFT JOIN aqbooksellers ON aqbasket.booksellerid = aqbooksellers.id
991             WHERE aqorders.basketno = aqbasket.basketno
992             AND (closedate < DATE_SUB(CURDATE( ),INTERVAL $delay DAY))
993             AND ((datereceived = '' OR datereceived is null)
994             OR (aqorders.quantityreceived < aqorders.quantity) )
995         ";
996         $strsth .= " AND aqbasket.booksellerid = $supplierid " if ($supplierid);
997         $strsth .= " AND borrowers.branchcode like \'" . $branch . "\'"
998           if ($branch);
999         $strsth .=
1000           " AND borrowers.branchcode like \'"
1001           . C4::Context->userenv->{branch} . "\'"
1002           if ( C4::Context->preference("IndependantBranches")
1003             && C4::Context->userenv
1004             && C4::Context->userenv->{flags} != 1 );
1005         $strsth .=" HAVING quantity<>0
1006                     AND unitpricesupplier<>0
1007                     AND unitpricelib<>0
1008                     ORDER BY latesince,basketno,borrowers.branchcode, supplier
1009         ";
1010     }
1011     else {
1012         $strsth = "
1013             SELECT aqbasket.basketno,
1014                    DATE(aqbasket.closedate) AS orderdate,
1015                     aqorders.quantity, aqorders.rrp AS unitpricesupplier,
1016                     aqorders.ecost as unitpricelib,
1017                     aqorders.quantity * aqorders.rrp AS subtotal
1018                     aqbookfund.bookfundname AS budget,
1019                     borrowers.branchcode AS branch,
1020                     aqbooksellers.name AS supplier,
1021                     biblio.title,
1022                     biblio.author,
1023                     biblioitems.publishercode AS publisher,
1024                     biblioitems.publicationyear,
1025                     (CURDATE -  closedate) AS latesince
1026                     FROM(( (
1027                         (aqorders LEFT JOIN biblio on biblio.biblionumber = aqorders.biblionumber)
1028                         LEFT JOIN biblioitems on  biblioitems.biblionumber=biblio.biblionumber)
1029                         LEFT JOIN aqorderbreakdown on aqorders.ordernumber = aqorderbreakdown.ordernumber)
1030                         LEFT JOIN aqbookfund ON aqorderbreakdown.bookfundid = aqbookfund.bookfundid),
1031                         (aqbasket LEFT JOIN borrowers on aqbasket.authorisedby = borrowers.borrowernumber) LEFT JOIN aqbooksellers ON aqbasket.booksellerid = aqbooksellers.id
1032                     WHERE aqorders.basketno = aqbasket.basketno
1033                     AND (closedate < (CURDATE -(INTERVAL $delay DAY))
1034                     AND ((datereceived = '' OR datereceived is null)
1035                     OR (aqorders.quantityreceived < aqorders.quantity) ) ";
1036         $strsth .= " AND aqbasket.booksellerid = $supplierid " if ($supplierid);
1037
1038         $strsth .= " AND borrowers.branchcode like \'" . $branch . "\'" if ($branch);
1039         $strsth .=" AND borrowers.branchcode like \'". C4::Context->userenv->{branch} . "\'"
1040             if (C4::Context->preference("IndependantBranches") && C4::Context->userenv->{flags} != 1 );
1041         $strsth .=" ORDER BY latesince,basketno,borrowers.branchcode, supplier";
1042     }
1043     my $sth = $dbh->prepare($strsth);
1044     $sth->execute;
1045     my @results;
1046     my $hilighted = 1;
1047     while ( my $data = $sth->fetchrow_hashref ) {
1048         $data->{hilighted} = $hilighted if ( $hilighted > 0 );
1049         $data->{orderdate} = format_date( $data->{orderdate} );
1050         push @results, $data;
1051         $hilighted = -$hilighted;
1052     }
1053     $sth->finish;
1054     return @results;
1055 }
1056
1057 #------------------------------------------------------------#
1058
1059 =head3 GetHistory
1060
1061 =over 4
1062
1063 (\@order_loop, $total_qty, $total_price, $total_qtyreceived)=&GetHistory( $title, $author, $name, $from_placed_on, $to_placed_on )
1064
1065 this function get the search history.
1066
1067 =back
1068
1069 =cut
1070
1071 sub GetHistory {
1072     my ( $title, $author, $name, $from_placed_on, $to_placed_on ) = @_;
1073     my @order_loop;
1074     my $total_qty         = 0;
1075     my $total_qtyreceived = 0;
1076     my $total_price       = 0;
1077
1078 # don't run the query if there are no parameters (list would be too long for sure !)
1079     if ( $title || $author || $name || $from_placed_on || $to_placed_on ) {
1080         my $dbh   = C4::Context->dbh;
1081         my $query ="
1082             SELECT
1083                 biblio.title,
1084                 biblio.author,
1085                 aqorders.basketno,
1086                 name,aqbasket.creationdate,
1087                 aqorders.datereceived,
1088                 aqorders.quantity,
1089                 aqorders.quantityreceived,
1090                 aqorders.ecost,
1091                 aqorders.ordernumber,
1092                 aqorders.booksellerinvoicenumber as invoicenumber,
1093                 aqbooksellers.id as id,
1094                 aqorders.biblionumber
1095             FROM aqorders 
1096             LEFT JOIN aqbasket ON aqorders.basketno=aqbasket.basketno 
1097             LEFT JOIN aqbooksellers ON aqbasket.booksellerid=aqbooksellers.id
1098             LEFT JOIN biblio ON biblio.biblionumber=aqorders.biblionumber";
1099
1100         $query .= " LEFT JOIN borrowers ON aqbasket.authorisedby=borrowers.borrowernumber"
1101           if ( C4::Context->preference("IndependantBranches") );
1102
1103         $query .= " WHERE 1 ";
1104         $query .= " AND biblio.title LIKE " . $dbh->quote( "%" . $title . "%" )
1105           if $title;
1106
1107         $query .=
1108           " AND biblio.author LIKE " . $dbh->quote( "%" . $author . "%" )
1109           if $author;
1110
1111         $query .= " AND name LIKE " . $dbh->quote( "%" . $name . "%" ) if $name;
1112
1113         $query .= " AND creationdate >" . $dbh->quote($from_placed_on)
1114           if $from_placed_on;
1115
1116         $query .= " AND creationdate<" . $dbh->quote($to_placed_on)
1117           if $to_placed_on;
1118         $query .= " AND (datecancellationprinted is NULL or datecancellationprinted='0000-00-00')";
1119
1120         if ( C4::Context->preference("IndependantBranches") ) {
1121             my $userenv = C4::Context->userenv;
1122             if ( ($userenv) && ( $userenv->{flags} != 1 ) ) {
1123                 $query .=
1124                     " AND (borrowers.branchcode = '"
1125                   . $userenv->{branch}
1126                   . "' OR borrowers.branchcode ='')";
1127             }
1128         }
1129         $query .= " ORDER BY booksellerid";
1130         my $sth = $dbh->prepare($query);
1131         $sth->execute;
1132         my $cnt = 1;
1133         while ( my $line = $sth->fetchrow_hashref ) {
1134             $line->{count} = $cnt++;
1135             $line->{toggle} = 1 if $cnt % 2;
1136             push @order_loop, $line;
1137             $line->{creationdate} = format_date( $line->{creationdate} );
1138             $line->{datereceived} = format_date( $line->{datereceived} );
1139             $total_qty         += $line->{'quantity'};
1140             $total_qtyreceived += $line->{'quantityreceived'};
1141             $total_price       += $line->{'quantity'} * $line->{'ecost'};
1142         }
1143     }
1144     return \@order_loop, $total_qty, $total_price, $total_qtyreceived;
1145 }
1146
1147 =head2 GetRecentAcqui
1148
1149    $results = GetRecentAcqui($days);
1150
1151    C<$results> is a ref to a table which containts hashref
1152
1153 =cut
1154
1155 sub GetRecentAcqui {
1156     my $limit  = shift;
1157     my $dbh    = C4::Context->dbh;
1158     my $query = "
1159         SELECT *
1160         FROM   biblio
1161         ORDER BY timestamp DESC
1162         LIMIT  0,".$limit;
1163
1164     my $sth = $dbh->prepare($query);
1165     $sth->execute;
1166     my @results;
1167     while(my $data = $sth->fetchrow_hashref){
1168         push @results,$data;
1169     }
1170     return \@results;
1171 }
1172
1173 1;
1174 __END__
1175
1176 =back
1177
1178 =head1 AUTHOR
1179
1180 Koha Developement team <info@koha.org>
1181
1182 =cut