1 package C4::Acquisition;
3 # Copyright 2000-2002 Katipo Communications
5 # This file is part of Koha.
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
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.
16 # You should have received a copy of the GNU General Public License along
17 # with Koha; if not, write to the Free Software Foundation, Inc.,
18 # 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301 USA.
26 use C4::Dates qw(format_date format_date_in_iso);
31 use C4::SQLHelper qw(InsertInTable);
32 use C4::Bookseller qw(GetBookSellerFromId);
33 use C4::Templates qw(gettemplate);
38 use vars qw($VERSION @ISA @EXPORT);
41 # set the version for version checking
42 $VERSION = 3.07.00.049;
46 &GetBasket &NewBasket &CloseBasket &DelBasket &ModBasket
47 &GetBasketAsCSV &GetBasketGroupAsCSV
48 &GetBasketsByBookseller &GetBasketsByBasketgroup
49 &GetBasketsInfosByBookseller
53 &ModBasketgroup &NewBasketgroup &DelBasketgroup &GetBasketgroup &CloseBasketgroup
54 &GetBasketgroups &ReOpenBasketgroup
56 &NewOrder &DelOrder &ModOrder &GetPendingOrders &GetOrder &GetOrders &GetOrdersByBiblionumber
57 &GetOrderNumber &GetLateOrders &GetOrderFromItemnumber
58 &SearchOrder &GetHistory &GetRecentAcqui
59 &ModReceiveOrder &CancelReceipt &ModOrderBiblioitemNumber
61 &GetLastOrderNotReceivedFromSubscriptionid &GetLastOrderReceivedFromSubscriptionid
62 &NewOrderItem &ModOrderItem &ModItemOrder
64 &GetParcels &GetParcel
65 &GetContracts &GetContract
75 &GetItemnumbersFromOrder
85 sub GetOrderFromItemnumber {
86 my ($itemnumber) = @_;
87 my $dbh = C4::Context->dbh;
90 SELECT * from aqorders LEFT JOIN aqorders_items
91 ON ( aqorders.ordernumber = aqorders_items.ordernumber )
92 WHERE itemnumber = ? |;
94 my $sth = $dbh->prepare($query);
98 $sth->execute($itemnumber);
100 my $order = $sth->fetchrow_hashref;
105 # Returns the itemnumber(s) associated with the ordernumber given in parameter
106 sub GetItemnumbersFromOrder {
107 my ($ordernumber) = @_;
108 my $dbh = C4::Context->dbh;
109 my $query = "SELECT itemnumber FROM aqorders_items WHERE ordernumber=?";
110 my $sth = $dbh->prepare($query);
111 $sth->execute($ordernumber);
114 while (my $order = $sth->fetchrow_hashref) {
115 push @tab, $order->{'itemnumber'};
129 C4::Acquisition - Koha functions for dealing with orders and acquisitions
137 The functions in this module deal with acquisitions, managing book
138 orders, basket and parcels.
142 =head2 FUNCTIONS ABOUT BASKETS
146 $aqbasket = &GetBasket($basketnumber);
148 get all basket informations in aqbasket for a given basket
150 B<returns:> informations for a given basket returned as a hashref.
156 my $dbh = C4::Context->dbh;
159 concat( b.firstname,' ',b.surname) AS authorisedbyname,
160 b.branchcode AS branch
162 LEFT JOIN borrowers b ON aqbasket.authorisedby=b.borrowernumber
165 my $sth=$dbh->prepare($query);
166 $sth->execute($basketno);
167 my $basket = $sth->fetchrow_hashref;
171 #------------------------------------------------------------#
175 $basket = &NewBasket( $booksellerid, $authorizedby, $basketname,
176 $basketnote, $basketbooksellernote, $basketcontractnumber, $deliveryplace, $billingplace );
178 Create a new basket in aqbasket table
182 =item C<$booksellerid> is a foreign key in the aqbasket table
184 =item C<$authorizedby> is the username of who created the basket
188 The other parameters are optional, see ModBasketHeader for more info on them.
193 my ( $booksellerid, $authorisedby, $basketname, $basketnote,
194 $basketbooksellernote, $basketcontractnumber, $deliveryplace,
195 $billingplace ) = @_;
196 my $dbh = C4::Context->dbh;
198 'INSERT INTO aqbasket (creationdate,booksellerid,authorisedby) '
199 . 'VALUES (now(),?,?)';
200 $dbh->do( $query, {}, $booksellerid, $authorisedby );
202 my $basket = $dbh->{mysql_insertid};
203 $basketname ||= q{}; # default to empty strings
205 $basketbooksellernote ||= q{};
206 ModBasketHeader( $basket, $basketname, $basketnote, $basketbooksellernote,
207 $basketcontractnumber, $booksellerid, $deliveryplace, $billingplace );
211 #------------------------------------------------------------#
215 &CloseBasket($basketno);
217 close a basket (becomes unmodifiable,except for recieves)
223 my $dbh = C4::Context->dbh;
229 my $sth = $dbh->prepare($query);
230 $sth->execute($basketno);
233 #------------------------------------------------------------#
235 =head3 GetBasketAsCSV
237 &GetBasketAsCSV($basketno);
239 Export a basket as CSV
241 $cgi parameter is needed for column name translation
246 my ($basketno, $cgi) = @_;
247 my $basket = GetBasket($basketno);
248 my @orders = GetOrders($basketno);
249 my $contract = GetContract($basket->{'contractnumber'});
251 my $template = C4::Templates::gettemplate("acqui/csv/basket.tmpl", "intranet", $cgi);
254 foreach my $order (@orders) {
255 my $bd = GetBiblioData( $order->{'biblionumber'} );
257 contractname => $contract->{'contractname'},
258 ordernumber => $order->{'ordernumber'},
259 entrydate => $order->{'entrydate'},
260 isbn => $order->{'isbn'},
261 author => $bd->{'author'},
262 title => $bd->{'title'},
263 publicationyear => $bd->{'publicationyear'},
264 publishercode => $bd->{'publishercode'},
265 collectiontitle => $bd->{'collectiontitle'},
266 notes => $order->{'notes'},
267 quantity => $order->{'quantity'},
268 rrp => $order->{'rrp'},
269 deliveryplace => C4::Branch::GetBranchName( $basket->{'deliveryplace'} ),
270 billingplace => C4::Branch::GetBranchName( $basket->{'billingplace'} ),
273 contractname author title publishercode collectiontitle notes
274 deliveryplace billingplace
276 # Double the quotes to not be interpreted as a field end
277 $row->{$_} =~ s/"/""/g if $row->{$_};
283 if(defined $a->{publishercode} and defined $b->{publishercode}) {
284 $a->{publishercode} cmp $b->{publishercode};
288 $template->param(rows => \@rows);
290 return $template->output;
294 =head3 GetBasketGroupAsCSV
298 &GetBasketGroupAsCSV($basketgroupid);
300 Export a basket group as CSV
302 $cgi parameter is needed for column name translation
308 sub GetBasketGroupAsCSV {
309 my ($basketgroupid, $cgi) = @_;
310 my $baskets = GetBasketsByBasketgroup($basketgroupid);
312 my $template = C4::Templates::gettemplate('acqui/csv/basketgroup.tmpl', 'intranet', $cgi);
315 for my $basket (@$baskets) {
316 my @orders = GetOrders( $$basket{basketno} );
317 my $contract = GetContract( $$basket{contractnumber} );
318 my $bookseller = GetBookSellerFromId( $$basket{booksellerid} );
319 my $basketgroup = GetBasketgroup( $$basket{basketgroupid} );
321 foreach my $order (@orders) {
322 my $bd = GetBiblioData( $order->{'biblionumber'} );
324 clientnumber => $bookseller->{accountnumber},
325 basketname => $basket->{basketname},
326 ordernumber => $order->{ordernumber},
327 author => $bd->{author},
328 title => $bd->{title},
329 publishercode => $bd->{publishercode},
330 publicationyear => $bd->{publicationyear},
331 collectiontitle => $bd->{collectiontitle},
332 isbn => $order->{isbn},
333 quantity => $order->{quantity},
334 rrp => $order->{rrp},
335 discount => $bookseller->{discount},
336 ecost => $order->{ecost},
337 notes => $order->{notes},
338 entrydate => $order->{entrydate},
339 booksellername => $bookseller->{name},
340 bookselleraddress => $bookseller->{address1},
341 booksellerpostal => $bookseller->{postal},
342 contractnumber => $contract->{contractnumber},
343 contractname => $contract->{contractname},
344 basketgroupdeliveryplace => C4::Branch::GetBranchName( $basketgroup->{deliveryplace} ),
345 basketgroupbillingplace => C4::Branch::GetBranchName( $basketgroup->{billingplace} ),
346 basketdeliveryplace => C4::Branch::GetBranchName( $basket->{deliveryplace} ),
347 basketbillingplace => C4::Branch::GetBranchName( $basket->{billingplace} ),
350 basketname author title publishercode collectiontitle notes
351 booksellername bookselleraddress booksellerpostal contractname
352 basketgroupdeliveryplace basketgroupbillingplace
353 basketdeliveryplace basketbillingplace
355 # Double the quotes to not be interpreted as a field end
356 $row->{$_} =~ s/"/""/g if $row->{$_};
361 $template->param(rows => \@rows);
363 return $template->output;
367 =head3 CloseBasketgroup
369 &CloseBasketgroup($basketgroupno);
375 sub CloseBasketgroup {
376 my ($basketgroupno) = @_;
377 my $dbh = C4::Context->dbh;
378 my $sth = $dbh->prepare("
379 UPDATE aqbasketgroups
383 $sth->execute($basketgroupno);
386 #------------------------------------------------------------#
388 =head3 ReOpenBaskergroup($basketgroupno)
390 &ReOpenBaskergroup($basketgroupno);
396 sub ReOpenBasketgroup {
397 my ($basketgroupno) = @_;
398 my $dbh = C4::Context->dbh;
399 my $sth = $dbh->prepare("
400 UPDATE aqbasketgroups
404 $sth->execute($basketgroupno);
407 #------------------------------------------------------------#
412 &DelBasket($basketno);
414 Deletes the basket that has basketno field $basketno in the aqbasket table.
418 =item C<$basketno> is the primary key of the basket in the aqbasket table.
425 my ( $basketno ) = @_;
426 my $query = "DELETE FROM aqbasket WHERE basketno=?";
427 my $dbh = C4::Context->dbh;
428 my $sth = $dbh->prepare($query);
429 $sth->execute($basketno);
433 #------------------------------------------------------------#
437 &ModBasket($basketinfo);
439 Modifies a basket, using a hashref $basketinfo for the relevant information, only $basketinfo->{'basketno'} is required.
443 =item C<$basketno> is the primary key of the basket in the aqbasket table.
450 my $basketinfo = shift;
451 my $query = "UPDATE aqbasket SET ";
453 foreach my $key (keys %$basketinfo){
454 if ($key ne 'basketno'){
455 $query .= "$key=?, ";
456 push(@params, $basketinfo->{$key} || undef );
459 # get rid of the "," at the end of $query
460 if (substr($query, length($query)-2) eq ', '){
465 $query .= "WHERE basketno=?";
466 push(@params, $basketinfo->{'basketno'});
467 my $dbh = C4::Context->dbh;
468 my $sth = $dbh->prepare($query);
469 $sth->execute(@params);
473 #------------------------------------------------------------#
475 =head3 ModBasketHeader
477 &ModBasketHeader($basketno, $basketname, $note, $booksellernote, $contractnumber, $booksellerid);
479 Modifies a basket's header.
483 =item C<$basketno> is the "basketno" field in the "aqbasket" table;
485 =item C<$basketname> is the "basketname" field in the "aqbasket" table;
487 =item C<$note> is the "note" field in the "aqbasket" table;
489 =item C<$booksellernote> is the "booksellernote" field in the "aqbasket" table;
491 =item C<$contractnumber> is the "contractnumber" (foreign) key in the "aqbasket" table.
493 =item C<$booksellerid> is the id (foreign) key in the "aqbooksellers" table for the vendor.
495 =item C<$deliveryplace> is the "deliveryplace" field in the aqbasket table.
497 =item C<$billingplace> is the "billingplace" field in the aqbasket table.
503 sub ModBasketHeader {
504 my ($basketno, $basketname, $note, $booksellernote, $contractnumber, $booksellerid, $deliveryplace, $billingplace) = @_;
507 SET basketname=?, note=?, booksellernote=?, booksellerid=?, deliveryplace=?, billingplace=?
511 my $dbh = C4::Context->dbh;
512 my $sth = $dbh->prepare($query);
513 $sth->execute($basketname, $note, $booksellernote, $booksellerid, $deliveryplace, $billingplace, $basketno);
515 if ( $contractnumber ) {
516 my $query2 ="UPDATE aqbasket SET contractnumber=? WHERE basketno=?";
517 my $sth2 = $dbh->prepare($query2);
518 $sth2->execute($contractnumber,$basketno);
524 #------------------------------------------------------------#
526 =head3 GetBasketsByBookseller
528 @results = &GetBasketsByBookseller($booksellerid, $extra);
530 Returns a list of hashes of all the baskets that belong to bookseller 'booksellerid'.
534 =item C<$booksellerid> is the 'id' field of the bookseller in the aqbooksellers table
536 =item C<$extra> is the extra sql parameters, can be
538 $extra->{groupby}: group baskets by column
539 ex. $extra->{groupby} = aqbasket.basketgroupid
540 $extra->{orderby}: order baskets by column
541 $extra->{limit}: limit number of results (can be helpful for pagination)
547 sub GetBasketsByBookseller {
548 my ($booksellerid, $extra) = @_;
549 my $query = "SELECT * FROM aqbasket WHERE booksellerid=?";
551 if ($extra->{groupby}) {
552 $query .= " GROUP by $extra->{groupby}";
554 if ($extra->{orderby}){
555 $query .= " ORDER by $extra->{orderby}";
557 if ($extra->{limit}){
558 $query .= " LIMIT $extra->{limit}";
561 my $dbh = C4::Context->dbh;
562 my $sth = $dbh->prepare($query);
563 $sth->execute($booksellerid);
564 my $results = $sth->fetchall_arrayref({});
569 =head3 GetBasketsInfosByBookseller
571 my $baskets = GetBasketsInfosByBookseller($supplierid, $allbaskets);
573 The optional second parameter allbaskets is a boolean allowing you to
574 select all baskets from the supplier; by default only active baskets (open or
575 closed but still something to receive) are returned.
577 Returns in a arrayref of hashref all about booksellers baskets, plus:
578 total_biblios: Number of distinct biblios in basket
579 total_items: Number of items in basket
580 expected_items: Number of non-received items in basket
584 sub GetBasketsInfosByBookseller {
585 my ($supplierid, $allbaskets) = @_;
587 return unless $supplierid;
589 my $dbh = C4::Context->dbh;
592 SUM(aqorders.quantity) AS total_items,
593 COUNT(DISTINCT aqorders.biblionumber) AS total_biblios,
595 IF(aqorders.datereceived IS NULL
596 AND aqorders.datecancellationprinted IS NULL
601 LEFT JOIN aqorders ON aqorders.basketno = aqbasket.basketno
602 WHERE booksellerid = ?};
604 $query.=" AND (closedate IS NULL OR (aqorders.quantity > aqorders.quantityreceived AND datecancellationprinted IS NULL))";
606 $query.=" GROUP BY aqbasket.basketno";
608 my $sth = $dbh->prepare($query);
609 $sth->execute($supplierid);
610 return $sth->fetchall_arrayref({});
614 #------------------------------------------------------------#
616 =head3 GetBasketsByBasketgroup
618 $baskets = &GetBasketsByBasketgroup($basketgroupid);
620 Returns a reference to all baskets that belong to basketgroup $basketgroupid.
624 sub GetBasketsByBasketgroup {
625 my $basketgroupid = shift;
627 SELECT *, aqbasket.booksellerid as booksellerid
629 LEFT JOIN aqcontract USING(contractnumber) WHERE basketgroupid=?
631 my $dbh = C4::Context->dbh;
632 my $sth = $dbh->prepare($query);
633 $sth->execute($basketgroupid);
634 my $results = $sth->fetchall_arrayref({});
639 #------------------------------------------------------------#
641 =head3 NewBasketgroup
643 $basketgroupid = NewBasketgroup(\%hashref);
645 Adds a basketgroup to the aqbasketgroups table, and add the initial baskets to it.
647 $hashref->{'booksellerid'} is the 'id' field of the bookseller in the aqbooksellers table,
649 $hashref->{'name'} is the 'name' field of the basketgroup in the aqbasketgroups table,
651 $hashref->{'basketlist'} is a list reference of the 'id's of the baskets that belong to this group,
653 $hashref->{'billingplace'} is the 'billingplace' field of the basketgroup in the aqbasketgroups table,
655 $hashref->{'deliveryplace'} is the 'deliveryplace' field of the basketgroup in the aqbasketgroups table,
657 $hashref->{'freedeliveryplace'} is the 'freedeliveryplace' field of the basketgroup in the aqbasketgroups table,
659 $hashref->{'deliverycomment'} is the 'deliverycomment' field of the basketgroup in the aqbasketgroups table,
661 $hashref->{'closed'} is the 'closed' field of the aqbasketgroups table, it is false if 0, true otherwise.
666 my $basketgroupinfo = shift;
667 die "booksellerid is required to create a basketgroup" unless $basketgroupinfo->{'booksellerid'};
668 my $query = "INSERT INTO aqbasketgroups (";
670 foreach my $field (qw(name billingplace deliveryplace freedeliveryplace deliverycomment closed)) {
671 if ( defined $basketgroupinfo->{$field} ) {
672 $query .= "$field, ";
673 push(@params, $basketgroupinfo->{$field});
676 $query .= "booksellerid) VALUES (";
681 push(@params, $basketgroupinfo->{'booksellerid'});
682 my $dbh = C4::Context->dbh;
683 my $sth = $dbh->prepare($query);
684 $sth->execute(@params);
685 my $basketgroupid = $dbh->{'mysql_insertid'};
686 if( $basketgroupinfo->{'basketlist'} ) {
687 foreach my $basketno (@{$basketgroupinfo->{'basketlist'}}) {
688 my $query2 = "UPDATE aqbasket SET basketgroupid=? WHERE basketno=?";
689 my $sth2 = $dbh->prepare($query2);
690 $sth2->execute($basketgroupid, $basketno);
693 return $basketgroupid;
696 #------------------------------------------------------------#
698 =head3 ModBasketgroup
700 ModBasketgroup(\%hashref);
702 Modifies a basketgroup in the aqbasketgroups table, and add the baskets to it.
704 $hashref->{'id'} is the 'id' field of the basketgroup in the aqbasketgroup table, this parameter is mandatory,
706 $hashref->{'name'} is the 'name' field of the basketgroup in the aqbasketgroups table,
708 $hashref->{'basketlist'} is a list reference of the 'id's of the baskets that belong to this group,
710 $hashref->{'billingplace'} is the 'billingplace' field of the basketgroup in the aqbasketgroups table,
712 $hashref->{'deliveryplace'} is the 'deliveryplace' field of the basketgroup in the aqbasketgroups table,
714 $hashref->{'freedeliveryplace'} is the 'freedeliveryplace' field of the basketgroup in the aqbasketgroups table,
716 $hashref->{'deliverycomment'} is the 'deliverycomment' field of the basketgroup in the aqbasketgroups table,
718 $hashref->{'closed'} is the 'closed' field of the aqbasketgroups table, it is false if 0, true otherwise.
723 my $basketgroupinfo = shift;
724 die "basketgroup id is required to edit a basketgroup" unless $basketgroupinfo->{'id'};
725 my $dbh = C4::Context->dbh;
726 my $query = "UPDATE aqbasketgroups SET ";
728 foreach my $field (qw(name billingplace deliveryplace freedeliveryplace deliverycomment closed)) {
729 if ( defined $basketgroupinfo->{$field} ) {
730 $query .= "$field=?, ";
731 push(@params, $basketgroupinfo->{$field});
736 $query .= " WHERE id=?";
737 push(@params, $basketgroupinfo->{'id'});
738 my $sth = $dbh->prepare($query);
739 $sth->execute(@params);
741 $sth = $dbh->prepare('UPDATE aqbasket SET basketgroupid = NULL WHERE basketgroupid = ?');
742 $sth->execute($basketgroupinfo->{'id'});
744 if($basketgroupinfo->{'basketlist'} && @{$basketgroupinfo->{'basketlist'}}){
745 $sth = $dbh->prepare("UPDATE aqbasket SET basketgroupid=? WHERE basketno=?");
746 foreach my $basketno (@{$basketgroupinfo->{'basketlist'}}) {
747 $sth->execute($basketgroupinfo->{'id'}, $basketno);
754 #------------------------------------------------------------#
756 =head3 DelBasketgroup
758 DelBasketgroup($basketgroupid);
760 Deletes a basketgroup in the aqbasketgroups table, and removes the reference to it from the baskets,
764 =item C<$basketgroupid> is the 'id' field of the basket in the aqbasketgroup table
771 my $basketgroupid = shift;
772 die "basketgroup id is required to edit a basketgroup" unless $basketgroupid;
773 my $query = "DELETE FROM aqbasketgroups WHERE id=?";
774 my $dbh = C4::Context->dbh;
775 my $sth = $dbh->prepare($query);
776 $sth->execute($basketgroupid);
780 #------------------------------------------------------------#
783 =head2 FUNCTIONS ABOUT ORDERS
785 =head3 GetBasketgroup
787 $basketgroup = &GetBasketgroup($basketgroupid);
789 Returns a reference to the hash containing all infermation about the basketgroup.
794 my $basketgroupid = shift;
795 die "basketgroup id is required to edit a basketgroup" unless $basketgroupid;
796 my $query = "SELECT * FROM aqbasketgroups WHERE id=?";
797 my $dbh = C4::Context->dbh;
798 my $sth = $dbh->prepare($query);
799 $sth->execute($basketgroupid);
800 my $result = $sth->fetchrow_hashref;
805 #------------------------------------------------------------#
807 =head3 GetBasketgroups
809 $basketgroups = &GetBasketgroups($booksellerid);
811 Returns a reference to the array of all the basketgroups of bookseller $booksellerid.
815 sub GetBasketgroups {
816 my $booksellerid = shift;
817 die 'bookseller id is required to edit a basketgroup' unless $booksellerid;
818 my $query = 'SELECT * FROM aqbasketgroups WHERE booksellerid=? ORDER BY id DESC';
819 my $dbh = C4::Context->dbh;
820 my $sth = $dbh->prepare($query);
821 $sth->execute($booksellerid);
822 return $sth->fetchall_arrayref({});
825 #------------------------------------------------------------#
827 =head2 FUNCTIONS ABOUT ORDERS
831 #------------------------------------------------------------#
833 =head3 GetPendingOrders
835 $orders = &GetPendingOrders($supplierid,$grouped,$owner,$basketno,$ordernumber,$search,$ean);
837 Finds pending orders from the bookseller with the given ID. Ignores
838 completed and cancelled orders.
840 C<$booksellerid> contains the bookseller identifier
841 C<$owner> contains 0 or 1. 0 means any owner. 1 means only the list of orders entered by the user itself.
842 C<$grouped> is a boolean that, if set to 1 will group all order lines of the same basket
843 in a single result line
844 C<$orders> is a reference-to-array; each element is a reference-to-hash.
846 Used also by the filter in parcel.pl
853 These give the value of the corresponding field in the aqorders table
854 of the Koha database.
856 Results are ordered from most to least recent.
860 sub GetPendingOrders {
861 my ($supplierid,$grouped,$owner,$basketno,$ordernumber,$search,$ean) = @_;
862 my $dbh = C4::Context->dbh;
864 SELECT ".($grouped?"count(*),":"")."aqbasket.basketno,
865 surname,firstname,biblio.*,biblioitems.isbn,
866 aqbasket.closedate, aqbasket.creationdate, aqbasket.basketname,
869 LEFT JOIN aqbasket ON aqbasket.basketno=aqorders.basketno
870 LEFT JOIN borrowers ON aqbasket.authorisedby=borrowers.borrowernumber
871 LEFT JOIN biblio ON biblio.biblionumber=aqorders.biblionumber
872 LEFT JOIN biblioitems ON biblioitems.biblionumber=biblio.biblionumber
873 WHERE (quantity > quantityreceived OR quantityreceived is NULL)
874 AND datecancellationprinted IS NULL";
876 my $userenv = C4::Context->userenv;
877 if ( C4::Context->preference("IndependentBranches") ) {
878 if ( ($userenv) && ( $userenv->{flags} != 1 ) ) {
879 $strsth .= " AND (borrowers.branchcode = ?
880 or borrowers.branchcode = '')";
881 push @query_params, $userenv->{branch};
885 $strsth .= " AND aqbasket.booksellerid = ?";
886 push @query_params, $supplierid;
889 $strsth .= " AND (aqorders.ordernumber=?)";
890 push @query_params, $ordernumber;
893 $strsth .= " AND (biblio.title like ? OR biblio.author LIKE ? OR biblioitems.isbn like ?)";
894 push @query_params, ("%$search%","%$search%","%$search%");
897 $strsth .= " AND biblioitems.ean = ?";
898 push @query_params, $ean;
901 $strsth .= " AND aqbasket.basketno=? ";
902 push @query_params, $basketno;
905 $strsth .= " AND aqbasket.authorisedby=? ";
906 push @query_params, $userenv->{'number'};
908 $strsth .= " group by aqbasket.basketno" if $grouped;
909 $strsth .= " order by aqbasket.basketno";
910 my $sth = $dbh->prepare($strsth);
911 $sth->execute( @query_params );
912 my $results = $sth->fetchall_arrayref({});
917 #------------------------------------------------------------#
921 @orders = &GetOrders($basketnumber, $orderby);
923 Looks up the pending (non-cancelled) orders with the given basket
924 number. If C<$booksellerID> is non-empty, only orders from that seller
928 C<&basket> returns a two-element array. C<@orders> is an array of
929 references-to-hash, whose keys are the fields from the aqorders,
930 biblio, and biblioitems tables in the Koha database.
935 my ( $basketno, $orderby ) = @_;
936 my $dbh = C4::Context->dbh;
938 SELECT biblio.*,biblioitems.*,
943 LEFT JOIN aqbudgets ON aqbudgets.budget_id = aqorders.budget_id
944 LEFT JOIN biblio ON biblio.biblionumber = aqorders.biblionumber
945 LEFT JOIN biblioitems ON biblioitems.biblionumber =biblio.biblionumber
947 AND (datecancellationprinted IS NULL OR datecancellationprinted='0000-00-00')
950 $orderby = "biblioitems.publishercode,biblio.title" unless $orderby;
951 $query .= " ORDER BY $orderby";
952 my $sth = $dbh->prepare($query);
953 $sth->execute($basketno);
954 my $results = $sth->fetchall_arrayref({});
959 #------------------------------------------------------------#
960 =head3 GetOrdersByBiblionumber
962 @orders = &GetOrdersByBiblionumber($biblionumber);
964 Looks up the orders with linked to a specific $biblionumber, including
965 cancelled orders and received orders.
968 C<@orders> is an array of references-to-hash, whose keys are the
969 fields from the aqorders, biblio, and biblioitems tables in the Koha database.
973 sub GetOrdersByBiblionumber {
974 my $biblionumber = shift;
975 return unless $biblionumber;
976 my $dbh = C4::Context->dbh;
978 SELECT biblio.*,biblioitems.*,
982 LEFT JOIN aqbudgets ON aqbudgets.budget_id = aqorders.budget_id
983 LEFT JOIN biblio ON biblio.biblionumber = aqorders.biblionumber
984 LEFT JOIN biblioitems ON biblioitems.biblionumber =biblio.biblionumber
985 WHERE aqorders.biblionumber=?
987 my $sth = $dbh->prepare($query);
988 $sth->execute($biblionumber);
989 my $results = $sth->fetchall_arrayref({});
994 #------------------------------------------------------------#
996 =head3 GetOrderNumber
998 $ordernumber = &GetOrderNumber($biblioitemnumber, $biblionumber);
1000 Looks up the ordernumber with the given biblionumber and biblioitemnumber.
1002 Returns the number of this order.
1006 =item C<$ordernumber> is the order number.
1012 sub GetOrderNumber {
1013 my ( $biblionumber,$biblioitemnumber ) = @_;
1014 my $dbh = C4::Context->dbh;
1018 WHERE biblionumber=?
1019 AND biblioitemnumber=?
1021 my $sth = $dbh->prepare($query);
1022 $sth->execute( $biblionumber, $biblioitemnumber );
1024 return $sth->fetchrow;
1027 #------------------------------------------------------------#
1031 $order = &GetOrder($ordernumber);
1033 Looks up an order by order number.
1035 Returns a reference-to-hash describing the order. The keys of
1036 C<$order> are fields from the biblio, biblioitems, aqorders tables of the Koha database.
1041 my ($ordernumber) = @_;
1042 my $dbh = C4::Context->dbh;
1044 SELECT biblioitems.*, biblio.*, aqorders.*
1046 LEFT JOIN biblio on biblio.biblionumber=aqorders.biblionumber
1047 LEFT JOIN biblioitems on biblioitems.biblionumber=aqorders.biblionumber
1048 WHERE aqorders.ordernumber=?
1051 my $sth= $dbh->prepare($query);
1052 $sth->execute($ordernumber);
1053 my $data = $sth->fetchrow_hashref;
1058 =head3 GetLastOrderNotReceivedFromSubscriptionid
1060 $order = &GetLastOrderNotReceivedFromSubscriptionid($subscriptionid);
1062 Returns a reference-to-hash describing the last order not received for a subscription.
1066 sub GetLastOrderNotReceivedFromSubscriptionid {
1067 my ( $subscriptionid ) = @_;
1068 my $dbh = C4::Context->dbh;
1070 SELECT * FROM aqorders
1071 LEFT JOIN subscription
1072 ON ( aqorders.subscriptionid = subscription.subscriptionid )
1073 WHERE aqorders.subscriptionid = ?
1074 AND aqorders.datereceived IS NULL
1077 my $sth = $dbh->prepare( $query );
1078 $sth->execute( $subscriptionid );
1079 my $order = $sth->fetchrow_hashref;
1083 =head3 GetLastOrderReceivedFromSubscriptionid
1085 $order = &GetLastOrderReceivedFromSubscriptionid($subscriptionid);
1087 Returns a reference-to-hash describing the last order received for a subscription.
1091 sub GetLastOrderReceivedFromSubscriptionid {
1092 my ( $subscriptionid ) = @_;
1093 my $dbh = C4::Context->dbh;
1095 SELECT * FROM aqorders
1096 LEFT JOIN subscription
1097 ON ( aqorders.subscriptionid = subscription.subscriptionid )
1098 WHERE aqorders.subscriptionid = ?
1099 AND aqorders.datereceived =
1101 SELECT MAX( aqorders.datereceived )
1103 LEFT JOIN subscription
1104 ON ( aqorders.subscriptionid = subscription.subscriptionid )
1105 WHERE aqorders.subscriptionid = ?
1106 AND aqorders.datereceived IS NOT NULL
1108 ORDER BY ordernumber DESC
1111 my $sth = $dbh->prepare( $query );
1112 $sth->execute( $subscriptionid, $subscriptionid );
1113 my $order = $sth->fetchrow_hashref;
1119 #------------------------------------------------------------#
1123 &NewOrder(\%hashref);
1125 Adds a new order to the database. Any argument that isn't described
1126 below is the new value of the field with the same name in the aqorders
1127 table of the Koha database.
1131 =item $hashref->{'basketno'} is the basketno foreign key in aqorders, it is mandatory
1133 =item $hashref->{'ordernumber'} is a "minimum order number."
1135 =item $hashref->{'budgetdate'} is effectively ignored.
1136 If it's undef (anything false) or the string 'now', the current day is used.
1137 Else, the upcoming July 1st is used.
1139 =item $hashref->{'subscription'} may be either "yes", or anything else for "no".
1141 =item $hashref->{'uncertainprice'} may be 0 for "the price is known" or 1 for "the price is uncertain"
1143 =item defaults entrydate to Now
1145 The following keys are used: "biblionumber", "title", "basketno", "quantity", "notes", "biblioitemnumber", "rrp", "ecost", "gstrate", "unitprice", "subscription", "sort1", "sort2", "booksellerinvoicenumber", "listprice", "budgetdate", "purchaseordernumber", "branchcode", "booksellerinvoicenumber", "budget_id".
1152 my $orderinfo = shift;
1153 #### ------------------------------
1154 my $dbh = C4::Context->dbh;
1158 # if these parameters are missing, we can't continue
1159 for my $key (qw/basketno quantity biblionumber budget_id/) {
1160 croak "Mandatory parameter $key missing" unless $orderinfo->{$key};
1163 if ( defined $orderinfo->{subscription} && $orderinfo->{'subscription'} eq 'yes' ) {
1164 $orderinfo->{'subscription'} = 1;
1166 $orderinfo->{'subscription'} = 0;
1168 $orderinfo->{'entrydate'} ||= C4::Dates->new()->output("iso");
1169 if (!$orderinfo->{quantityreceived}) {
1170 $orderinfo->{quantityreceived} = 0;
1173 my $ordernumber=InsertInTable("aqorders",$orderinfo);
1174 if (not $orderinfo->{parent_ordernumber}) {
1175 my $sth = $dbh->prepare("
1177 SET parent_ordernumber = ordernumber
1178 WHERE ordernumber = ?
1180 $sth->execute($ordernumber);
1182 return ( $orderinfo->{'basketno'}, $ordernumber );
1187 #------------------------------------------------------------#
1196 my ($itemnumber, $ordernumber) = @_;
1197 my $dbh = C4::Context->dbh;
1199 INSERT INTO aqorders_items
1200 (itemnumber, ordernumber)
1203 my $sth = $dbh->prepare($query);
1204 $sth->execute( $itemnumber, $ordernumber);
1207 #------------------------------------------------------------#
1211 &ModOrder(\%hashref);
1213 Modifies an existing order. Updates the order with order number
1214 $hashref->{'ordernumber'} and biblionumber $hashref->{'biblionumber'}. All
1215 other keys of the hash update the fields with the same name in the aqorders
1216 table of the Koha database.
1221 my $orderinfo = shift;
1223 die "Ordernumber is required" if $orderinfo->{'ordernumber'} eq '' ;
1224 die "Biblionumber is required" if $orderinfo->{'biblionumber'} eq '';
1226 my $dbh = C4::Context->dbh;
1229 # update uncertainprice to an integer, just in case (under FF, checked boxes have the value "ON" by default)
1230 $orderinfo->{uncertainprice}=1 if $orderinfo->{uncertainprice};
1232 # delete($orderinfo->{'branchcode'});
1233 # the hash contains a lot of entries not in aqorders, so get the columns ...
1234 my $sth = $dbh->prepare("SELECT * FROM aqorders LIMIT 1;");
1236 my $colnames = $sth->{NAME};
1237 #FIXME Be careful. If aqorders would have columns with diacritics,
1238 #you should need to decode what you get back from NAME.
1239 #See report 10110 and guided_reports.pl
1240 my $query = "UPDATE aqorders SET ";
1242 foreach my $orderinfokey (grep(!/ordernumber/, keys %$orderinfo)){
1243 # ... and skip hash entries that are not in the aqorders table
1244 # FIXME : probably not the best way to do it (would be better to have a correct hash)
1245 next unless grep(/^$orderinfokey$/, @$colnames);
1246 $query .= "$orderinfokey=?, ";
1247 push(@params, $orderinfo->{$orderinfokey});
1250 $query .= "timestamp=NOW() WHERE ordernumber=?";
1251 # push(@params, $specorderinfo{'ordernumber'});
1252 push(@params, $orderinfo->{'ordernumber'} );
1253 $sth = $dbh->prepare($query);
1254 $sth->execute(@params);
1258 #------------------------------------------------------------#
1262 &ModOrderItem(\%hashref);
1264 Modifies the itemnumber in the aqorders_items table. The input hash needs three entities:
1268 =item - itemnumber: the old itemnumber
1269 =item - ordernumber: the order this item is attached to
1270 =item - newitemnumber: the new itemnumber we want to attach the line to
1277 my $orderiteminfo = shift;
1278 if (! $orderiteminfo->{'ordernumber'} || ! $orderiteminfo->{'itemnumber'} || ! $orderiteminfo->{'newitemnumber'}){
1279 die "Ordernumber, itemnumber and newitemnumber is required";
1282 my $dbh = C4::Context->dbh;
1284 my $query = "UPDATE aqorders_items set itemnumber=? where itemnumber=? and ordernumber=?";
1285 my @params = ($orderiteminfo->{'newitemnumber'}, $orderiteminfo->{'itemnumber'}, $orderiteminfo->{'ordernumber'});
1286 my $sth = $dbh->prepare($query);
1287 $sth->execute(@params);
1293 ModItemOrder($itemnumber, $ordernumber);
1295 Modifies the ordernumber of an item in aqorders_items.
1300 my ($itemnumber, $ordernumber) = @_;
1302 return unless ($itemnumber and $ordernumber);
1304 my $dbh = C4::Context->dbh;
1306 UPDATE aqorders_items
1308 WHERE itemnumber = ?
1310 my $sth = $dbh->prepare($query);
1311 return $sth->execute($ordernumber, $itemnumber);
1314 #------------------------------------------------------------#
1317 =head3 ModOrderBibliotemNumber
1319 &ModOrderBiblioitemNumber($biblioitemnumber,$ordernumber, $biblionumber);
1321 Modifies the biblioitemnumber for an existing order.
1322 Updates the order with order number C<$ordernum> and biblionumber C<$biblionumber>.
1326 #FIXME: is this used at all?
1327 sub ModOrderBiblioitemNumber {
1328 my ($biblioitemnumber,$ordernumber, $biblionumber) = @_;
1329 my $dbh = C4::Context->dbh;
1332 SET biblioitemnumber = ?
1333 WHERE ordernumber = ?
1334 AND biblionumber = ?";
1335 my $sth = $dbh->prepare($query);
1336 $sth->execute( $biblioitemnumber, $ordernumber, $biblionumber );
1339 =head3 GetCancelledOrders
1341 my @orders = GetCancelledOrders($basketno, $orderby);
1343 Returns cancelled orders for a basket
1347 sub GetCancelledOrders {
1348 my ( $basketno, $orderby ) = @_;
1350 return () unless $basketno;
1352 my $dbh = C4::Context->dbh;
1354 SELECT biblio.*, biblioitems.*, aqorders.*, aqbudgets.*
1356 LEFT JOIN aqbudgets ON aqbudgets.budget_id = aqorders.budget_id
1357 LEFT JOIN biblio ON biblio.biblionumber = aqorders.biblionumber
1358 LEFT JOIN biblioitems ON biblioitems.biblionumber = biblio.biblionumber
1360 AND (datecancellationprinted IS NOT NULL
1361 AND datecancellationprinted <> '0000-00-00')
1364 $orderby = "aqorders.datecancellationprinted desc, aqorders.timestamp desc"
1366 $query .= " ORDER BY $orderby";
1367 my $sth = $dbh->prepare($query);
1368 $sth->execute($basketno);
1369 my $results = $sth->fetchall_arrayref( {} );
1375 #------------------------------------------------------------#
1377 =head3 ModReceiveOrder
1379 &ModReceiveOrder($biblionumber, $ordernumber, $quantityreceived, $user,
1380 $unitprice, $invoiceid, $biblioitemnumber,
1381 $bookfund, $rrp, \@received_itemnumbers);
1383 Updates an order, to reflect the fact that it was received, at least
1384 in part. All arguments not mentioned below update the fields with the
1385 same name in the aqorders table of the Koha database.
1387 If a partial order is received, splits the order into two.
1389 Updates the order with bibilionumber C<$biblionumber> and ordernumber
1395 sub ModReceiveOrder {
1397 $biblionumber, $ordernumber, $quantrec, $user, $cost, $ecost,
1398 $invoiceid, $rrp, $budget_id, $datereceived, $received_items
1402 my $dbh = C4::Context->dbh;
1403 $datereceived = C4::Dates->output('iso') unless $datereceived;
1404 my $suggestionid = GetSuggestionFromBiblionumber( $biblionumber );
1405 if ($suggestionid) {
1406 ModSuggestion( {suggestionid=>$suggestionid,
1407 STATUS=>'AVAILABLE',
1408 biblionumber=> $biblionumber}
1412 my $sth=$dbh->prepare("
1413 SELECT * FROM aqorders
1414 WHERE biblionumber=? AND aqorders.ordernumber=?");
1416 $sth->execute($biblionumber,$ordernumber);
1417 my $order = $sth->fetchrow_hashref();
1420 my $new_ordernumber = $ordernumber;
1421 if ( $order->{quantity} > $quantrec ) {
1422 # Split order line in two parts: the first is the original order line
1423 # without received items (the quantity is decreased),
1424 # the second part is a new order line with quantity=quantityrec
1425 # (entirely received)
1426 $sth=$dbh->prepare("
1429 WHERE ordernumber = ?
1432 $sth->execute($order->{quantity} - $quantrec, $ordernumber);
1436 delete $order->{'ordernumber'};
1437 $order->{'quantity'} = $quantrec;
1438 $order->{'quantityreceived'} = $quantrec;
1439 $order->{'datereceived'} = $datereceived;
1440 $order->{'invoiceid'} = $invoiceid;
1441 $order->{'unitprice'} = $cost;
1442 $order->{'rrp'} = $rrp;
1443 $order->{ecost} = $ecost;
1444 $order->{'orderstatus'} = 3; # totally received
1445 $new_ordernumber = NewOrder($order);
1447 if ($received_items) {
1448 foreach my $itemnumber (@$received_items) {
1449 ModItemOrder($itemnumber, $new_ordernumber);
1453 $sth=$dbh->prepare("update aqorders
1454 set quantityreceived=?,datereceived=?,invoiceid=?,
1455 unitprice=?,rrp=?,ecost=?
1456 where biblionumber=? and ordernumber=?");
1457 $sth->execute($quantrec,$datereceived,$invoiceid,$cost,$rrp,$ecost,$biblionumber,$ordernumber);
1460 return ($datereceived, $new_ordernumber);
1463 =head3 CancelReceipt
1465 my $parent_ordernumber = CancelReceipt($ordernumber);
1467 Cancel an order line receipt and update the parent order line, as if no
1469 If items are created at receipt (AcqCreateItem = receiving) then delete
1475 my $ordernumber = shift;
1477 return unless $ordernumber;
1479 my $dbh = C4::Context->dbh;
1481 SELECT datereceived, parent_ordernumber, quantity
1483 WHERE ordernumber = ?
1485 my $sth = $dbh->prepare($query);
1486 $sth->execute($ordernumber);
1487 my $order = $sth->fetchrow_hashref;
1489 warn "CancelReceipt: order $ordernumber does not exist";
1492 unless($order->{'datereceived'}) {
1493 warn "CancelReceipt: order $ordernumber is not received";
1497 my $parent_ordernumber = $order->{'parent_ordernumber'};
1499 if($parent_ordernumber == $ordernumber || not $parent_ordernumber) {
1500 # The order line has no parent, just mark it as not received
1503 SET quantityreceived = ?,
1506 WHERE ordernumber = ?
1508 $sth = $dbh->prepare($query);
1509 $sth->execute(0, undef, undef, $ordernumber);
1511 # The order line has a parent, increase parent quantity and delete
1514 SELECT quantity, datereceived
1516 WHERE ordernumber = ?
1518 $sth = $dbh->prepare($query);
1519 $sth->execute($parent_ordernumber);
1520 my $parent_order = $sth->fetchrow_hashref;
1521 unless($parent_order) {
1522 warn "Parent order $parent_ordernumber does not exist.";
1525 if($parent_order->{'datereceived'}) {
1526 warn "CancelReceipt: parent order is received.".
1527 " Can't cancel receipt.";
1533 WHERE ordernumber = ?
1535 $sth = $dbh->prepare($query);
1536 my $rv = $sth->execute(
1537 $order->{'quantity'} + $parent_order->{'quantity'},
1541 warn "Cannot update parent order line, so do not cancel".
1545 if(C4::Context->preference('AcqCreateItem') eq 'receiving') {
1546 # Remove items that were created at receipt
1548 DELETE FROM items, aqorders_items
1549 USING items, aqorders_items
1550 WHERE items.itemnumber = ? AND aqorders_items.itemnumber = ?
1552 $sth = $dbh->prepare($query);
1553 my @itemnumbers = GetItemnumbersFromOrder($ordernumber);
1554 foreach my $itemnumber (@itemnumbers) {
1555 $sth->execute($itemnumber, $itemnumber);
1559 my @itemnumbers = GetItemnumbersFromOrder($ordernumber);
1560 foreach my $itemnumber (@itemnumbers) {
1561 ModItemOrder($itemnumber, $parent_ordernumber);
1566 DELETE FROM aqorders
1567 WHERE ordernumber = ?
1569 $sth = $dbh->prepare($query);
1570 $sth->execute($ordernumber);
1574 return $parent_ordernumber;
1577 #------------------------------------------------------------#
1581 @results = &SearchOrder($search, $biblionumber, $complete);
1583 Searches for orders.
1585 C<$search> may take one of several forms: if it is an ISBN,
1586 C<&ordersearch> returns orders with that ISBN. If C<$search> is an
1587 order number, C<&ordersearch> returns orders with that order number
1588 and biblionumber C<$biblionumber>. Otherwise, C<$search> is considered
1589 to be a space-separated list of search terms; in this case, all of the
1590 terms must appear in the title (matching the beginning of title
1593 If C<$complete> is C<yes>, the results will include only completed
1594 orders. In any case, C<&ordersearch> ignores cancelled orders.
1596 C<&ordersearch> returns an array.
1597 C<@results> is an array of references-to-hash with the following keys:
1603 =item C<seriestitle>
1614 #### -------- SearchOrder-------------------------------
1615 my ( $ordernumber, $search, $ean, $supplierid, $basket ) = @_;
1617 my $dbh = C4::Context->dbh;
1622 LEFT JOIN biblio ON aqorders.biblionumber=biblio.biblionumber
1623 LEFT JOIN biblioitems ON biblioitems.biblionumber=biblio.biblionumber
1624 LEFT JOIN aqbasket ON aqorders.basketno = aqbasket.basketno
1625 WHERE (datecancellationprinted is NULL)";
1628 $query .= " AND (aqorders.ordernumber=?)";
1629 push @args, $ordernumber;
1632 $query .= " AND (biblio.title like ? OR biblio.author LIKE ? OR biblioitems.isbn like ?)";
1633 push @args, ("%$search%","%$search%","%$search%");
1636 $query .= " AND biblioitems.ean = ?";
1640 $query .= "AND aqbasket.booksellerid = ?";
1641 push @args, $supplierid;
1644 $query .= "AND aqorders.basketno = ?";
1645 push @args, $basket;
1648 my $sth = $dbh->prepare($query);
1649 $sth->execute(@args);
1650 my $results = $sth->fetchall_arrayref({});
1655 #------------------------------------------------------------#
1659 &DelOrder($biblionumber, $ordernumber);
1661 Cancel the order with the given order and biblio numbers. It does not
1662 delete any entries in the aqorders table, it merely marks them as
1668 my ( $bibnum, $ordernumber ) = @_;
1669 my $dbh = C4::Context->dbh;
1672 SET datecancellationprinted=now()
1673 WHERE biblionumber=? AND ordernumber=?
1675 my $sth = $dbh->prepare($query);
1676 $sth->execute( $bibnum, $ordernumber );
1678 my @itemnumbers = GetItemnumbersFromOrder( $ordernumber );
1679 foreach my $itemnumber (@itemnumbers){
1680 C4::Items::DelItem( $dbh, $bibnum, $itemnumber );
1685 =head2 FUNCTIONS ABOUT PARCELS
1689 #------------------------------------------------------------#
1693 @results = &GetParcel($booksellerid, $code, $date);
1695 Looks up all of the received items from the supplier with the given
1696 bookseller ID at the given date, for the given code (bookseller Invoice number). Ignores cancelled and completed orders.
1698 C<@results> is an array of references-to-hash. The keys of each element are fields from
1699 the aqorders, biblio, and biblioitems tables of the Koha database.
1701 C<@results> is sorted alphabetically by book title.
1706 #gets all orders from a certain supplier, orders them alphabetically
1707 my ( $supplierid, $code, $datereceived ) = @_;
1708 my $dbh = C4::Context->dbh;
1711 if $code; # add % if we search on a given code (otherwise, let him empty)
1713 SELECT authorisedby,
1718 aqorders.biblionumber,
1719 aqorders.ordernumber,
1720 aqorders.parent_ordernumber,
1722 aqorders.quantityreceived,
1730 LEFT JOIN aqbasket ON aqbasket.basketno=aqorders.basketno
1731 LEFT JOIN borrowers ON aqbasket.authorisedby=borrowers.borrowernumber
1732 LEFT JOIN biblio ON aqorders.biblionumber=biblio.biblionumber
1733 LEFT JOIN aqinvoices ON aqorders.invoiceid = aqinvoices.invoiceid
1735 aqbasket.booksellerid = ?
1736 AND aqinvoices.invoicenumber LIKE ?
1737 AND aqorders.datereceived = ? ";
1739 my @query_params = ( $supplierid, $code, $datereceived );
1740 if ( C4::Context->preference("IndependentBranches") ) {
1741 my $userenv = C4::Context->userenv;
1742 if ( ($userenv) && ( $userenv->{flags} != 1 ) ) {
1743 $strsth .= " and (borrowers.branchcode = ?
1744 or borrowers.branchcode = '')";
1745 push @query_params, $userenv->{branch};
1748 $strsth .= " ORDER BY aqbasket.basketno";
1749 # ## parcelinformation : $strsth
1750 my $sth = $dbh->prepare($strsth);
1751 $sth->execute( @query_params );
1752 while ( my $data = $sth->fetchrow_hashref ) {
1753 push( @results, $data );
1755 # ## countparcelbiblio: scalar(@results)
1761 #------------------------------------------------------------#
1765 $results = &GetParcels($bookseller, $order, $code, $datefrom, $dateto);
1767 get a lists of parcels.
1774 is the bookseller this function has to get parcels.
1777 To know on what criteria the results list has to be ordered.
1780 is the booksellerinvoicenumber.
1782 =item $datefrom & $dateto
1783 to know on what date this function has to filter its search.
1788 a pointer on a hash list containing parcel informations as such :
1794 =item Last operation
1796 =item Number of biblio
1798 =item Number of items
1805 my ($bookseller,$order, $code, $datefrom, $dateto) = @_;
1806 my $dbh = C4::Context->dbh;
1807 my @query_params = ();
1809 SELECT aqinvoices.invoicenumber,
1810 datereceived,purchaseordernumber,
1811 count(DISTINCT biblionumber) AS biblio,
1812 sum(quantity) AS itemsexpected,
1813 sum(quantityreceived) AS itemsreceived
1814 FROM aqorders LEFT JOIN aqbasket ON aqbasket.basketno = aqorders.basketno
1815 LEFT JOIN aqinvoices ON aqorders.invoiceid = aqinvoices.invoiceid
1816 WHERE aqbasket.booksellerid = ? and datereceived IS NOT NULL
1818 push @query_params, $bookseller;
1820 if ( defined $code ) {
1821 $strsth .= ' and aqinvoices.invoicenumber like ? ';
1822 # add a % to the end of the code to allow stemming.
1823 push @query_params, "$code%";
1826 if ( defined $datefrom ) {
1827 $strsth .= ' and datereceived >= ? ';
1828 push @query_params, $datefrom;
1831 if ( defined $dateto ) {
1832 $strsth .= 'and datereceived <= ? ';
1833 push @query_params, $dateto;
1836 $strsth .= "group by aqinvoices.invoicenumber,datereceived ";
1838 # can't use a placeholder to place this column name.
1839 # but, we could probably be checking to make sure it is a column that will be fetched.
1840 $strsth .= "order by $order " if ($order);
1842 my $sth = $dbh->prepare($strsth);
1844 $sth->execute( @query_params );
1845 my $results = $sth->fetchall_arrayref({});
1850 #------------------------------------------------------------#
1852 =head3 GetLateOrders
1854 @results = &GetLateOrders;
1856 Searches for bookseller with late orders.
1859 the table of supplier with late issues. This table is full of hashref.
1865 my $supplierid = shift;
1867 my $estimateddeliverydatefrom = shift;
1868 my $estimateddeliverydateto = shift;
1870 my $dbh = C4::Context->dbh;
1872 #BEWARE, order of parenthesis and LEFT JOIN is important for speed
1873 my $dbdriver = C4::Context->config("db_scheme") || "mysql";
1875 my @query_params = ();
1877 SELECT aqbasket.basketno,
1878 aqorders.ordernumber,
1879 DATE(aqbasket.closedate) AS orderdate,
1880 aqorders.rrp AS unitpricesupplier,
1881 aqorders.ecost AS unitpricelib,
1882 aqorders.claims_count AS claims_count,
1883 aqorders.claimed_date AS claimed_date,
1884 aqbudgets.budget_name AS budget,
1885 borrowers.branchcode AS branch,
1886 aqbooksellers.name AS supplier,
1887 aqbooksellers.id AS supplierid,
1888 biblio.author, biblio.title,
1889 biblioitems.publishercode AS publisher,
1890 biblioitems.publicationyear,
1891 ADDDATE(aqbasket.closedate, INTERVAL aqbooksellers.deliverytime DAY) AS estimateddeliverydate,
1895 aqorders LEFT JOIN biblio ON biblio.biblionumber = aqorders.biblionumber
1896 LEFT JOIN biblioitems ON biblioitems.biblionumber = biblio.biblionumber
1897 LEFT JOIN aqbudgets ON aqorders.budget_id = aqbudgets.budget_id,
1898 aqbasket LEFT JOIN borrowers ON aqbasket.authorisedby = borrowers.borrowernumber
1899 LEFT JOIN aqbooksellers ON aqbasket.booksellerid = aqbooksellers.id
1900 WHERE aqorders.basketno = aqbasket.basketno
1901 AND ( datereceived = ''
1902 OR datereceived IS NULL
1903 OR aqorders.quantityreceived < aqorders.quantity
1905 AND aqbasket.closedate IS NOT NULL
1906 AND (aqorders.datecancellationprinted IS NULL OR aqorders.datecancellationprinted='0000-00-00')
1909 if ($dbdriver eq "mysql") {
1911 aqorders.quantity - COALESCE(aqorders.quantityreceived,0) AS quantity,
1912 (aqorders.quantity - COALESCE(aqorders.quantityreceived,0)) * aqorders.rrp AS subtotal,
1913 DATEDIFF(CAST(now() AS date),closedate) AS latesince
1915 if ( defined $delay ) {
1916 $from .= " AND (closedate <= DATE_SUB(CAST(now() AS date),INTERVAL ? DAY)) " ;
1917 push @query_params, $delay;
1920 HAVING quantity <> 0
1921 AND unitpricesupplier <> 0
1922 AND unitpricelib <> 0
1925 # FIXME: account for IFNULL as above
1927 aqorders.quantity AS quantity,
1928 aqorders.quantity * aqorders.rrp AS subtotal,
1929 (CAST(now() AS date) - closedate) AS latesince
1931 if ( defined $delay ) {
1932 $from .= " AND (closedate <= (CAST(now() AS date) -(INTERVAL ? DAY)) ";
1933 push @query_params, $delay;
1936 if (defined $supplierid) {
1937 $from .= ' AND aqbasket.booksellerid = ? ';
1938 push @query_params, $supplierid;
1940 if (defined $branch) {
1941 $from .= ' AND borrowers.branchcode LIKE ? ';
1942 push @query_params, $branch;
1945 if ( defined $estimateddeliverydatefrom or defined $estimateddeliverydateto ) {
1946 $from .= ' AND aqbooksellers.deliverytime IS NOT NULL ';
1948 if ( defined $estimateddeliverydatefrom ) {
1949 $from .= ' AND ADDDATE(aqbasket.closedate, INTERVAL aqbooksellers.deliverytime DAY) >= ?';
1950 push @query_params, $estimateddeliverydatefrom;
1952 if ( defined $estimateddeliverydateto ) {
1953 $from .= ' AND ADDDATE(aqbasket.closedate, INTERVAL aqbooksellers.deliverytime DAY) <= ?';
1954 push @query_params, $estimateddeliverydateto;
1956 if ( defined $estimateddeliverydatefrom and not defined $estimateddeliverydateto ) {
1957 $from .= ' AND ADDDATE(aqbasket.closedate, INTERVAL aqbooksellers.deliverytime DAY) <= CAST(now() AS date)';
1959 if (C4::Context->preference("IndependentBranches")
1960 && C4::Context->userenv
1961 && C4::Context->userenv->{flags} != 1 ) {
1962 $from .= ' AND borrowers.branchcode LIKE ? ';
1963 push @query_params, C4::Context->userenv->{branch};
1965 my $query = "$select $from $having\nORDER BY latesince, basketno, borrowers.branchcode, supplier";
1966 $debug and print STDERR "GetLateOrders query: $query\nGetLateOrders args: " . join(" ",@query_params);
1967 my $sth = $dbh->prepare($query);
1968 $sth->execute(@query_params);
1970 while (my $data = $sth->fetchrow_hashref) {
1971 $data->{orderdate} = format_date($data->{orderdate});
1972 $data->{claimed_date} = format_date($data->{claimed_date});
1973 push @results, $data;
1978 #------------------------------------------------------------#
1982 (\@order_loop, $total_qty, $total_price, $total_qtyreceived) = GetHistory( %params );
1984 Retreives some acquisition history information
1992 basket - search both basket name and number
1993 booksellerinvoicenumber
1996 $order_loop is a list of hashrefs that each look like this:
1998 'author' => 'Twain, Mark',
2000 'biblionumber' => '215',
2002 'creationdate' => 'MM/DD/YYYY',
2003 'datereceived' => undef,
2006 'invoicenumber' => undef,
2008 'ordernumber' => '1',
2010 'quantityreceived' => undef,
2011 'title' => 'The Adventures of Huckleberry Finn'
2013 $total_qty is the sum of all of the quantities in $order_loop
2014 $total_price is the cost of each in $order_loop times the quantity
2015 $total_qtyreceived is the sum of all of the quantityreceived entries in $order_loop
2020 # don't run the query if there are no parameters (list would be too long for sure !)
2021 croak "No search params" unless @_;
2023 my $title = $params{title};
2024 my $author = $params{author};
2025 my $isbn = $params{isbn};
2026 my $ean = $params{ean};
2027 my $name = $params{name};
2028 my $from_placed_on = $params{from_placed_on};
2029 my $to_placed_on = $params{to_placed_on};
2030 my $basket = $params{basket};
2031 my $booksellerinvoicenumber = $params{booksellerinvoicenumber};
2032 my $basketgroupname = $params{basketgroupname};
2035 my $total_qtyreceived = 0;
2036 my $total_price = 0;
2038 my $dbh = C4::Context->dbh;
2046 aqbasket.basketname,
2047 aqbasket.basketgroupid,
2048 aqbasketgroups.name as groupname,
2050 aqbasket.creationdate,
2051 aqorders.datereceived,
2053 aqorders.quantityreceived,
2055 aqorders.ordernumber,
2057 aqinvoices.invoicenumber,
2058 aqbooksellers.id as id,
2059 aqorders.biblionumber
2061 LEFT JOIN aqbasket ON aqorders.basketno=aqbasket.basketno
2062 LEFT JOIN aqbasketgroups ON aqbasket.basketgroupid=aqbasketgroups.id
2063 LEFT JOIN aqbooksellers ON aqbasket.booksellerid=aqbooksellers.id
2064 LEFT JOIN biblioitems ON biblioitems.biblionumber=aqorders.biblionumber
2065 LEFT JOIN biblio ON biblio.biblionumber=aqorders.biblionumber
2066 LEFT JOIN aqinvoices ON aqorders.invoiceid = aqinvoices.invoiceid";
2068 $query .= " LEFT JOIN borrowers ON aqbasket.authorisedby=borrowers.borrowernumber"
2069 if ( C4::Context->preference("IndependentBranches") );
2071 $query .= " WHERE (datecancellationprinted is NULL or datecancellationprinted='0000-00-00') ";
2073 my @query_params = ();
2076 $query .= " AND biblio.title LIKE ? ";
2077 $title =~ s/\s+/%/g;
2078 push @query_params, "%$title%";
2082 $query .= " AND biblio.author LIKE ? ";
2083 push @query_params, "%$author%";
2087 $query .= " AND biblioitems.isbn LIKE ? ";
2088 push @query_params, "%$isbn%";
2090 if ( defined $ean and $ean ) {
2091 $query .= " AND biblioitems.ean = ? ";
2092 push @query_params, "$ean";
2095 $query .= " AND aqbooksellers.name LIKE ? ";
2096 push @query_params, "%$name%";
2099 if ( $from_placed_on ) {
2100 $query .= " AND creationdate >= ? ";
2101 push @query_params, $from_placed_on;
2104 if ( $to_placed_on ) {
2105 $query .= " AND creationdate <= ? ";
2106 push @query_params, $to_placed_on;
2110 if ($basket =~ m/^\d+$/) {
2111 $query .= " AND aqorders.basketno = ? ";
2112 push @query_params, $basket;
2114 $query .= " AND aqbasket.basketname LIKE ? ";
2115 push @query_params, "%$basket%";
2119 if ($booksellerinvoicenumber) {
2120 $query .= " AND aqinvoices.invoicenumber LIKE ? ";
2121 push @query_params, "%$booksellerinvoicenumber%";
2124 if ($basketgroupname) {
2125 $query .= " AND aqbasketgroups.name LIKE ? ";
2126 push @query_params, "%$basketgroupname%";
2129 if ( C4::Context->preference("IndependentBranches") ) {
2130 my $userenv = C4::Context->userenv;
2131 if ( $userenv && ($userenv->{flags} || 0) != 1 ) {
2132 $query .= " AND (borrowers.branchcode = ? OR borrowers.branchcode ='' ) ";
2133 push @query_params, $userenv->{branch};
2136 $query .= " ORDER BY id";
2137 my $sth = $dbh->prepare($query);
2138 $sth->execute( @query_params );
2140 while ( my $line = $sth->fetchrow_hashref ) {
2141 $line->{count} = $cnt++;
2142 $line->{toggle} = 1 if $cnt % 2;
2143 push @order_loop, $line;
2144 $total_qty += $line->{'quantity'};
2145 $total_qtyreceived += $line->{'quantityreceived'};
2146 $total_price += $line->{'quantity'} * $line->{'ecost'};
2148 return \@order_loop, $total_qty, $total_price, $total_qtyreceived;
2151 =head2 GetRecentAcqui
2153 $results = GetRecentAcqui($days);
2155 C<$results> is a ref to a table which containts hashref
2159 sub GetRecentAcqui {
2161 my $dbh = C4::Context->dbh;
2165 ORDER BY timestamp DESC
2168 my $sth = $dbh->prepare($query);
2170 my $results = $sth->fetchall_arrayref({});
2176 $contractlist = &GetContracts($booksellerid, $activeonly);
2178 Looks up the contracts that belong to a bookseller
2180 Returns a list of contracts
2184 =item C<$booksellerid> is the "id" field in the "aqbooksellers" table.
2186 =item C<$activeonly> if exists get only contracts that are still active.
2193 my ( $booksellerid, $activeonly ) = @_;
2194 my $dbh = C4::Context->dbh;
2196 if (! $activeonly) {
2200 WHERE booksellerid=?
2205 WHERE booksellerid=?
2206 AND contractenddate >= CURDATE( )";
2208 my $sth = $dbh->prepare($query);
2209 $sth->execute( $booksellerid );
2211 while (my $data = $sth->fetchrow_hashref ) {
2212 push(@results, $data);
2218 #------------------------------------------------------------#
2222 $contract = &GetContract($contractID);
2224 Looks up the contract that has PRIMKEY (contractnumber) value $contractID
2231 my ( $contractno ) = @_;
2232 my $dbh = C4::Context->dbh;
2236 WHERE contractnumber=?
2239 my $sth = $dbh->prepare($query);
2240 $sth->execute( $contractno );
2241 my $result = $sth->fetchrow_hashref;
2249 &AddClaim($ordernumber);
2251 Add a claim for an order
2257 my ($ordernumber) = @_;
2258 my $dbh = C4::Context->dbh;
2261 claims_count = claims_count + 1,
2262 claimed_date = CURDATE()
2263 WHERE ordernumber = ?
2265 my $sth = $dbh->prepare($query);
2266 $sth->execute($ordernumber);
2271 my @invoices = GetInvoices(
2272 invoicenumber => $invoicenumber,
2273 suppliername => $suppliername,
2274 shipmentdatefrom => $shipmentdatefrom, # ISO format
2275 shipmentdateto => $shipmentdateto, # ISO format
2276 billingdatefrom => $billingdatefrom, # ISO format
2277 billingdateto => $billingdateto, # ISO format
2278 isbneanissn => $isbn_or_ean_or_issn,
2281 publisher => $publisher,
2282 publicationyear => $publicationyear,
2283 branchcode => $branchcode,
2284 order_by => $order_by
2287 Return a list of invoices that match all given criteria.
2289 $order_by is "column_name (asc|desc)", where column_name is any of
2290 'invoicenumber', 'booksellerid', 'shipmentdate', 'billingdate', 'closedate',
2291 'shipmentcost', 'shipmentcost_budgetid'.
2293 asc is the default if omitted
2300 my @columns = qw(invoicenumber booksellerid shipmentdate billingdate
2301 closedate shipmentcost shipmentcost_budgetid);
2303 my $dbh = C4::Context->dbh;
2305 SELECT aqinvoices.*, aqbooksellers.name AS suppliername,
2308 aqorders.datereceived IS NOT NULL,
2309 aqorders.biblionumber,
2312 ) AS receivedbiblios,
2313 SUM(aqorders.quantityreceived) AS receiveditems
2315 LEFT JOIN aqbooksellers ON aqbooksellers.id = aqinvoices.booksellerid
2316 LEFT JOIN aqorders ON aqorders.invoiceid = aqinvoices.invoiceid
2317 LEFT JOIN biblio ON aqorders.biblionumber = biblio.biblionumber
2318 LEFT JOIN biblioitems ON biblio.biblionumber = biblioitems.biblionumber
2319 LEFT JOIN subscription ON biblio.biblionumber = subscription.biblionumber
2324 if($args{supplierid}) {
2325 push @bind_strs, " aqinvoices.booksellerid = ? ";
2326 push @bind_args, $args{supplierid};
2328 if($args{invoicenumber}) {
2329 push @bind_strs, " aqinvoices.invoicenumber LIKE ? ";
2330 push @bind_args, "%$args{invoicenumber}%";
2332 if($args{suppliername}) {
2333 push @bind_strs, " aqbooksellers.name LIKE ? ";
2334 push @bind_args, "%$args{suppliername}%";
2336 if($args{shipmentdatefrom}) {
2337 push @bind_strs, " aqinvoices.shipementdate >= ? ";
2338 push @bind_args, $args{shipmentdatefrom};
2340 if($args{shipmentdateto}) {
2341 push @bind_strs, " aqinvoices.shipementdate <= ? ";
2342 push @bind_args, $args{shipmentdateto};
2344 if($args{billingdatefrom}) {
2345 push @bind_strs, " aqinvoices.billingdate >= ? ";
2346 push @bind_args, $args{billingdatefrom};
2348 if($args{billingdateto}) {
2349 push @bind_strs, " aqinvoices.billingdate <= ? ";
2350 push @bind_args, $args{billingdateto};
2352 if($args{isbneanissn}) {
2353 push @bind_strs, " (biblioitems.isbn LIKE ? OR biblioitems.ean LIKE ? OR biblioitems.issn LIKE ? ) ";
2354 push @bind_args, $args{isbneanissn}, $args{isbneanissn}, $args{isbneanissn};
2357 push @bind_strs, " biblio.title LIKE ? ";
2358 push @bind_args, $args{title};
2361 push @bind_strs, " biblio.author LIKE ? ";
2362 push @bind_args, $args{author};
2364 if($args{publisher}) {
2365 push @bind_strs, " biblioitems.publishercode LIKE ? ";
2366 push @bind_args, $args{publisher};
2368 if($args{publicationyear}) {
2369 push @bind_strs, " biblioitems.publicationyear = ? ";
2370 push @bind_args, $args{publicationyear};
2372 if($args{branchcode}) {
2373 push @bind_strs, " aqorders.branchcode = ? ";
2374 push @bind_args, $args{branchcode};
2377 $query .= " WHERE " . join(" AND ", @bind_strs) if @bind_strs;
2378 $query .= " GROUP BY aqinvoices.invoiceid ";
2380 if($args{order_by}) {
2381 my ($column, $direction) = split / /, $args{order_by};
2382 if(grep /^$column$/, @columns) {
2383 $direction ||= 'ASC';
2384 $query .= " ORDER BY $column $direction";
2388 my $sth = $dbh->prepare($query);
2389 $sth->execute(@bind_args);
2391 my $results = $sth->fetchall_arrayref({});
2397 my $invoice = GetInvoice($invoiceid);
2399 Get informations about invoice with given $invoiceid
2401 Return a hash filled with aqinvoices.* fields
2406 my ($invoiceid) = @_;
2409 return unless $invoiceid;
2411 my $dbh = C4::Context->dbh;
2417 my $sth = $dbh->prepare($query);
2418 $sth->execute($invoiceid);
2420 $invoice = $sth->fetchrow_hashref;
2424 =head3 GetInvoiceDetails
2426 my $invoice = GetInvoiceDetails($invoiceid)
2428 Return informations about an invoice + the list of related order lines
2430 Orders informations are in $invoice->{orders} (array ref)
2434 sub GetInvoiceDetails {
2435 my ($invoiceid) = @_;
2437 if ( !defined $invoiceid ) {
2438 carp 'GetInvoiceDetails called without an invoiceid';
2442 my $dbh = C4::Context->dbh;
2444 SELECT aqinvoices.*, aqbooksellers.name AS suppliername
2446 LEFT JOIN aqbooksellers ON aqinvoices.booksellerid = aqbooksellers.id
2449 my $sth = $dbh->prepare($query);
2450 $sth->execute($invoiceid);
2452 my $invoice = $sth->fetchrow_hashref;
2455 SELECT aqorders.*, biblio.*
2457 LEFT JOIN biblio ON aqorders.biblionumber = biblio.biblionumber
2460 $sth = $dbh->prepare($query);
2461 $sth->execute($invoiceid);
2462 $invoice->{orders} = $sth->fetchall_arrayref({});
2463 $invoice->{orders} ||= []; # force an empty arrayref if fetchall_arrayref fails
2470 my $invoiceid = AddInvoice(
2471 invoicenumber => $invoicenumber,
2472 booksellerid => $booksellerid,
2473 shipmentdate => $shipmentdate,
2474 billingdate => $billingdate,
2475 closedate => $closedate,
2476 shipmentcost => $shipmentcost,
2477 shipmentcost_budgetid => $shipmentcost_budgetid
2480 Create a new invoice and return its id or undef if it fails.
2487 return unless(%invoice and $invoice{invoicenumber});
2489 my @columns = qw(invoicenumber booksellerid shipmentdate billingdate
2490 closedate shipmentcost shipmentcost_budgetid);
2494 foreach my $key (keys %invoice) {
2495 if(0 < grep(/^$key$/, @columns)) {
2496 push @set_strs, "$key = ?";
2497 push @set_args, ($invoice{$key} || undef);
2503 my $dbh = C4::Context->dbh;
2504 my $query = "INSERT INTO aqinvoices SET ";
2505 $query .= join (",", @set_strs);
2506 my $sth = $dbh->prepare($query);
2507 $rv = $sth->execute(@set_args);
2509 $rv = $dbh->last_insert_id(undef, undef, 'aqinvoices', undef);
2518 invoiceid => $invoiceid, # Mandatory
2519 invoicenumber => $invoicenumber,
2520 booksellerid => $booksellerid,
2521 shipmentdate => $shipmentdate,
2522 billingdate => $billingdate,
2523 closedate => $closedate,
2524 shipmentcost => $shipmentcost,
2525 shipmentcost_budgetid => $shipmentcost_budgetid
2528 Modify an invoice, invoiceid is mandatory.
2530 Return undef if it fails.
2537 return unless(%invoice and $invoice{invoiceid});
2539 my @columns = qw(invoicenumber booksellerid shipmentdate billingdate
2540 closedate shipmentcost shipmentcost_budgetid);
2544 foreach my $key (keys %invoice) {
2545 if(0 < grep(/^$key$/, @columns)) {
2546 push @set_strs, "$key = ?";
2547 push @set_args, ($invoice{$key} || undef);
2551 my $dbh = C4::Context->dbh;
2552 my $query = "UPDATE aqinvoices SET ";
2553 $query .= join(",", @set_strs);
2554 $query .= " WHERE invoiceid = ?";
2556 my $sth = $dbh->prepare($query);
2557 $sth->execute(@set_args, $invoice{invoiceid});
2562 CloseInvoice($invoiceid);
2566 Equivalent to ModInvoice(invoiceid => $invoiceid, closedate => undef);
2571 my ($invoiceid) = @_;
2573 return unless $invoiceid;
2575 my $dbh = C4::Context->dbh;
2578 SET closedate = CAST(NOW() AS DATE)
2581 my $sth = $dbh->prepare($query);
2582 $sth->execute($invoiceid);
2585 =head3 ReopenInvoice
2587 ReopenInvoice($invoiceid);
2591 Equivalent to ModInvoice(invoiceid => $invoiceid, closedate => C4::Dates->new()->output('iso'))
2596 my ($invoiceid) = @_;
2598 return unless $invoiceid;
2600 my $dbh = C4::Context->dbh;
2603 SET closedate = NULL
2606 my $sth = $dbh->prepare($query);
2607 $sth->execute($invoiceid);
2615 Koha Development Team <http://koha-community.org/>