Merge branch 'patroncards-wip' of git://git.foundations.edu/koha into community
[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 warnings;
23 use C4::Context;
24 use C4::Debug;
25 use C4::Dates qw(format_date format_date_in_iso);
26 use MARC::Record;
27 use C4::Suggestions;
28 use C4::Debug;
29 use C4::SQLHelper qw(InsertInTable);
30
31 use Time::localtime;
32 use HTML::Entities;
33
34 use vars qw($VERSION @ISA @EXPORT);
35
36 BEGIN {
37     # set the version for version checking
38     $VERSION = 3.01;
39     require Exporter;
40     @ISA    = qw(Exporter);
41     @EXPORT = qw(
42         &GetBasket &NewBasket &CloseBasket &DelBasket &ModBasket
43         &GetBasketsByBookseller &GetBasketsByBasketgroup
44
45         &ModBasketHeader
46
47         &ModBasketgroup &NewBasketgroup &DelBasketgroup &GetBasketgroup &CloseBasketgroup
48         &GetBasketgroups &ReOpenBasketgroup
49
50         &NewOrder &DelOrder &ModOrder &GetPendingOrders &GetOrder &GetOrders
51         &GetOrderNumber &GetLateOrders &GetOrderFromItemnumber
52         &SearchOrder &GetHistory &GetRecentAcqui
53         &ModReceiveOrder &ModOrderBiblioitemNumber
54
55         &NewOrderItem &ModOrderItem
56
57         &GetParcels &GetParcel
58         &GetContracts &GetContract
59
60         &GetItemnumbersFromOrder
61     );
62 }
63
64
65
66
67
68 sub GetOrderFromItemnumber {
69     my ($itemnumber) = @_;
70     my $dbh          = C4::Context->dbh;
71     my $query        = qq|
72
73     SELECT  * from aqorders    LEFT JOIN aqorders_items
74     ON (     aqorders.ordernumber = aqorders_items.ordernumber   )
75     WHERE itemnumber = ?  |;
76
77     my $sth = $dbh->prepare($query);
78
79 #    $sth->trace(3);
80
81     $sth->execute($itemnumber);
82
83     my $order = $sth->fetchrow_hashref;
84     return ( $order  );
85
86 }
87
88 # Returns the itemnumber(s) associated with the ordernumber given in parameter
89 sub GetItemnumbersFromOrder {
90     my ($ordernumber) = @_;
91     my $dbh          = C4::Context->dbh;
92     my $query        = "SELECT itemnumber FROM aqorders_items WHERE ordernumber=?";
93     my $sth = $dbh->prepare($query);
94     $sth->execute($ordernumber);
95     my @tab;
96
97     while (my $order = $sth->fetchrow_hashref) {
98     push @tab, $order->{'itemnumber'};
99     }
100
101     return @tab;
102
103 }
104
105
106
107
108
109
110 =head1 NAME
111
112 C4::Acquisition - Koha functions for dealing with orders and acquisitions
113
114 =head1 SYNOPSIS
115
116 use C4::Acquisition;
117
118 =head1 DESCRIPTION
119
120 The functions in this module deal with acquisitions, managing book
121 orders, basket and parcels.
122
123 =head1 FUNCTIONS
124
125 =head2 FUNCTIONS ABOUT BASKETS
126
127 =head3 GetBasket
128
129 =over 4
130
131 $aqbasket = &GetBasket($basketnumber);
132
133 get all basket informations in aqbasket for a given basket
134
135 return :
136 informations for a given basket returned as a hashref.
137
138 =back
139
140 =cut
141
142 sub GetBasket {
143     my ($basketno) = @_;
144     my $dbh        = C4::Context->dbh;
145     my $query = "
146         SELECT  aqbasket.*,
147                 concat( b.firstname,' ',b.surname) AS authorisedbyname,
148                 b.branchcode AS branch
149         FROM    aqbasket
150         LEFT JOIN borrowers b ON aqbasket.authorisedby=b.borrowernumber
151         WHERE basketno=?
152     ";
153     my $sth=$dbh->prepare($query);
154     $sth->execute($basketno);
155     my $basket = $sth->fetchrow_hashref;
156     return ( $basket );
157 }
158
159 #------------------------------------------------------------#
160
161 =head3 NewBasket
162
163 =over 4
164
165 $basket = &NewBasket( $booksellerid, $authorizedby, $basketname, $basketnote, $basketbooksellernote, $basketcontractnumber );
166
167 Create a new basket in aqbasket table
168
169 =item C<$booksellerid> is a foreign key in the aqbasket table
170
171 =item C<$authorizedby> is the username of who created the basket
172
173 The other parameters are optional, see ModBasketHeader for more info on them.
174
175 =back
176
177 =cut
178
179 # FIXME : this function seems to be unused.
180
181 sub NewBasket {
182     my ( $booksellerid, $authorisedby, $basketname, $basketnote, $basketbooksellernote, $basketcontractnumber ) = @_;
183     my $dbh = C4::Context->dbh;
184     my $query = "
185         INSERT INTO aqbasket
186                 (creationdate,booksellerid,authorisedby)
187         VALUES  (now(),'$booksellerid','$authorisedby')
188     ";
189     my $sth =
190     $dbh->do($query);
191 #find & return basketno MYSQL dependant, but $dbh->last_insert_id always returns null :-(
192     my $basket = $dbh->{'mysql_insertid'};
193     ModBasketHeader($basket, $basketname || '', $basketnote || '', $basketbooksellernote || '', $basketcontractnumber || undef);
194     return $basket;
195 }
196
197 #------------------------------------------------------------#
198
199 =head3 CloseBasket
200
201 =over 4
202
203 &CloseBasket($basketno);
204
205 close a basket (becomes unmodifiable,except for recieves)
206
207 =back
208
209 =cut
210
211 sub CloseBasket {
212     my ($basketno) = @_;
213     my $dbh        = C4::Context->dbh;
214     my $query = "
215         UPDATE aqbasket
216         SET    closedate=now()
217         WHERE  basketno=?
218     ";
219     my $sth = $dbh->prepare($query);
220     $sth->execute($basketno);
221 }
222
223 #------------------------------------------------------------#
224
225 =head3 CloseBasketgroup
226
227 =over 4
228
229 &CloseBasketgroup($basketgroupno);
230
231 close a basketgroup
232
233 =back
234
235 =cut
236
237 sub CloseBasketgroup {
238     my ($basketgroupno) = @_;
239     my $dbh        = C4::Context->dbh;
240     my $sth = $dbh->prepare("
241         UPDATE aqbasketgroups
242         SET    closed=1
243         WHERE  id=?
244     ");
245     $sth->execute($basketgroupno);
246 }
247
248 #------------------------------------------------------------#
249
250 =head3 ReOpenBaskergroup($basketgroupno)
251
252 =over 4
253
254 &ReOpenBaskergroup($basketgroupno);
255
256 reopen a basketgroup
257
258 =back
259
260 =cut
261
262 sub ReOpenBasketgroup {
263     my ($basketgroupno) = @_;
264     my $dbh        = C4::Context->dbh;
265     my $sth = $dbh->prepare("
266         UPDATE aqbasketgroups
267         SET    closed=0
268         WHERE  id=?
269     ");
270     $sth->execute($basketgroupno);
271 }
272
273 #------------------------------------------------------------#
274
275
276 =head3 DelBasket
277
278 =over 4
279
280 &DelBasket($basketno);
281
282 Deletes the basket that has basketno field $basketno in the aqbasket table.
283
284 =over 2
285
286 =item C<$basketno> is the primary key of the basket in the aqbasket table.
287
288 =back
289
290 =back
291
292 =cut
293 sub DelBasket {
294     my ( $basketno ) = @_;
295     my $query = "DELETE FROM aqbasket WHERE basketno=?";
296     my $dbh = C4::Context->dbh;
297     my $sth = $dbh->prepare($query);
298     $sth->execute($basketno);
299     $sth->finish;
300 }
301
302 #------------------------------------------------------------#
303
304 =head3 ModBasket
305
306 =over 4
307
308 &ModBasket($basketinfo);
309
310 Modifies a basket, using a hashref $basketinfo for the relevant information, only $basketinfo->{'basketno'} is required.
311
312 =over 2
313
314 =item C<$basketno> is the primary key of the basket in the aqbasket table.
315
316 =back
317
318 =back
319
320 =cut
321 sub ModBasket {
322     my $basketinfo = shift;
323     my $query = "UPDATE aqbasket SET ";
324     my @params;
325     foreach my $key (keys %$basketinfo){
326         if ($key ne 'basketno'){
327             $query .= "$key=?, ";
328             push(@params, $basketinfo->{$key} || undef );
329         }
330     }
331 # get rid of the "," at the end of $query
332     if (substr($query, length($query)-2) eq ', '){
333         chop($query);
334         chop($query);
335         $query .= ' ';
336     }
337     $query .= "WHERE basketno=?";
338     push(@params, $basketinfo->{'basketno'});
339     my $dbh = C4::Context->dbh;
340     my $sth = $dbh->prepare($query);
341     $sth->execute(@params);
342     $sth->finish;
343 }
344
345 #------------------------------------------------------------#
346
347 =head3 ModBasketHeader
348
349 =over 4
350
351 &ModBasketHeader($basketno, $basketname, $note, $booksellernote, $contractnumber);
352
353 Modifies a basket's header.
354
355 =over 2
356
357 =item C<$basketno> is the "basketno" field in the "aqbasket" table;
358
359 =item C<$basketname> is the "basketname" field in the "aqbasket" table;
360
361 =item C<$note> is the "note" field in the "aqbasket" table;
362
363 =item C<$booksellernote> is the "booksellernote" field in the "aqbasket" table;
364
365 =item C<$contractnumber> is the "contractnumber" (foreign) key in the "aqbasket" table.
366
367 =back
368
369 =back
370
371 =cut
372 sub ModBasketHeader {
373     my ($basketno, $basketname, $note, $booksellernote, $contractnumber) = @_;
374     my $query = "UPDATE aqbasket SET basketname=?, note=?, booksellernote=? WHERE basketno=?";
375     my $dbh = C4::Context->dbh;
376     my $sth = $dbh->prepare($query);
377     $sth->execute($basketname,$note,$booksellernote,$basketno);
378     if ( $contractnumber ) {
379         my $query2 ="UPDATE aqbasket SET contractnumber=? WHERE basketno=?";
380         my $sth2 = $dbh->prepare($query2);
381         $sth2->execute($contractnumber,$basketno);
382         $sth2->finish;
383     }
384     $sth->finish;
385 }
386
387 #------------------------------------------------------------#
388
389 =head3 GetBasketsByBookseller
390
391 =over 4
392
393 @results = &GetBasketsByBookseller($booksellerid, $extra);
394
395 Returns a list of hashes of all the baskets that belong to bookseller 'booksellerid'.
396
397 =over 2
398
399 =item C<$booksellerid> is the 'id' field of the bookseller in the aqbooksellers table
400
401 =item C<$extra> is the extra sql parameters, can be
402
403 - $extra->{groupby}: group baskets by column
404     ex. $extra->{groupby} = aqbasket.basketgroupid
405 - $extra->{orderby}: order baskets by column
406 - $extra->{limit}: limit number of results (can be helpful for pagination)
407
408 =back
409
410 =back
411
412 =cut
413
414 sub GetBasketsByBookseller {
415     my ($booksellerid, $extra) = @_;
416     my $query = "SELECT * FROM aqbasket WHERE booksellerid=?";
417     if ($extra){
418         if ($extra->{groupby}) {
419             $query .= " GROUP by $extra->{groupby}";
420         }
421         if ($extra->{orderby}){
422             $query .= " ORDER by $extra->{orderby}";
423         }
424         if ($extra->{limit}){
425             $query .= " LIMIT $extra->{limit}";
426         }
427     }
428     my $dbh = C4::Context->dbh;
429     my $sth = $dbh->prepare($query);
430     $sth->execute($booksellerid);
431     my $results = $sth->fetchall_arrayref({});
432     $sth->finish;
433     return $results
434 }
435
436 #------------------------------------------------------------#
437
438 =head3 GetBasketsByBasketgroup
439
440 =over 4
441
442 $baskets = &GetBasketsByBasketgroup($basketgroupid);
443
444 =over 2
445
446 Returns a reference to all baskets that belong to basketgroup $basketgroupid.
447
448 =back
449
450 =back
451
452 =cut
453
454 sub GetBasketsByBasketgroup {
455     my $basketgroupid = shift;
456     my $query = "SELECT * FROM aqbasket
457                 LEFT JOIN aqcontract USING(contractnumber) WHERE basketgroupid=?";
458     my $dbh = C4::Context->dbh;
459     my $sth = $dbh->prepare($query);
460     $sth->execute($basketgroupid);
461     my $results = $sth->fetchall_arrayref({});
462     $sth->finish;
463     return $results
464 }
465
466 #------------------------------------------------------------#
467
468 =head3 NewBasketgroup
469
470 =over 4
471
472 $basketgroupid = NewBasketgroup(\%hashref);
473
474 =over 2
475
476 Adds a basketgroup to the aqbasketgroups table, and add the initial baskets to it.
477
478 $hashref->{'booksellerid'} is the 'id' field of the bookseller in the aqbooksellers table,
479
480 $hashref->{'name'} is the 'name' field of the basketgroup in the aqbasketgroups table,
481
482 $hashref->{'basketlist'} is a list reference of the 'id's of the baskets that belong to this group,
483
484 $hashref->{'deliveryplace'} is the 'deliveryplace' field of the basketgroup in the aqbasketgroups table,
485
486 $hashref->{'deliverycomment'} is the 'deliverycomment' field of the basketgroup in the aqbasketgroups table,
487
488 $hashref->{'closed'} is the 'closed' field of the aqbasketgroups table, it is false if 0, true otherwise.
489
490 =back
491
492 =back
493
494 =cut
495
496 sub NewBasketgroup {
497     my $basketgroupinfo = shift;
498     die "booksellerid is required to create a basketgroup" unless $basketgroupinfo->{'booksellerid'};
499     my $query = "INSERT INTO aqbasketgroups (";
500     my @params;
501     foreach my $field ('name', 'deliveryplace', 'deliverycomment', 'closed') {
502         if ( $basketgroupinfo->{$field} ) {
503             $query .= "$field, ";
504             push(@params, $basketgroupinfo->{$field});
505         }
506     }
507     $query .= "booksellerid) VALUES (";
508     foreach (@params) {
509         $query .= "?, ";
510     }
511     $query .= "?)";
512     push(@params, $basketgroupinfo->{'booksellerid'});
513     my $dbh = C4::Context->dbh;
514     my $sth = $dbh->prepare($query);
515     $sth->execute(@params);
516     my $basketgroupid = $dbh->{'mysql_insertid'};
517     if( $basketgroupinfo->{'basketlist'} ) {
518         foreach my $basketno (@{$basketgroupinfo->{'basketlist'}}) {
519             my $query2 = "UPDATE aqbasket SET basketgroupid=? WHERE basketno=?";
520             my $sth2 = $dbh->prepare($query2);
521             $sth2->execute($basketgroupid, $basketno);
522         }
523     }
524     return $basketgroupid;
525 }
526
527 #------------------------------------------------------------#
528
529 =head3 ModBasketgroup
530
531 =over 4
532
533 ModBasketgroup(\%hashref);
534
535 =over 2
536
537 Modifies a basketgroup in the aqbasketgroups table, and add the baskets to it.
538
539 $hashref->{'id'} is the 'id' field of the basketgroup in the aqbasketgroup table, this parameter is mandatory,
540
541 $hashref->{'name'} is the 'name' field of the basketgroup in the aqbasketgroups table,
542
543 $hashref->{'basketlist'} is a list reference of the 'id's of the baskets that belong to this group,
544
545 $hashref->{'billingplace'} is the 'billingplace' field of the basketgroup in the aqbasketgroups table,
546
547 $hashref->{'deliveryplace'} is the 'deliveryplace' field of the basketgroup in the aqbasketgroups table,
548
549 $hashref->{'deliverycomment'} is the 'deliverycomment' field of the basketgroup in the aqbasketgroups table,
550
551 $hashref->{'closed'} is the 'closed' field of the aqbasketgroups table, it is false if 0, true otherwise.
552
553 =back
554
555 =back
556
557 =cut
558
559 sub ModBasketgroup {
560     my $basketgroupinfo = shift;
561     die "basketgroup id is required to edit a basketgroup" unless $basketgroupinfo->{'id'};
562     my $dbh = C4::Context->dbh;
563     my $query = "UPDATE aqbasketgroups SET ";
564     my @params;
565     foreach my $field (qw(name billingplace deliveryplace deliverycomment closed)) {
566         if ( defined $basketgroupinfo->{$field} ) {
567             $query .= "$field=?, ";
568             push(@params, $basketgroupinfo->{$field});
569         }
570     }
571     chop($query);
572     chop($query);
573     $query .= " WHERE id=?";
574     push(@params, $basketgroupinfo->{'id'});
575     my $sth = $dbh->prepare($query);
576     $sth->execute(@params);
577
578     $sth = $dbh->prepare('UPDATE aqbasket SET basketgroupid = NULL WHERE basketgroupid = ?');
579     $sth->execute($basketgroupinfo->{'id'});
580
581     if($basketgroupinfo->{'basketlist'} && @{$basketgroupinfo->{'basketlist'}}){
582         $sth = $dbh->prepare("UPDATE aqbasket SET basketgroupid=? WHERE basketno=?");
583         foreach my $basketno (@{$basketgroupinfo->{'basketlist'}}) {
584             $sth->execute($basketgroupinfo->{'id'}, $basketno);
585             $sth->finish;
586         }
587     }
588     $sth->finish;
589 }
590
591 #------------------------------------------------------------#
592
593 =head3 DelBasketgroup
594
595 =over 4
596
597 DelBasketgroup($basketgroupid);
598
599 =over 2
600
601 Deletes a basketgroup in the aqbasketgroups table, and removes the reference to it from the baskets,
602
603 =item C<$basketgroupid> is the 'id' field of the basket in the aqbasketgroup table
604
605 =back
606
607 =back
608
609 =cut
610
611 sub DelBasketgroup {
612     my $basketgroupid = shift;
613     die "basketgroup id is required to edit a basketgroup" unless $basketgroupid;
614     my $query = "DELETE FROM aqbasketgroups WHERE id=?";
615     my $dbh = C4::Context->dbh;
616     my $sth = $dbh->prepare($query);
617     $sth->execute($basketgroupid);
618     $sth->finish;
619 }
620
621 #------------------------------------------------------------#
622
623 =back
624
625 =head2 FUNCTIONS ABOUT ORDERS
626
627 =over 2
628
629 =cut
630
631 =head3 GetBasketgroup
632
633 =over 4
634
635 $basketgroup = &GetBasketgroup($basketgroupid);
636
637 =over 2
638
639 Returns a reference to the hash containing all infermation about the basketgroup.
640
641 =back
642
643 =back
644
645 =cut
646
647 sub GetBasketgroup {
648     my $basketgroupid = shift;
649     die "basketgroup id is required to edit a basketgroup" unless $basketgroupid;
650     my $query = "SELECT * FROM aqbasketgroups WHERE id=?";
651     my $dbh = C4::Context->dbh;
652     my $sth = $dbh->prepare($query);
653     $sth->execute($basketgroupid);
654     my $result = $sth->fetchrow_hashref;
655     $sth->finish;
656     return $result
657 }
658
659 #------------------------------------------------------------#
660
661 =head3 GetBasketgroups
662
663 =over 4
664
665 $basketgroups = &GetBasketgroups($booksellerid);
666
667 =over 2
668
669 Returns a reference to the array of all the basketgroups of bookseller $booksellerid.
670
671 =back
672
673 =back
674
675 =cut
676
677 sub GetBasketgroups {
678     my $booksellerid = shift;
679     die "bookseller id is required to edit a basketgroup" unless $booksellerid;
680     my $query = "SELECT * FROM aqbasketgroups WHERE booksellerid=?";
681     my $dbh = C4::Context->dbh;
682     my $sth = $dbh->prepare($query);
683     $sth->execute($booksellerid);
684     my $results = $sth->fetchall_arrayref({});
685     $sth->finish;
686     return $results
687 }
688
689 #------------------------------------------------------------#
690
691 =back
692
693 =head2 FUNCTIONS ABOUT ORDERS
694
695 =over 2
696
697 =cut
698
699 #------------------------------------------------------------#
700
701 =head3 GetPendingOrders
702
703 =over 4
704
705 $orders = &GetPendingOrders($booksellerid, $grouped, $owner);
706
707 Finds pending orders from the bookseller with the given ID. Ignores
708 completed and cancelled orders.
709
710 C<$booksellerid> contains the bookseller identifier
711 C<$grouped> contains 0 or 1. 0 means returns the list, 1 means return the total
712 C<$owner> contains 0 or 1. 0 means any owner. 1 means only the list of orders entered by the user itself.
713
714 C<$orders> is a reference-to-array; each element is a
715 reference-to-hash with the following fields:
716 C<$grouped> is a boolean that, if set to 1 will group all order lines of the same basket
717 in a single result line
718
719 =over 2
720
721 =item C<authorizedby>
722
723 =item C<entrydate>
724
725 =item C<basketno>
726
727 These give the value of the corresponding field in the aqorders table
728 of the Koha database.
729
730 =back
731
732 =back
733
734 Results are ordered from most to least recent.
735
736 =cut
737
738 sub GetPendingOrders {
739     my ($supplierid,$grouped,$owner,$basketno) = @_;
740     my $dbh = C4::Context->dbh;
741     my $strsth = "
742         SELECT    ".($grouped?"count(*),":"")."aqbasket.basketno,
743                     surname,firstname,aqorders.*,biblio.*,biblioitems.isbn,
744                     aqbasket.closedate, aqbasket.creationdate, aqbasket.basketname
745         FROM      aqorders
746         LEFT JOIN aqbasket ON aqbasket.basketno=aqorders.basketno
747         LEFT JOIN borrowers ON aqbasket.authorisedby=borrowers.borrowernumber
748         LEFT JOIN biblio ON biblio.biblionumber=aqorders.biblionumber
749         LEFT JOIN biblioitems ON biblioitems.biblionumber=biblio.biblionumber
750         WHERE booksellerid=?
751             AND (quantity > quantityreceived OR quantityreceived is NULL)
752             AND datecancellationprinted IS NULL
753             AND (to_days(now())-to_days(closedate) < 180 OR closedate IS NULL)
754     ";
755     ## FIXME  Why 180 days ???
756     my @query_params = ( $supplierid );
757     my $userenv = C4::Context->userenv;
758     if ( C4::Context->preference("IndependantBranches") ) {
759         if ( ($userenv) && ( $userenv->{flags} != 1 ) ) {
760             $strsth .= " and (borrowers.branchcode = ?
761                         or borrowers.branchcode  = '')";
762             push @query_params, $userenv->{branch};
763         }
764     }
765     if ($owner) {
766         $strsth .= " AND aqbasket.authorisedby=? ";
767         push @query_params, $userenv->{'number'};
768     }
769     if ($basketno) {
770         $strsth .= " AND aqbasket.basketno=? ";
771         push @query_params, $basketno;
772     }
773     $strsth .= " group by aqbasket.basketno" if $grouped;
774     $strsth .= " order by aqbasket.basketno";
775
776     my $sth = $dbh->prepare($strsth);
777     $sth->execute( @query_params );
778     my $results = $sth->fetchall_arrayref({});
779     $sth->finish;
780     return $results;
781 }
782
783 #------------------------------------------------------------#
784
785 =head3 GetOrders
786
787 =over 4
788
789 @orders = &GetOrders($basketnumber, $orderby);
790
791 Looks up the pending (non-cancelled) orders with the given basket
792 number. If C<$booksellerID> is non-empty, only orders from that seller
793 are returned.
794
795 return :
796 C<&basket> returns a two-element array. C<@orders> is an array of
797 references-to-hash, whose keys are the fields from the aqorders,
798 biblio, and biblioitems tables in the Koha database.
799
800 =back
801
802 =cut
803
804 sub GetOrders {
805     my ( $basketno, $orderby ) = @_;
806     my $dbh   = C4::Context->dbh;
807     my $query  ="
808         SELECT biblio.*,biblioitems.*,
809                 aqorders.*,
810                 aqbudgets.*,
811                 biblio.title
812         FROM    aqorders
813             LEFT JOIN aqbudgets        ON aqbudgets.budget_id = aqorders.budget_id
814             LEFT JOIN biblio           ON biblio.biblionumber = aqorders.biblionumber
815             LEFT JOIN biblioitems      ON biblioitems.biblionumber =biblio.biblionumber
816         WHERE   basketno=?
817             AND (datecancellationprinted IS NULL OR datecancellationprinted='0000-00-00')
818     ";
819
820     $orderby = "biblioitems.publishercode,biblio.title" unless $orderby;
821     $query .= " ORDER BY $orderby";
822     my $sth = $dbh->prepare($query);
823     $sth->execute($basketno);
824     my $results = $sth->fetchall_arrayref({});
825     $sth->finish;
826     return @$results;
827 }
828
829 #------------------------------------------------------------#
830
831 =head3 GetOrderNumber
832
833 =over 4
834
835 $ordernumber = &GetOrderNumber($biblioitemnumber, $biblionumber);
836
837 =back
838
839 Looks up the ordernumber with the given biblionumber and biblioitemnumber.
840
841 Returns the number of this order.
842
843 =over 4
844
845 =item C<$ordernumber> is the order number.
846
847 =back
848
849 =cut
850 sub GetOrderNumber {
851     my ( $biblionumber,$biblioitemnumber ) = @_;
852     my $dbh = C4::Context->dbh;
853     my $query = "
854         SELECT ordernumber
855         FROM   aqorders
856         WHERE  biblionumber=?
857         AND    biblioitemnumber=?
858     ";
859     my $sth = $dbh->prepare($query);
860     $sth->execute( $biblionumber, $biblioitemnumber );
861
862     return $sth->fetchrow;
863 }
864
865 #------------------------------------------------------------#
866
867 =head3 GetOrder
868
869 =over 4
870
871 $order = &GetOrder($ordernumber);
872
873 Looks up an order by order number.
874
875 Returns a reference-to-hash describing the order. The keys of
876 C<$order> are fields from the biblio, biblioitems, aqorders tables of the Koha database.
877
878 =back
879
880 =cut
881
882 sub GetOrder {
883     my ($ordernumber) = @_;
884     my $dbh      = C4::Context->dbh;
885     my $query = "
886         SELECT biblioitems.*, biblio.*, aqorders.*
887         FROM   aqorders
888         LEFT JOIN biblio on           biblio.biblionumber=aqorders.biblionumber
889         LEFT JOIN biblioitems on       biblioitems.biblionumber=aqorders.biblionumber
890         WHERE aqorders.ordernumber=?
891
892     ";
893     my $sth= $dbh->prepare($query);
894     $sth->execute($ordernumber);
895     my $data = $sth->fetchrow_hashref;
896     $sth->finish;
897     return $data;
898 }
899
900 #------------------------------------------------------------#
901
902 =head3 NewOrder
903
904 =over 4
905
906 &NewOrder(\%hashref);
907
908 Adds a new order to the database. Any argument that isn't described
909 below is the new value of the field with the same name in the aqorders
910 table of the Koha database.
911
912 =over 4
913
914 =item $hashref->{'basketno'} is the basketno foreign key in aqorders, it is mandatory
915
916
917 =item $hashref->{'ordernumber'} is a "minimum order number."
918
919 =item $hashref->{'budgetdate'} is effectively ignored.
920 If it's undef (anything false) or the string 'now', the current day is used.
921 Else, the upcoming July 1st is used.
922
923 =item $hashref->{'subscription'} may be either "yes", or anything else for "no".
924
925 =item $hashref->{'uncertainprice'} may be 0 for "the price is known" or 1 for "the price is uncertain"
926
927 =item defaults entrydate to Now
928
929 The following keys are used: "biblionumber", "title", "basketno", "quantity", "notes", "biblioitemnumber", "rrp", "ecost", "gst", "unitprice", "subscription", "sort1", "sort2", "booksellerinvoicenumber", "listprice", "budgetdate", "purchaseordernumber", "branchcode", "booksellerinvoicenumber", "bookfundid".
930
931 =back
932
933 =back
934
935 =cut
936
937 sub NewOrder {
938     my $orderinfo = shift;
939 #### ------------------------------
940     my $dbh = C4::Context->dbh;
941     my @params;
942
943
944     # if these parameters are missing, we can't continue
945     for my $key (qw/basketno quantity biblionumber budget_id/) {
946         die "Mandatory parameter $key missing" unless $orderinfo->{$key};
947     }
948
949     if ( $orderinfo->{'subscription'} eq 'yes' ) {
950         $orderinfo->{'subscription'} = 1;
951     } else {
952         $orderinfo->{'subscription'} = 0;
953     }
954     $orderinfo->{'entrydate'} ||= C4::Dates->new()->output("iso");
955
956     my $ordernumber=InsertInTable("aqorders",$orderinfo);
957     return ( $orderinfo->{'basketno'}, $ordernumber );
958 }
959
960
961
962 #------------------------------------------------------------#
963
964 =head3 NewOrderItem
965
966 =over 4
967
968 &NewOrderItem();
969
970
971 =back
972
973 =cut
974
975 sub NewOrderItem {
976     #my ($biblioitemnumber,$ordernumber, $biblionumber) = @_;
977     my ($itemnumber, $ordernumber)  = @_;
978     my $dbh = C4::Context->dbh;
979     my $query = qq|
980             INSERT INTO aqorders_items
981                 (itemnumber, ordernumber)
982             VALUES (?,?)    |;
983
984     my $sth = $dbh->prepare($query);
985     $sth->execute( $itemnumber, $ordernumber);
986 }
987
988 #------------------------------------------------------------#
989
990 =head3 ModOrder
991
992 =over 4
993
994 &ModOrder(\%hashref);
995
996 =over 2
997
998 Modifies an existing order. Updates the order with order number
999 $hashref->{'ordernumber'} and biblionumber $hashref->{'biblionumber'}. All other keys of the hash
1000 update the fields with the same name in the aqorders table of the Koha database.
1001
1002 =back
1003
1004 =back
1005
1006 =cut
1007
1008 sub ModOrder {
1009     my $orderinfo = shift;
1010
1011     die "Ordernumber is required"     if $orderinfo->{'ordernumber'} eq  '' ;
1012     die "Biblionumber is required"  if  $orderinfo->{'biblionumber'} eq '';
1013
1014     my $dbh = C4::Context->dbh;
1015     my @params;
1016 #    delete($orderinfo->{'branchcode'});
1017     # the hash contains a lot of entries not in aqorders, so get the columns ...
1018     my $sth = $dbh->prepare("SELECT * FROM aqorders LIMIT 1;");
1019     $sth->execute;
1020     my $colnames = $sth->{NAME};
1021     my $query = "UPDATE aqorders SET ";
1022
1023     foreach my $orderinfokey (grep(!/ordernumber/, keys %$orderinfo)){
1024         # ... and skip hash entries that are not in the aqorders table
1025         # FIXME : probably not the best way to do it (would be better to have a correct hash)
1026         next unless grep(/^$orderinfokey$/, @$colnames);
1027             $query .= "$orderinfokey=?, ";
1028             push(@params, $orderinfo->{$orderinfokey});
1029     }
1030
1031     $query .= "timestamp=NOW()  WHERE  ordernumber=?";
1032 #   push(@params, $specorderinfo{'ordernumber'});
1033     push(@params, $orderinfo->{'ordernumber'} );
1034     $sth = $dbh->prepare($query);
1035     $sth->execute(@params);
1036     $sth->finish;
1037 }
1038
1039 #------------------------------------------------------------#
1040
1041 =head3 ModOrderItem
1042
1043 =over 4
1044
1045 &ModOrderItem(\%hashref);
1046
1047 =over 2
1048
1049 Modifies the itemnumber in the aqorders_items table. The input hash needs three entities:
1050 - itemnumber: the old itemnumber
1051 - ordernumber: the order this item is attached to
1052 - newitemnumber: the new itemnumber we want to attach the line to
1053
1054 =back
1055
1056 =back
1057
1058 =cut
1059
1060 sub ModOrderItem {
1061     my $orderiteminfo = shift;
1062     if (! $orderiteminfo->{'ordernumber'} || ! $orderiteminfo->{'itemnumber'} || ! $orderiteminfo->{'newitemnumber'}){
1063         die "Ordernumber, itemnumber and newitemnumber is required";
1064     }
1065
1066     my $dbh = C4::Context->dbh;
1067
1068     my $query = "UPDATE aqorders_items set itemnumber=? where itemnumber=? and ordernumber=?";
1069     my @params = ($orderiteminfo->{'newitemnumber'}, $orderiteminfo->{'itemnumber'}, $orderiteminfo->{'ordernumber'});
1070     warn $query;
1071     warn Data::Dumper::Dumper(@params);
1072     my $sth = $dbh->prepare($query);
1073     $sth->execute(@params);
1074     return 0;
1075 }
1076
1077 #------------------------------------------------------------#
1078
1079
1080 =head3 ModOrderBibliotemNumber
1081
1082 =over 4
1083
1084 &ModOrderBiblioitemNumber($biblioitemnumber,$ordernumber, $biblionumber);
1085
1086 Modifies the biblioitemnumber for an existing order.
1087 Updates the order with order number C<$ordernum> and biblionumber C<$biblionumber>.
1088
1089 =back
1090
1091 =cut
1092
1093 #FIXME: is this used at all?
1094 sub ModOrderBiblioitemNumber {
1095     my ($biblioitemnumber,$ordernumber, $biblionumber) = @_;
1096     my $dbh = C4::Context->dbh;
1097     my $query = "
1098     UPDATE aqorders
1099     SET    biblioitemnumber = ?
1100     WHERE  ordernumber = ?
1101     AND biblionumber =  ?";
1102     my $sth = $dbh->prepare($query);
1103     $sth->execute( $biblioitemnumber, $ordernumber, $biblionumber );
1104 }
1105
1106 #------------------------------------------------------------#
1107
1108 =head3 ModReceiveOrder
1109
1110 =over 4
1111
1112 &ModReceiveOrder($biblionumber, $ordernumber, $quantityreceived, $user,
1113     $unitprice, $booksellerinvoicenumber, $biblioitemnumber,
1114     $freight, $bookfund, $rrp);
1115
1116 Updates an order, to reflect the fact that it was received, at least
1117 in part. All arguments not mentioned below update the fields with the
1118 same name in the aqorders table of the Koha database.
1119
1120 If a partial order is received, splits the order into two.  The received
1121 portion must have a booksellerinvoicenumber.
1122
1123 Updates the order with bibilionumber C<$biblionumber> and ordernumber
1124 C<$ordernumber>.
1125
1126 =back
1127
1128 =cut
1129
1130
1131 sub ModReceiveOrder {
1132     my (
1133         $biblionumber,    $ordernumber,  $quantrec, $user, $cost,
1134         $invoiceno, $freight, $rrp, $budget_id, $datereceived
1135     )
1136     = @_;
1137     my $dbh = C4::Context->dbh;
1138 #     warn "DATE BEFORE : $daterecieved";
1139 #    $daterecieved=POSIX::strftime("%Y-%m-%d",CORE::localtime) unless $daterecieved;
1140 #     warn "DATE REC : $daterecieved";
1141     $datereceived = C4::Dates->output('iso') unless $datereceived;
1142     my $suggestionid = GetSuggestionFromBiblionumber( $dbh, $biblionumber );
1143     if ($suggestionid) {
1144         ModSuggestion( {suggestionid=>$suggestionid,
1145                                                 STATUS=>'AVAILABLE',
1146                                                 biblionumber=> $biblionumber}
1147                                                 );
1148     }
1149
1150     my $sth=$dbh->prepare("
1151         SELECT * FROM   aqorders
1152         WHERE           biblionumber=? AND aqorders.ordernumber=?");
1153
1154     $sth->execute($biblionumber,$ordernumber);
1155     my $order = $sth->fetchrow_hashref();
1156     $sth->finish();
1157
1158     if ( $order->{quantity} > $quantrec ) {
1159         $sth=$dbh->prepare("
1160             UPDATE aqorders
1161             SET quantityreceived=?
1162                 , datereceived=?
1163                 , booksellerinvoicenumber=?
1164                 , unitprice=?
1165                 , freight=?
1166                 , rrp=?
1167                 , quantityreceived=?
1168             WHERE biblionumber=? AND ordernumber=?");
1169
1170         $sth->execute($quantrec,$datereceived,$invoiceno,$cost,$freight,$rrp,$quantrec,$biblionumber,$ordernumber);
1171         $sth->finish;
1172
1173         # create a new order for the remaining items, and set its bookfund.
1174         foreach my $orderkey ( "linenumber", "allocation" ) {
1175             delete($order->{'$orderkey'});
1176         }
1177         my $newOrder = NewOrder($order);
1178 } else {
1179         $sth=$dbh->prepare("update aqorders
1180                             set quantityreceived=?,datereceived=?,booksellerinvoicenumber=?,
1181                                 unitprice=?,freight=?,rrp=?
1182                             where biblionumber=? and ordernumber=?");
1183         $sth->execute($quantrec,$datereceived,$invoiceno,$cost,$freight,$rrp,$biblionumber,$ordernumber);
1184         $sth->finish;
1185     }
1186     return $datereceived;
1187 }
1188 #------------------------------------------------------------#
1189
1190 =head3 SearchOrder
1191
1192 @results = &SearchOrder($search, $biblionumber, $complete);
1193
1194 Searches for orders.
1195
1196 C<$search> may take one of several forms: if it is an ISBN,
1197 C<&ordersearch> returns orders with that ISBN. If C<$search> is an
1198 order number, C<&ordersearch> returns orders with that order number
1199 and biblionumber C<$biblionumber>. Otherwise, C<$search> is considered
1200 to be a space-separated list of search terms; in this case, all of the
1201 terms must appear in the title (matching the beginning of title
1202 words).
1203
1204 If C<$complete> is C<yes>, the results will include only completed
1205 orders. In any case, C<&ordersearch> ignores cancelled orders.
1206
1207 C<&ordersearch> returns an array.
1208 C<@results> is an array of references-to-hash with the following keys:
1209
1210 =over 4
1211
1212 =item C<author>
1213
1214 =item C<seriestitle>
1215
1216 =item C<branchcode>
1217
1218 =item C<bookfundid>
1219
1220 =back
1221
1222 =cut
1223
1224 sub SearchOrder {
1225 #### -------- SearchOrder-------------------------------
1226     my ($ordernumber, $search, $supplierid, $basket) = @_;
1227
1228     my $dbh = C4::Context->dbh;
1229     my @args = ();
1230     my $query =
1231             "SELECT *
1232             FROM aqorders
1233             LEFT JOIN biblio ON aqorders.biblionumber=biblio.biblionumber
1234             LEFT JOIN biblioitems ON biblioitems.biblionumber=biblio.biblionumber
1235             LEFT JOIN aqbasket ON aqorders.basketno = aqbasket.basketno
1236                 WHERE  (datecancellationprinted is NULL)";
1237
1238     if($ordernumber){
1239         $query .= " AND (aqorders.ordernumber=?)";
1240         push @args, $ordernumber;
1241     }
1242     if($search){
1243         $query .= " AND (biblio.title like ? OR biblio.author LIKE ? OR biblioitems.isbn like ?)";
1244         push @args, ("%$search%","%$search%","%$search%");
1245     }
1246     if($supplierid){
1247         $query .= "AND aqbasket.booksellerid = ?";
1248         push @args, $supplierid;
1249     }
1250     if($basket){
1251         $query .= "AND aqorders.basketno = ?";
1252         push @args, $basket;
1253     }
1254
1255     my $sth = $dbh->prepare($query);
1256     $sth->execute(@args);
1257     my $results = $sth->fetchall_arrayref({});
1258     $sth->finish;
1259     return $results;
1260 }
1261
1262 #------------------------------------------------------------#
1263
1264 =head3 DelOrder
1265
1266 =over 4
1267
1268 &DelOrder($biblionumber, $ordernumber);
1269
1270 Cancel the order with the given order and biblio numbers. It does not
1271 delete any entries in the aqorders table, it merely marks them as
1272 cancelled.
1273
1274 =back
1275
1276 =cut
1277
1278 sub DelOrder {
1279     my ( $bibnum, $ordernumber ) = @_;
1280     my $dbh = C4::Context->dbh;
1281     my $query = "
1282         UPDATE aqorders
1283         SET    datecancellationprinted=now()
1284         WHERE  biblionumber=? AND ordernumber=?
1285     ";
1286     my $sth = $dbh->prepare($query);
1287     $sth->execute( $bibnum, $ordernumber );
1288     $sth->finish;
1289 }
1290
1291 =head2 FUNCTIONS ABOUT PARCELS
1292
1293 =cut
1294
1295 #------------------------------------------------------------#
1296
1297 =head3 GetParcel
1298
1299 =over 4
1300
1301 @results = &GetParcel($booksellerid, $code, $date);
1302
1303 Looks up all of the received items from the supplier with the given
1304 bookseller ID at the given date, for the given code (bookseller Invoice number). Ignores cancelled and completed orders.
1305
1306 C<@results> is an array of references-to-hash. The keys of each element are fields from
1307 the aqorders, biblio, and biblioitems tables of the Koha database.
1308
1309 C<@results> is sorted alphabetically by book title.
1310
1311 =back
1312
1313 =cut
1314
1315 sub GetParcel {
1316     #gets all orders from a certain supplier, orders them alphabetically
1317     my ( $supplierid, $code, $datereceived ) = @_;
1318     my $dbh     = C4::Context->dbh;
1319     my @results = ();
1320     $code .= '%'
1321     if $code;  # add % if we search on a given code (otherwise, let him empty)
1322     my $strsth ="
1323         SELECT  authorisedby,
1324                 creationdate,
1325                 aqbasket.basketno,
1326                 closedate,surname,
1327                 firstname,
1328                 aqorders.biblionumber,
1329                 aqorders.ordernumber,
1330                 aqorders.quantity,
1331                 aqorders.quantityreceived,
1332                 aqorders.unitprice,
1333                 aqorders.listprice,
1334                 aqorders.rrp,
1335                 aqorders.ecost,
1336                 biblio.title
1337         FROM aqorders
1338         LEFT JOIN aqbasket ON aqbasket.basketno=aqorders.basketno
1339         LEFT JOIN borrowers ON aqbasket.authorisedby=borrowers.borrowernumber
1340         LEFT JOIN biblio ON aqorders.biblionumber=biblio.biblionumber
1341         WHERE
1342             aqbasket.booksellerid = ?
1343             AND aqorders.booksellerinvoicenumber LIKE ?
1344             AND aqorders.datereceived = ? ";
1345
1346     my @query_params = ( $supplierid, $code, $datereceived );
1347     if ( C4::Context->preference("IndependantBranches") ) {
1348         my $userenv = C4::Context->userenv;
1349         if ( ($userenv) && ( $userenv->{flags} != 1 ) ) {
1350             $strsth .= " and (borrowers.branchcode = ?
1351                         or borrowers.branchcode  = '')";
1352             push @query_params, $userenv->{branch};
1353         }
1354     }
1355     $strsth .= " ORDER BY aqbasket.basketno";
1356     # ## parcelinformation : $strsth
1357     my $sth = $dbh->prepare($strsth);
1358     $sth->execute( @query_params );
1359     while ( my $data = $sth->fetchrow_hashref ) {
1360         push( @results, $data );
1361     }
1362     # ## countparcelbiblio: scalar(@results)
1363     $sth->finish;
1364
1365     return @results;
1366 }
1367
1368 #------------------------------------------------------------#
1369
1370 =head3 GetParcels
1371
1372 =over 4
1373
1374 $results = &GetParcels($bookseller, $order, $code, $datefrom, $dateto);
1375 get a lists of parcels.
1376
1377 =back
1378
1379 * Input arg :
1380
1381 =over 4
1382
1383 =item $bookseller
1384 is the bookseller this function has to get parcels.
1385
1386 =item $order
1387 To know on what criteria the results list has to be ordered.
1388
1389 =item $code
1390 is the booksellerinvoicenumber.
1391
1392 =item $datefrom & $dateto
1393 to know on what date this function has to filter its search.
1394
1395 * return:
1396 a pointer on a hash list containing parcel informations as such :
1397
1398 =item Creation date
1399
1400 =item Last operation
1401
1402 =item Number of biblio
1403
1404 =item Number of items
1405
1406 =back
1407
1408 =cut
1409
1410 sub GetParcels {
1411     my ($bookseller,$order, $code, $datefrom, $dateto) = @_;
1412     my $dbh    = C4::Context->dbh;
1413     my @query_params = ();
1414     my $strsth ="
1415         SELECT  aqorders.booksellerinvoicenumber,
1416                 datereceived,purchaseordernumber,
1417                 count(DISTINCT biblionumber) AS biblio,
1418                 sum(quantity) AS itemsexpected,
1419                 sum(quantityreceived) AS itemsreceived
1420         FROM   aqorders LEFT JOIN aqbasket ON aqbasket.basketno = aqorders.basketno
1421         WHERE aqbasket.booksellerid = $bookseller and datereceived IS NOT NULL
1422     ";
1423
1424     if ( defined $code ) {
1425         $strsth .= ' and aqorders.booksellerinvoicenumber like ? ';
1426         # add a % to the end of the code to allow stemming.
1427         push @query_params, "$code%";
1428     }
1429
1430     if ( defined $datefrom ) {
1431         $strsth .= ' and datereceived >= ? ';
1432         push @query_params, $datefrom;
1433     }
1434
1435     if ( defined $dateto ) {
1436         $strsth .=  'and datereceived <= ? ';
1437         push @query_params, $dateto;
1438     }
1439
1440     $strsth .= "group by aqorders.booksellerinvoicenumber,datereceived ";
1441
1442     # can't use a placeholder to place this column name.
1443     # but, we could probably be checking to make sure it is a column that will be fetched.
1444     $strsth .= "order by $order " if ($order);
1445
1446     my $sth = $dbh->prepare($strsth);
1447
1448     $sth->execute( @query_params );
1449     my $results = $sth->fetchall_arrayref({});
1450     $sth->finish;
1451     return @$results;
1452 }
1453
1454 #------------------------------------------------------------#
1455
1456 =head3 GetLateOrders
1457
1458 =over 4
1459
1460 @results = &GetLateOrders;
1461
1462 Searches for bookseller with late orders.
1463
1464 return:
1465 the table of supplier with late issues. This table is full of hashref.
1466
1467 =back
1468
1469 =cut
1470
1471 sub GetLateOrders {
1472     my $delay      = shift;
1473     my $supplierid = shift;
1474     my $branch     = shift;
1475
1476     my $dbh = C4::Context->dbh;
1477
1478     #BEWARE, order of parenthesis and LEFT JOIN is important for speed
1479     my $dbdriver = C4::Context->config("db_scheme") || "mysql";
1480
1481     my @query_params = ($delay);        # delay is the first argument regardless
1482     my $select = "
1483     SELECT aqbasket.basketno,
1484         aqorders.ordernumber,
1485         DATE(aqbasket.closedate)  AS orderdate,
1486         aqorders.rrp              AS unitpricesupplier,
1487         aqorders.ecost            AS unitpricelib,
1488         aqbudgets.budget_name     AS budget,
1489         borrowers.branchcode      AS branch,
1490         aqbooksellers.name        AS supplier,
1491         biblio.author,
1492         biblioitems.publishercode AS publisher,
1493         biblioitems.publicationyear,
1494     ";
1495     my $from = "
1496     FROM
1497         aqorders LEFT JOIN biblio     ON biblio.biblionumber         = aqorders.biblionumber
1498         LEFT JOIN biblioitems         ON biblioitems.biblionumber    = biblio.biblionumber
1499         LEFT JOIN aqbudgets           ON aqorders.budget_id          = aqbudgets.budget_id,
1500         aqbasket LEFT JOIN borrowers  ON aqbasket.authorisedby       = borrowers.borrowernumber
1501         LEFT JOIN aqbooksellers       ON aqbasket.booksellerid       = aqbooksellers.id
1502         WHERE aqorders.basketno = aqbasket.basketno
1503         AND ( datereceived = ''
1504             OR datereceived IS NULL
1505             OR aqorders.quantityreceived < aqorders.quantity
1506         )
1507     ";
1508     my $having = "";
1509     if ($dbdriver eq "mysql") {
1510         $select .= "
1511         aqorders.quantity - IFNULL(aqorders.quantityreceived,0)                 AS quantity,
1512         (aqorders.quantity - IFNULL(aqorders.quantityreceived,0)) * aqorders.rrp AS subtotal,
1513         DATEDIFF(CURDATE( ),closedate) AS latesince
1514         ";
1515         $from .= " AND (closedate <= DATE_SUB(CURDATE( ),INTERVAL ? DAY)) ";
1516         $having = "
1517         HAVING quantity          <> 0
1518             AND unitpricesupplier <> 0
1519             AND unitpricelib      <> 0
1520         ";
1521     } else {
1522         # FIXME: account for IFNULL as above
1523         $select .= "
1524                 aqorders.quantity                AS quantity,
1525                 aqorders.quantity * aqorders.rrp AS subtotal,
1526                 (CURDATE - closedate)            AS latesince
1527         ";
1528         $from .= " AND (closedate <= (CURDATE -(INTERVAL ? DAY)) ";
1529     }
1530     if (defined $supplierid) {
1531         $from .= ' AND aqbasket.booksellerid = ? ';
1532         push @query_params, $supplierid;
1533     }
1534     if (defined $branch) {
1535         $from .= ' AND borrowers.branchcode LIKE ? ';
1536         push @query_params, $branch;
1537     }
1538     if (C4::Context->preference("IndependantBranches")
1539             && C4::Context->userenv
1540             && C4::Context->userenv->{flags} != 1 ) {
1541         $from .= ' AND borrowers.branchcode LIKE ? ';
1542         push @query_params, C4::Context->userenv->{branch};
1543     }
1544     my $query = "$select $from $having\nORDER BY latesince, basketno, borrowers.branchcode, supplier";
1545     $debug and print STDERR "GetLateOrders query: $query\nGetLateOrders args: " . join(" ",@query_params);
1546     my $sth = $dbh->prepare($query);
1547     $sth->execute(@query_params);
1548     my @results;
1549     while (my $data = $sth->fetchrow_hashref) {
1550         $data->{orderdate} = format_date($data->{orderdate});
1551         push @results, $data;
1552     }
1553     return @results;
1554 }
1555
1556 #------------------------------------------------------------#
1557
1558 =head3 GetHistory
1559
1560 =over 4
1561
1562 (\@order_loop, $total_qty, $total_price, $total_qtyreceived) = GetHistory( $title, $author, $name, $from_placed_on, $to_placed_on );
1563
1564 Retreives some acquisition history information
1565
1566 returns:
1567     $order_loop is a list of hashrefs that each look like this:
1568             {
1569                 'author'           => 'Twain, Mark',
1570                 'basketno'         => '1',
1571                 'biblionumber'     => '215',
1572                 'count'            => 1,
1573                 'creationdate'     => 'MM/DD/YYYY',
1574                 'datereceived'     => undef,
1575                 'ecost'            => '1.00',
1576                 'id'               => '1',
1577                 'invoicenumber'    => undef,
1578                 'name'             => '',
1579                 'ordernumber'      => '1',
1580                 'quantity'         => 1,
1581                 'quantityreceived' => undef,
1582                 'title'            => 'The Adventures of Huckleberry Finn'
1583             }
1584     $total_qty is the sum of all of the quantities in $order_loop
1585     $total_price is the cost of each in $order_loop times the quantity
1586     $total_qtyreceived is the sum of all of the quantityreceived entries in $order_loop
1587
1588 =back
1589
1590 =cut
1591
1592 sub GetHistory {
1593     my ( $title, $author, $name, $from_placed_on, $to_placed_on ) = @_;
1594     my @order_loop;
1595     my $total_qty         = 0;
1596     my $total_qtyreceived = 0;
1597     my $total_price       = 0;
1598
1599 # don't run the query if there are no parameters (list would be too long for sure !)
1600     if ( $title || $author || $name || $from_placed_on || $to_placed_on ) {
1601         my $dbh   = C4::Context->dbh;
1602         my $query ="
1603             SELECT
1604                 biblio.title,
1605                 biblio.author,
1606                 aqorders.basketno,
1607                 name,aqbasket.creationdate,
1608                 aqorders.datereceived,
1609                 aqorders.quantity,
1610                 aqorders.quantityreceived,
1611                 aqorders.ecost,
1612                 aqorders.ordernumber,
1613                 aqorders.booksellerinvoicenumber as invoicenumber,
1614                 aqbooksellers.id as id,
1615                 aqorders.biblionumber
1616             FROM aqorders
1617             LEFT JOIN aqbasket ON aqorders.basketno=aqbasket.basketno
1618             LEFT JOIN aqbooksellers ON aqbasket.booksellerid=aqbooksellers.id
1619             LEFT JOIN biblio ON biblio.biblionumber=aqorders.biblionumber";
1620
1621         $query .= " LEFT JOIN borrowers ON aqbasket.authorisedby=borrowers.borrowernumber"
1622         if ( C4::Context->preference("IndependantBranches") );
1623
1624         $query .= " WHERE (datecancellationprinted is NULL or datecancellationprinted='0000-00-00') ";
1625
1626         my @query_params  = ();
1627
1628         if ( defined $title ) {
1629             $query .= " AND biblio.title LIKE ? ";
1630             push @query_params, "%$title%";
1631         }
1632
1633         if ( defined $author ) {
1634             $query .= " AND biblio.author LIKE ? ";
1635             push @query_params, "%$author%";
1636         }
1637
1638         if ( defined $name ) {
1639             $query .= " AND name LIKE ? ";
1640             push @query_params, "%$name%";
1641         }
1642
1643         if ( defined $from_placed_on ) {
1644             $query .= " AND creationdate >= ? ";
1645             push @query_params, $from_placed_on;
1646         }
1647
1648         if ( defined $to_placed_on ) {
1649             $query .= " AND creationdate <= ? ";
1650             push @query_params, $to_placed_on;
1651         }
1652
1653         if ( C4::Context->preference("IndependantBranches") ) {
1654             my $userenv = C4::Context->userenv;
1655             if ( ($userenv) && ( $userenv->{flags} != 1 ) ) {
1656                 $query .= " AND (borrowers.branchcode = ? OR borrowers.branchcode ='' ) ";
1657                 push @query_params, $userenv->{branch};
1658             }
1659         }
1660         $query .= " ORDER BY booksellerid";
1661         my $sth = $dbh->prepare($query);
1662         $sth->execute( @query_params );
1663         my $cnt = 1;
1664         while ( my $line = $sth->fetchrow_hashref ) {
1665             $line->{count} = $cnt++;
1666             $line->{toggle} = 1 if $cnt % 2;
1667             push @order_loop, $line;
1668             $line->{creationdate} = format_date( $line->{creationdate} );
1669             $line->{datereceived} = format_date( $line->{datereceived} );
1670             $total_qty         += $line->{'quantity'};
1671             $total_qtyreceived += $line->{'quantityreceived'};
1672             $total_price       += $line->{'quantity'} * $line->{'ecost'};
1673         }
1674     }
1675     return \@order_loop, $total_qty, $total_price, $total_qtyreceived;
1676 }
1677
1678 =head2 GetRecentAcqui
1679
1680 $results = GetRecentAcqui($days);
1681
1682 C<$results> is a ref to a table which containts hashref
1683
1684 =cut
1685
1686 sub GetRecentAcqui {
1687     my $limit  = shift;
1688     my $dbh    = C4::Context->dbh;
1689     my $query = "
1690         SELECT *
1691         FROM   biblio
1692         ORDER BY timestamp DESC
1693         LIMIT  0,".$limit;
1694
1695     my $sth = $dbh->prepare($query);
1696     $sth->execute;
1697     my $results = $sth->fetchall_arrayref({});
1698     return $results;
1699 }
1700
1701 =head3 GetContracts
1702
1703 =over 4
1704
1705 $contractlist = &GetContracts($booksellerid, $activeonly);
1706
1707 Looks up the contracts that belong to a bookseller
1708
1709 Returns a list of contracts
1710
1711 =item C<$booksellerid> is the "id" field in the "aqbooksellers" table.
1712
1713 =item C<$activeonly> if exists get only contracts that are still active.
1714
1715 =back
1716
1717 =cut
1718 sub GetContracts {
1719     my ( $booksellerid, $activeonly ) = @_;
1720     my $dbh = C4::Context->dbh;
1721     my $query;
1722     if (! $activeonly) {
1723         $query = "
1724             SELECT *
1725             FROM   aqcontract
1726             WHERE  booksellerid=?
1727         ";
1728     } else {
1729         $query = "SELECT *
1730             FROM aqcontract
1731             WHERE booksellerid=?
1732                 AND contractenddate >= CURDATE( )";
1733     }
1734     my $sth = $dbh->prepare($query);
1735     $sth->execute( $booksellerid );
1736     my @results;
1737     while (my $data = $sth->fetchrow_hashref ) {
1738         push(@results, $data);
1739     }
1740     $sth->finish;
1741     return @results;
1742 }
1743
1744 #------------------------------------------------------------#
1745
1746 =head3 GetContract
1747
1748 =over 4
1749
1750 $contract = &GetContract($contractID);
1751
1752 Looks up the contract that has PRIMKEY (contractnumber) value $contractID
1753
1754 Returns a contract
1755
1756 =back
1757
1758 =cut
1759 sub GetContract {
1760     my ( $contractno ) = @_;
1761     my $dbh = C4::Context->dbh;
1762     my $query = "
1763         SELECT *
1764         FROM   aqcontract
1765         WHERE  contractnumber=?
1766         ";
1767
1768     my $sth = $dbh->prepare($query);
1769     $sth->execute( $contractno );
1770     my $result = $sth->fetchrow_hashref;
1771     return $result;
1772 }
1773
1774 1;
1775 __END__
1776
1777 =head1 AUTHOR
1778
1779 Koha Developement team <info@koha.org>
1780
1781 =cut