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