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);
573 Returns in a arrayref of hashref all about booksellers baskets, plus:
574 total_biblios: Number of distinct biblios in basket
575 total_items: Number of items in basket
576 expected_items: Number of non-received items in basket
580 sub GetBasketsInfosByBookseller {
581 my ($supplierid) = @_;
583 return unless $supplierid;
585 my $dbh = C4::Context->dbh;
588 SUM(aqorders.quantity) AS total_items,
589 COUNT(DISTINCT aqorders.biblionumber) AS total_biblios,
591 IF(aqorders.datereceived IS NULL
592 AND aqorders.datecancellationprinted IS NULL
597 LEFT JOIN aqorders ON aqorders.basketno = aqbasket.basketno
598 WHERE booksellerid = ? AND ( aqorders.quantity > aqorders.quantityreceived OR quantityreceived IS NULL)
599 AND datecancellationprinted IS NULL
600 GROUP BY aqbasket.basketno
602 my $sth = $dbh->prepare($query);
603 $sth->execute($supplierid);
604 return $sth->fetchall_arrayref({});
608 #------------------------------------------------------------#
610 =head3 GetBasketsByBasketgroup
612 $baskets = &GetBasketsByBasketgroup($basketgroupid);
614 Returns a reference to all baskets that belong to basketgroup $basketgroupid.
618 sub GetBasketsByBasketgroup {
619 my $basketgroupid = shift;
621 SELECT *, aqbasket.booksellerid as booksellerid
623 LEFT JOIN aqcontract USING(contractnumber) WHERE basketgroupid=?
625 my $dbh = C4::Context->dbh;
626 my $sth = $dbh->prepare($query);
627 $sth->execute($basketgroupid);
628 my $results = $sth->fetchall_arrayref({});
633 #------------------------------------------------------------#
635 =head3 NewBasketgroup
637 $basketgroupid = NewBasketgroup(\%hashref);
639 Adds a basketgroup to the aqbasketgroups table, and add the initial baskets to it.
641 $hashref->{'booksellerid'} is the 'id' field of the bookseller in the aqbooksellers table,
643 $hashref->{'name'} is the 'name' field of the basketgroup in the aqbasketgroups table,
645 $hashref->{'basketlist'} is a list reference of the 'id's of the baskets that belong to this group,
647 $hashref->{'billingplace'} is the 'billingplace' field of the basketgroup in the aqbasketgroups table,
649 $hashref->{'deliveryplace'} is the 'deliveryplace' field of the basketgroup in the aqbasketgroups table,
651 $hashref->{'freedeliveryplace'} is the 'freedeliveryplace' field of the basketgroup in the aqbasketgroups table,
653 $hashref->{'deliverycomment'} is the 'deliverycomment' field of the basketgroup in the aqbasketgroups table,
655 $hashref->{'closed'} is the 'closed' field of the aqbasketgroups table, it is false if 0, true otherwise.
660 my $basketgroupinfo = shift;
661 die "booksellerid is required to create a basketgroup" unless $basketgroupinfo->{'booksellerid'};
662 my $query = "INSERT INTO aqbasketgroups (";
664 foreach my $field (qw(name billingplace deliveryplace freedeliveryplace deliverycomment closed)) {
665 if ( defined $basketgroupinfo->{$field} ) {
666 $query .= "$field, ";
667 push(@params, $basketgroupinfo->{$field});
670 $query .= "booksellerid) VALUES (";
675 push(@params, $basketgroupinfo->{'booksellerid'});
676 my $dbh = C4::Context->dbh;
677 my $sth = $dbh->prepare($query);
678 $sth->execute(@params);
679 my $basketgroupid = $dbh->{'mysql_insertid'};
680 if( $basketgroupinfo->{'basketlist'} ) {
681 foreach my $basketno (@{$basketgroupinfo->{'basketlist'}}) {
682 my $query2 = "UPDATE aqbasket SET basketgroupid=? WHERE basketno=?";
683 my $sth2 = $dbh->prepare($query2);
684 $sth2->execute($basketgroupid, $basketno);
687 return $basketgroupid;
690 #------------------------------------------------------------#
692 =head3 ModBasketgroup
694 ModBasketgroup(\%hashref);
696 Modifies a basketgroup in the aqbasketgroups table, and add the baskets to it.
698 $hashref->{'id'} is the 'id' field of the basketgroup in the aqbasketgroup table, this parameter is mandatory,
700 $hashref->{'name'} is the 'name' field of the basketgroup in the aqbasketgroups table,
702 $hashref->{'basketlist'} is a list reference of the 'id's of the baskets that belong to this group,
704 $hashref->{'billingplace'} is the 'billingplace' field of the basketgroup in the aqbasketgroups table,
706 $hashref->{'deliveryplace'} is the 'deliveryplace' field of the basketgroup in the aqbasketgroups table,
708 $hashref->{'freedeliveryplace'} is the 'freedeliveryplace' field of the basketgroup in the aqbasketgroups table,
710 $hashref->{'deliverycomment'} is the 'deliverycomment' field of the basketgroup in the aqbasketgroups table,
712 $hashref->{'closed'} is the 'closed' field of the aqbasketgroups table, it is false if 0, true otherwise.
717 my $basketgroupinfo = shift;
718 die "basketgroup id is required to edit a basketgroup" unless $basketgroupinfo->{'id'};
719 my $dbh = C4::Context->dbh;
720 my $query = "UPDATE aqbasketgroups SET ";
722 foreach my $field (qw(name billingplace deliveryplace freedeliveryplace deliverycomment closed)) {
723 if ( defined $basketgroupinfo->{$field} ) {
724 $query .= "$field=?, ";
725 push(@params, $basketgroupinfo->{$field});
730 $query .= " WHERE id=?";
731 push(@params, $basketgroupinfo->{'id'});
732 my $sth = $dbh->prepare($query);
733 $sth->execute(@params);
735 $sth = $dbh->prepare('UPDATE aqbasket SET basketgroupid = NULL WHERE basketgroupid = ?');
736 $sth->execute($basketgroupinfo->{'id'});
738 if($basketgroupinfo->{'basketlist'} && @{$basketgroupinfo->{'basketlist'}}){
739 $sth = $dbh->prepare("UPDATE aqbasket SET basketgroupid=? WHERE basketno=?");
740 foreach my $basketno (@{$basketgroupinfo->{'basketlist'}}) {
741 $sth->execute($basketgroupinfo->{'id'}, $basketno);
748 #------------------------------------------------------------#
750 =head3 DelBasketgroup
752 DelBasketgroup($basketgroupid);
754 Deletes a basketgroup in the aqbasketgroups table, and removes the reference to it from the baskets,
758 =item C<$basketgroupid> is the 'id' field of the basket in the aqbasketgroup table
765 my $basketgroupid = shift;
766 die "basketgroup id is required to edit a basketgroup" unless $basketgroupid;
767 my $query = "DELETE FROM aqbasketgroups WHERE id=?";
768 my $dbh = C4::Context->dbh;
769 my $sth = $dbh->prepare($query);
770 $sth->execute($basketgroupid);
774 #------------------------------------------------------------#
777 =head2 FUNCTIONS ABOUT ORDERS
779 =head3 GetBasketgroup
781 $basketgroup = &GetBasketgroup($basketgroupid);
783 Returns a reference to the hash containing all infermation about the basketgroup.
788 my $basketgroupid = shift;
789 die "basketgroup id is required to edit a basketgroup" unless $basketgroupid;
790 my $query = "SELECT * FROM aqbasketgroups WHERE id=?";
791 my $dbh = C4::Context->dbh;
792 my $sth = $dbh->prepare($query);
793 $sth->execute($basketgroupid);
794 my $result = $sth->fetchrow_hashref;
799 #------------------------------------------------------------#
801 =head3 GetBasketgroups
803 $basketgroups = &GetBasketgroups($booksellerid);
805 Returns a reference to the array of all the basketgroups of bookseller $booksellerid.
809 sub GetBasketgroups {
810 my $booksellerid = shift;
811 die 'bookseller id is required to edit a basketgroup' unless $booksellerid;
812 my $query = 'SELECT * FROM aqbasketgroups WHERE booksellerid=? ORDER BY id DESC';
813 my $dbh = C4::Context->dbh;
814 my $sth = $dbh->prepare($query);
815 $sth->execute($booksellerid);
816 return $sth->fetchall_arrayref({});
819 #------------------------------------------------------------#
821 =head2 FUNCTIONS ABOUT ORDERS
825 #------------------------------------------------------------#
827 =head3 GetPendingOrders
829 $orders = &GetPendingOrders($supplierid,$grouped,$owner,$basketno,$ordernumber,$search,$ean);
831 Finds pending orders from the bookseller with the given ID. Ignores
832 completed and cancelled orders.
834 C<$booksellerid> contains the bookseller identifier
835 C<$owner> contains 0 or 1. 0 means any owner. 1 means only the list of orders entered by the user itself.
836 C<$grouped> is a boolean that, if set to 1 will group all order lines of the same basket
837 in a single result line
838 C<$orders> is a reference-to-array; each element is a reference-to-hash.
840 Used also by the filter in parcel.pl
847 These give the value of the corresponding field in the aqorders table
848 of the Koha database.
850 Results are ordered from most to least recent.
854 sub GetPendingOrders {
855 my ($supplierid,$grouped,$owner,$basketno,$ordernumber,$search,$ean) = @_;
856 my $dbh = C4::Context->dbh;
858 SELECT ".($grouped?"count(*),":"")."aqbasket.basketno,
859 surname,firstname,biblio.*,biblioitems.isbn,
860 aqbasket.closedate, aqbasket.creationdate, aqbasket.basketname,
863 LEFT JOIN aqbasket ON aqbasket.basketno=aqorders.basketno
864 LEFT JOIN borrowers ON aqbasket.authorisedby=borrowers.borrowernumber
865 LEFT JOIN biblio ON biblio.biblionumber=aqorders.biblionumber
866 LEFT JOIN biblioitems ON biblioitems.biblionumber=biblio.biblionumber
867 WHERE (quantity > quantityreceived OR quantityreceived is NULL)
868 AND datecancellationprinted IS NULL";
870 my $userenv = C4::Context->userenv;
871 if ( C4::Context->preference("IndependantBranches") ) {
872 if ( ($userenv) && ( $userenv->{flags} != 1 ) ) {
873 $strsth .= " AND (borrowers.branchcode = ?
874 or borrowers.branchcode = '')";
875 push @query_params, $userenv->{branch};
879 $strsth .= " AND aqbasket.booksellerid = ?";
880 push @query_params, $supplierid;
883 $strsth .= " AND (aqorders.ordernumber=?)";
884 push @query_params, $ordernumber;
887 $strsth .= " AND (biblio.title like ? OR biblio.author LIKE ? OR biblioitems.isbn like ?)";
888 push @query_params, ("%$search%","%$search%","%$search%");
891 $strsth .= " AND biblioitems.ean = ?";
892 push @query_params, $ean;
895 $strsth .= " AND aqbasket.basketno=? ";
896 push @query_params, $basketno;
899 $strsth .= " AND aqbasket.authorisedby=? ";
900 push @query_params, $userenv->{'number'};
902 $strsth .= " group by aqbasket.basketno" if $grouped;
903 $strsth .= " order by aqbasket.basketno";
904 my $sth = $dbh->prepare($strsth);
905 $sth->execute( @query_params );
906 my $results = $sth->fetchall_arrayref({});
911 #------------------------------------------------------------#
915 @orders = &GetOrders($basketnumber, $orderby);
917 Looks up the pending (non-cancelled) orders with the given basket
918 number. If C<$booksellerID> is non-empty, only orders from that seller
922 C<&basket> returns a two-element array. C<@orders> is an array of
923 references-to-hash, whose keys are the fields from the aqorders,
924 biblio, and biblioitems tables in the Koha database.
929 my ( $basketno, $orderby ) = @_;
930 my $dbh = C4::Context->dbh;
932 SELECT biblio.*,biblioitems.*,
937 LEFT JOIN aqbudgets ON aqbudgets.budget_id = aqorders.budget_id
938 LEFT JOIN biblio ON biblio.biblionumber = aqorders.biblionumber
939 LEFT JOIN biblioitems ON biblioitems.biblionumber =biblio.biblionumber
941 AND (datecancellationprinted IS NULL OR datecancellationprinted='0000-00-00')
944 $orderby = "biblioitems.publishercode,biblio.title" unless $orderby;
945 $query .= " ORDER BY $orderby";
946 my $sth = $dbh->prepare($query);
947 $sth->execute($basketno);
948 my $results = $sth->fetchall_arrayref({});
953 #------------------------------------------------------------#
954 =head3 GetOrdersByBiblionumber
956 @orders = &GetOrdersByBiblionumber($biblionumber);
958 Looks up the orders with linked to a specific $biblionumber, including
959 cancelled orders and received orders.
962 C<@orders> is an array of references-to-hash, whose keys are the
963 fields from the aqorders, biblio, and biblioitems tables in the Koha database.
967 sub GetOrdersByBiblionumber {
968 my $biblionumber = shift;
969 return unless $biblionumber;
970 my $dbh = C4::Context->dbh;
972 SELECT biblio.*,biblioitems.*,
976 LEFT JOIN aqbudgets ON aqbudgets.budget_id = aqorders.budget_id
977 LEFT JOIN biblio ON biblio.biblionumber = aqorders.biblionumber
978 LEFT JOIN biblioitems ON biblioitems.biblionumber =biblio.biblionumber
979 WHERE aqorders.biblionumber=?
981 my $sth = $dbh->prepare($query);
982 $sth->execute($biblionumber);
983 my $results = $sth->fetchall_arrayref({});
988 #------------------------------------------------------------#
990 =head3 GetOrderNumber
992 $ordernumber = &GetOrderNumber($biblioitemnumber, $biblionumber);
994 Looks up the ordernumber with the given biblionumber and biblioitemnumber.
996 Returns the number of this order.
1000 =item C<$ordernumber> is the order number.
1006 sub GetOrderNumber {
1007 my ( $biblionumber,$biblioitemnumber ) = @_;
1008 my $dbh = C4::Context->dbh;
1012 WHERE biblionumber=?
1013 AND biblioitemnumber=?
1015 my $sth = $dbh->prepare($query);
1016 $sth->execute( $biblionumber, $biblioitemnumber );
1018 return $sth->fetchrow;
1021 #------------------------------------------------------------#
1025 $order = &GetOrder($ordernumber);
1027 Looks up an order by order number.
1029 Returns a reference-to-hash describing the order. The keys of
1030 C<$order> are fields from the biblio, biblioitems, aqorders tables of the Koha database.
1035 my ($ordernumber) = @_;
1036 my $dbh = C4::Context->dbh;
1038 SELECT biblioitems.*, biblio.*, aqorders.*
1040 LEFT JOIN biblio on biblio.biblionumber=aqorders.biblionumber
1041 LEFT JOIN biblioitems on biblioitems.biblionumber=aqorders.biblionumber
1042 WHERE aqorders.ordernumber=?
1045 my $sth= $dbh->prepare($query);
1046 $sth->execute($ordernumber);
1047 my $data = $sth->fetchrow_hashref;
1052 =head3 GetLastOrderNotReceivedFromSubscriptionid
1054 $order = &GetLastOrderNotReceivedFromSubscriptionid($subscriptionid);
1056 Returns a reference-to-hash describing the last order not received for a subscription.
1060 sub GetLastOrderNotReceivedFromSubscriptionid {
1061 my ( $subscriptionid ) = @_;
1062 my $dbh = C4::Context->dbh;
1064 SELECT * FROM aqorders
1065 LEFT JOIN subscription
1066 ON ( aqorders.subscriptionid = subscription.subscriptionid )
1067 WHERE aqorders.subscriptionid = ?
1068 AND aqorders.datereceived IS NULL
1071 my $sth = $dbh->prepare( $query );
1072 $sth->execute( $subscriptionid );
1073 my $order = $sth->fetchrow_hashref;
1077 =head3 GetLastOrderReceivedFromSubscriptionid
1079 $order = &GetLastOrderReceivedFromSubscriptionid($subscriptionid);
1081 Returns a reference-to-hash describing the last order received for a subscription.
1085 sub GetLastOrderReceivedFromSubscriptionid {
1086 my ( $subscriptionid ) = @_;
1087 my $dbh = C4::Context->dbh;
1089 SELECT * FROM aqorders
1090 LEFT JOIN subscription
1091 ON ( aqorders.subscriptionid = subscription.subscriptionid )
1092 WHERE aqorders.subscriptionid = ?
1093 AND aqorders.datereceived =
1095 SELECT MAX( aqorders.datereceived )
1097 LEFT JOIN subscription
1098 ON ( aqorders.subscriptionid = subscription.subscriptionid )
1099 WHERE aqorders.subscriptionid = ?
1100 AND aqorders.datereceived IS NOT NULL
1102 ORDER BY ordernumber DESC
1105 my $sth = $dbh->prepare( $query );
1106 $sth->execute( $subscriptionid, $subscriptionid );
1107 my $order = $sth->fetchrow_hashref;
1113 #------------------------------------------------------------#
1117 &NewOrder(\%hashref);
1119 Adds a new order to the database. Any argument that isn't described
1120 below is the new value of the field with the same name in the aqorders
1121 table of the Koha database.
1125 =item $hashref->{'basketno'} is the basketno foreign key in aqorders, it is mandatory
1127 =item $hashref->{'ordernumber'} is a "minimum order number."
1129 =item $hashref->{'budgetdate'} is effectively ignored.
1130 If it's undef (anything false) or the string 'now', the current day is used.
1131 Else, the upcoming July 1st is used.
1133 =item $hashref->{'subscription'} may be either "yes", or anything else for "no".
1135 =item $hashref->{'uncertainprice'} may be 0 for "the price is known" or 1 for "the price is uncertain"
1137 =item defaults entrydate to Now
1139 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".
1146 my $orderinfo = shift;
1147 #### ------------------------------
1148 my $dbh = C4::Context->dbh;
1152 # if these parameters are missing, we can't continue
1153 for my $key (qw/basketno quantity biblionumber budget_id/) {
1154 croak "Mandatory parameter $key missing" unless $orderinfo->{$key};
1157 if ( defined $orderinfo->{subscription} && $orderinfo->{'subscription'} eq 'yes' ) {
1158 $orderinfo->{'subscription'} = 1;
1160 $orderinfo->{'subscription'} = 0;
1162 $orderinfo->{'entrydate'} ||= C4::Dates->new()->output("iso");
1163 if (!$orderinfo->{quantityreceived}) {
1164 $orderinfo->{quantityreceived} = 0;
1167 my $ordernumber=InsertInTable("aqorders",$orderinfo);
1168 if (not $orderinfo->{parent_ordernumber}) {
1169 my $sth = $dbh->prepare("
1171 SET parent_ordernumber = ordernumber
1172 WHERE ordernumber = ?
1174 $sth->execute($ordernumber);
1176 return ( $orderinfo->{'basketno'}, $ordernumber );
1181 #------------------------------------------------------------#
1190 my ($itemnumber, $ordernumber) = @_;
1191 my $dbh = C4::Context->dbh;
1193 INSERT INTO aqorders_items
1194 (itemnumber, ordernumber)
1197 my $sth = $dbh->prepare($query);
1198 $sth->execute( $itemnumber, $ordernumber);
1201 #------------------------------------------------------------#
1205 &ModOrder(\%hashref);
1207 Modifies an existing order. Updates the order with order number
1208 $hashref->{'ordernumber'} and biblionumber $hashref->{'biblionumber'}. All
1209 other keys of the hash update the fields with the same name in the aqorders
1210 table of the Koha database.
1215 my $orderinfo = shift;
1217 die "Ordernumber is required" if $orderinfo->{'ordernumber'} eq '' ;
1218 die "Biblionumber is required" if $orderinfo->{'biblionumber'} eq '';
1220 my $dbh = C4::Context->dbh;
1223 # update uncertainprice to an integer, just in case (under FF, checked boxes have the value "ON" by default)
1224 $orderinfo->{uncertainprice}=1 if $orderinfo->{uncertainprice};
1226 # delete($orderinfo->{'branchcode'});
1227 # the hash contains a lot of entries not in aqorders, so get the columns ...
1228 my $sth = $dbh->prepare("SELECT * FROM aqorders LIMIT 1;");
1230 my $colnames = $sth->{NAME};
1231 #FIXME Be careful. If aqorders would have columns with diacritics,
1232 #you should need to decode what you get back from NAME.
1233 #See report 10110 and guided_reports.pl
1234 my $query = "UPDATE aqorders SET ";
1236 foreach my $orderinfokey (grep(!/ordernumber/, keys %$orderinfo)){
1237 # ... and skip hash entries that are not in the aqorders table
1238 # FIXME : probably not the best way to do it (would be better to have a correct hash)
1239 next unless grep(/^$orderinfokey$/, @$colnames);
1240 $query .= "$orderinfokey=?, ";
1241 push(@params, $orderinfo->{$orderinfokey});
1244 $query .= "timestamp=NOW() WHERE ordernumber=?";
1245 # push(@params, $specorderinfo{'ordernumber'});
1246 push(@params, $orderinfo->{'ordernumber'} );
1247 $sth = $dbh->prepare($query);
1248 $sth->execute(@params);
1252 #------------------------------------------------------------#
1256 &ModOrderItem(\%hashref);
1258 Modifies the itemnumber in the aqorders_items table. The input hash needs three entities:
1262 =item - itemnumber: the old itemnumber
1263 =item - ordernumber: the order this item is attached to
1264 =item - newitemnumber: the new itemnumber we want to attach the line to
1271 my $orderiteminfo = shift;
1272 if (! $orderiteminfo->{'ordernumber'} || ! $orderiteminfo->{'itemnumber'} || ! $orderiteminfo->{'newitemnumber'}){
1273 die "Ordernumber, itemnumber and newitemnumber is required";
1276 my $dbh = C4::Context->dbh;
1278 my $query = "UPDATE aqorders_items set itemnumber=? where itemnumber=? and ordernumber=?";
1279 my @params = ($orderiteminfo->{'newitemnumber'}, $orderiteminfo->{'itemnumber'}, $orderiteminfo->{'ordernumber'});
1280 my $sth = $dbh->prepare($query);
1281 $sth->execute(@params);
1287 ModItemOrder($itemnumber, $ordernumber);
1289 Modifies the ordernumber of an item in aqorders_items.
1294 my ($itemnumber, $ordernumber) = @_;
1296 return unless ($itemnumber and $ordernumber);
1298 my $dbh = C4::Context->dbh;
1300 UPDATE aqorders_items
1302 WHERE itemnumber = ?
1304 my $sth = $dbh->prepare($query);
1305 return $sth->execute($ordernumber, $itemnumber);
1308 #------------------------------------------------------------#
1311 =head3 ModOrderBibliotemNumber
1313 &ModOrderBiblioitemNumber($biblioitemnumber,$ordernumber, $biblionumber);
1315 Modifies the biblioitemnumber for an existing order.
1316 Updates the order with order number C<$ordernum> and biblionumber C<$biblionumber>.
1320 #FIXME: is this used at all?
1321 sub ModOrderBiblioitemNumber {
1322 my ($biblioitemnumber,$ordernumber, $biblionumber) = @_;
1323 my $dbh = C4::Context->dbh;
1326 SET biblioitemnumber = ?
1327 WHERE ordernumber = ?
1328 AND biblionumber = ?";
1329 my $sth = $dbh->prepare($query);
1330 $sth->execute( $biblioitemnumber, $ordernumber, $biblionumber );
1333 =head3 GetCancelledOrders
1335 my @orders = GetCancelledOrders($basketno, $orderby);
1337 Returns cancelled orders for a basket
1341 sub GetCancelledOrders {
1342 my ( $basketno, $orderby ) = @_;
1344 return () unless $basketno;
1346 my $dbh = C4::Context->dbh;
1348 SELECT biblio.*, biblioitems.*, aqorders.*, aqbudgets.*
1350 LEFT JOIN aqbudgets ON aqbudgets.budget_id = aqorders.budget_id
1351 LEFT JOIN biblio ON biblio.biblionumber = aqorders.biblionumber
1352 LEFT JOIN biblioitems ON biblioitems.biblionumber = biblio.biblionumber
1354 AND (datecancellationprinted IS NOT NULL
1355 AND datecancellationprinted <> '0000-00-00')
1358 $orderby = "aqorders.datecancellationprinted desc, aqorders.timestamp desc"
1360 $query .= " ORDER BY $orderby";
1361 my $sth = $dbh->prepare($query);
1362 $sth->execute($basketno);
1363 my $results = $sth->fetchall_arrayref( {} );
1369 #------------------------------------------------------------#
1371 =head3 ModReceiveOrder
1373 &ModReceiveOrder($biblionumber, $ordernumber, $quantityreceived, $user,
1374 $unitprice, $invoiceid, $biblioitemnumber,
1375 $bookfund, $rrp, \@received_itemnumbers);
1377 Updates an order, to reflect the fact that it was received, at least
1378 in part. All arguments not mentioned below update the fields with the
1379 same name in the aqorders table of the Koha database.
1381 If a partial order is received, splits the order into two.
1383 Updates the order with bibilionumber C<$biblionumber> and ordernumber
1389 sub ModReceiveOrder {
1391 $biblionumber, $ordernumber, $quantrec, $user, $cost, $ecost,
1392 $invoiceid, $rrp, $budget_id, $datereceived, $received_items
1396 my $dbh = C4::Context->dbh;
1397 $datereceived = C4::Dates->output('iso') unless $datereceived;
1398 my $suggestionid = GetSuggestionFromBiblionumber( $biblionumber );
1399 if ($suggestionid) {
1400 ModSuggestion( {suggestionid=>$suggestionid,
1401 STATUS=>'AVAILABLE',
1402 biblionumber=> $biblionumber}
1406 my $sth=$dbh->prepare("
1407 SELECT * FROM aqorders
1408 WHERE biblionumber=? AND aqorders.ordernumber=?");
1410 $sth->execute($biblionumber,$ordernumber);
1411 my $order = $sth->fetchrow_hashref();
1414 my $new_ordernumber = $ordernumber;
1415 if ( $order->{quantity} > $quantrec ) {
1416 # Split order line in two parts: the first is the original order line
1417 # without received items (the quantity is decreased),
1418 # the second part is a new order line with quantity=quantityrec
1419 # (entirely received)
1420 $sth=$dbh->prepare("
1423 WHERE ordernumber = ?
1426 $sth->execute($order->{quantity} - $quantrec, $ordernumber);
1430 delete $order->{'ordernumber'};
1431 $order->{'quantity'} = $quantrec;
1432 $order->{'quantityreceived'} = $quantrec;
1433 $order->{'datereceived'} = $datereceived;
1434 $order->{'invoiceid'} = $invoiceid;
1435 $order->{'unitprice'} = $cost;
1436 $order->{'rrp'} = $rrp;
1437 $order->{ecost} = $ecost;
1438 $order->{'orderstatus'} = 3; # totally received
1439 $new_ordernumber = NewOrder($order);
1441 if ($received_items) {
1442 foreach my $itemnumber (@$received_items) {
1443 ModItemOrder($itemnumber, $new_ordernumber);
1447 $sth=$dbh->prepare("update aqorders
1448 set quantityreceived=?,datereceived=?,invoiceid=?,
1449 unitprice=?,rrp=?,ecost=?
1450 where biblionumber=? and ordernumber=?");
1451 $sth->execute($quantrec,$datereceived,$invoiceid,$cost,$rrp,$ecost,$biblionumber,$ordernumber);
1454 return ($datereceived, $new_ordernumber);
1457 =head3 CancelReceipt
1459 my $parent_ordernumber = CancelReceipt($ordernumber);
1461 Cancel an order line receipt and update the parent order line, as if no
1463 If items are created at receipt (AcqCreateItem = receiving) then delete
1469 my $ordernumber = shift;
1471 return unless $ordernumber;
1473 my $dbh = C4::Context->dbh;
1475 SELECT datereceived, parent_ordernumber, quantity
1477 WHERE ordernumber = ?
1479 my $sth = $dbh->prepare($query);
1480 $sth->execute($ordernumber);
1481 my $order = $sth->fetchrow_hashref;
1483 warn "CancelReceipt: order $ordernumber does not exist";
1486 unless($order->{'datereceived'}) {
1487 warn "CancelReceipt: order $ordernumber is not received";
1491 my $parent_ordernumber = $order->{'parent_ordernumber'};
1493 if($parent_ordernumber == $ordernumber || not $parent_ordernumber) {
1494 # The order line has no parent, just mark it as not received
1497 SET quantityreceived = ?,
1500 WHERE ordernumber = ?
1502 $sth = $dbh->prepare($query);
1503 $sth->execute(0, undef, undef, $ordernumber);
1505 # The order line has a parent, increase parent quantity and delete
1508 SELECT quantity, datereceived
1510 WHERE ordernumber = ?
1512 $sth = $dbh->prepare($query);
1513 $sth->execute($parent_ordernumber);
1514 my $parent_order = $sth->fetchrow_hashref;
1515 unless($parent_order) {
1516 warn "Parent order $parent_ordernumber does not exist.";
1519 if($parent_order->{'datereceived'}) {
1520 warn "CancelReceipt: parent order is received.".
1521 " Can't cancel receipt.";
1527 WHERE ordernumber = ?
1529 $sth = $dbh->prepare($query);
1530 my $rv = $sth->execute(
1531 $order->{'quantity'} + $parent_order->{'quantity'},
1535 warn "Cannot update parent order line, so do not cancel".
1539 if(C4::Context->preference('AcqCreateItem') eq 'receiving') {
1540 # Remove items that were created at receipt
1542 DELETE FROM items, aqorders_items
1543 USING items, aqorders_items
1544 WHERE items.itemnumber = ? AND aqorders_items.itemnumber = ?
1546 $sth = $dbh->prepare($query);
1547 my @itemnumbers = GetItemnumbersFromOrder($ordernumber);
1548 foreach my $itemnumber (@itemnumbers) {
1549 $sth->execute($itemnumber, $itemnumber);
1553 my @itemnumbers = GetItemnumbersFromOrder($ordernumber);
1554 foreach my $itemnumber (@itemnumbers) {
1555 ModItemOrder($itemnumber, $parent_ordernumber);
1560 DELETE FROM aqorders
1561 WHERE ordernumber = ?
1563 $sth = $dbh->prepare($query);
1564 $sth->execute($ordernumber);
1568 return $parent_ordernumber;
1571 #------------------------------------------------------------#
1575 @results = &SearchOrder($search, $biblionumber, $complete);
1577 Searches for orders.
1579 C<$search> may take one of several forms: if it is an ISBN,
1580 C<&ordersearch> returns orders with that ISBN. If C<$search> is an
1581 order number, C<&ordersearch> returns orders with that order number
1582 and biblionumber C<$biblionumber>. Otherwise, C<$search> is considered
1583 to be a space-separated list of search terms; in this case, all of the
1584 terms must appear in the title (matching the beginning of title
1587 If C<$complete> is C<yes>, the results will include only completed
1588 orders. In any case, C<&ordersearch> ignores cancelled orders.
1590 C<&ordersearch> returns an array.
1591 C<@results> is an array of references-to-hash with the following keys:
1597 =item C<seriestitle>
1608 #### -------- SearchOrder-------------------------------
1609 my ( $ordernumber, $search, $ean, $supplierid, $basket ) = @_;
1611 my $dbh = C4::Context->dbh;
1616 LEFT JOIN biblio ON aqorders.biblionumber=biblio.biblionumber
1617 LEFT JOIN biblioitems ON biblioitems.biblionumber=biblio.biblionumber
1618 LEFT JOIN aqbasket ON aqorders.basketno = aqbasket.basketno
1619 WHERE (datecancellationprinted is NULL)";
1622 $query .= " AND (aqorders.ordernumber=?)";
1623 push @args, $ordernumber;
1626 $query .= " AND (biblio.title like ? OR biblio.author LIKE ? OR biblioitems.isbn like ?)";
1627 push @args, ("%$search%","%$search%","%$search%");
1630 $query .= " AND biblioitems.ean = ?";
1634 $query .= "AND aqbasket.booksellerid = ?";
1635 push @args, $supplierid;
1638 $query .= "AND aqorders.basketno = ?";
1639 push @args, $basket;
1642 my $sth = $dbh->prepare($query);
1643 $sth->execute(@args);
1644 my $results = $sth->fetchall_arrayref({});
1649 #------------------------------------------------------------#
1653 &DelOrder($biblionumber, $ordernumber);
1655 Cancel the order with the given order and biblio numbers. It does not
1656 delete any entries in the aqorders table, it merely marks them as
1662 my ( $bibnum, $ordernumber ) = @_;
1663 my $dbh = C4::Context->dbh;
1666 SET datecancellationprinted=now()
1667 WHERE biblionumber=? AND ordernumber=?
1669 my $sth = $dbh->prepare($query);
1670 $sth->execute( $bibnum, $ordernumber );
1672 my @itemnumbers = GetItemnumbersFromOrder( $ordernumber );
1673 foreach my $itemnumber (@itemnumbers){
1674 C4::Items::DelItem( $dbh, $bibnum, $itemnumber );
1679 =head2 FUNCTIONS ABOUT PARCELS
1683 #------------------------------------------------------------#
1687 @results = &GetParcel($booksellerid, $code, $date);
1689 Looks up all of the received items from the supplier with the given
1690 bookseller ID at the given date, for the given code (bookseller Invoice number). Ignores cancelled and completed orders.
1692 C<@results> is an array of references-to-hash. The keys of each element are fields from
1693 the aqorders, biblio, and biblioitems tables of the Koha database.
1695 C<@results> is sorted alphabetically by book title.
1700 #gets all orders from a certain supplier, orders them alphabetically
1701 my ( $supplierid, $code, $datereceived ) = @_;
1702 my $dbh = C4::Context->dbh;
1705 if $code; # add % if we search on a given code (otherwise, let him empty)
1707 SELECT authorisedby,
1712 aqorders.biblionumber,
1713 aqorders.ordernumber,
1714 aqorders.parent_ordernumber,
1716 aqorders.quantityreceived,
1724 LEFT JOIN aqbasket ON aqbasket.basketno=aqorders.basketno
1725 LEFT JOIN borrowers ON aqbasket.authorisedby=borrowers.borrowernumber
1726 LEFT JOIN biblio ON aqorders.biblionumber=biblio.biblionumber
1727 LEFT JOIN aqinvoices ON aqorders.invoiceid = aqinvoices.invoiceid
1729 aqbasket.booksellerid = ?
1730 AND aqinvoices.invoicenumber LIKE ?
1731 AND aqorders.datereceived = ? ";
1733 my @query_params = ( $supplierid, $code, $datereceived );
1734 if ( C4::Context->preference("IndependantBranches") ) {
1735 my $userenv = C4::Context->userenv;
1736 if ( ($userenv) && ( $userenv->{flags} != 1 ) ) {
1737 $strsth .= " and (borrowers.branchcode = ?
1738 or borrowers.branchcode = '')";
1739 push @query_params, $userenv->{branch};
1742 $strsth .= " ORDER BY aqbasket.basketno";
1743 # ## parcelinformation : $strsth
1744 my $sth = $dbh->prepare($strsth);
1745 $sth->execute( @query_params );
1746 while ( my $data = $sth->fetchrow_hashref ) {
1747 push( @results, $data );
1749 # ## countparcelbiblio: scalar(@results)
1755 #------------------------------------------------------------#
1759 $results = &GetParcels($bookseller, $order, $code, $datefrom, $dateto);
1761 get a lists of parcels.
1768 is the bookseller this function has to get parcels.
1771 To know on what criteria the results list has to be ordered.
1774 is the booksellerinvoicenumber.
1776 =item $datefrom & $dateto
1777 to know on what date this function has to filter its search.
1782 a pointer on a hash list containing parcel informations as such :
1788 =item Last operation
1790 =item Number of biblio
1792 =item Number of items
1799 my ($bookseller,$order, $code, $datefrom, $dateto) = @_;
1800 my $dbh = C4::Context->dbh;
1801 my @query_params = ();
1803 SELECT aqinvoices.invoicenumber,
1804 datereceived,purchaseordernumber,
1805 count(DISTINCT biblionumber) AS biblio,
1806 sum(quantity) AS itemsexpected,
1807 sum(quantityreceived) AS itemsreceived
1808 FROM aqorders LEFT JOIN aqbasket ON aqbasket.basketno = aqorders.basketno
1809 LEFT JOIN aqinvoices ON aqorders.invoiceid = aqinvoices.invoiceid
1810 WHERE aqbasket.booksellerid = ? and datereceived IS NOT NULL
1812 push @query_params, $bookseller;
1814 if ( defined $code ) {
1815 $strsth .= ' and aqinvoices.invoicenumber like ? ';
1816 # add a % to the end of the code to allow stemming.
1817 push @query_params, "$code%";
1820 if ( defined $datefrom ) {
1821 $strsth .= ' and datereceived >= ? ';
1822 push @query_params, $datefrom;
1825 if ( defined $dateto ) {
1826 $strsth .= 'and datereceived <= ? ';
1827 push @query_params, $dateto;
1830 $strsth .= "group by aqinvoices.invoicenumber,datereceived ";
1832 # can't use a placeholder to place this column name.
1833 # but, we could probably be checking to make sure it is a column that will be fetched.
1834 $strsth .= "order by $order " if ($order);
1836 my $sth = $dbh->prepare($strsth);
1838 $sth->execute( @query_params );
1839 my $results = $sth->fetchall_arrayref({});
1844 #------------------------------------------------------------#
1846 =head3 GetLateOrders
1848 @results = &GetLateOrders;
1850 Searches for bookseller with late orders.
1853 the table of supplier with late issues. This table is full of hashref.
1859 my $supplierid = shift;
1861 my $estimateddeliverydatefrom = shift;
1862 my $estimateddeliverydateto = shift;
1864 my $dbh = C4::Context->dbh;
1866 #BEWARE, order of parenthesis and LEFT JOIN is important for speed
1867 my $dbdriver = C4::Context->config("db_scheme") || "mysql";
1869 my @query_params = ();
1871 SELECT aqbasket.basketno,
1872 aqorders.ordernumber,
1873 DATE(aqbasket.closedate) AS orderdate,
1874 aqorders.rrp AS unitpricesupplier,
1875 aqorders.ecost AS unitpricelib,
1876 aqorders.claims_count AS claims_count,
1877 aqorders.claimed_date AS claimed_date,
1878 aqbudgets.budget_name AS budget,
1879 borrowers.branchcode AS branch,
1880 aqbooksellers.name AS supplier,
1881 aqbooksellers.id AS supplierid,
1882 biblio.author, biblio.title,
1883 biblioitems.publishercode AS publisher,
1884 biblioitems.publicationyear,
1885 ADDDATE(aqbasket.closedate, INTERVAL aqbooksellers.deliverytime DAY) AS estimateddeliverydate,
1889 aqorders LEFT JOIN biblio ON biblio.biblionumber = aqorders.biblionumber
1890 LEFT JOIN biblioitems ON biblioitems.biblionumber = biblio.biblionumber
1891 LEFT JOIN aqbudgets ON aqorders.budget_id = aqbudgets.budget_id,
1892 aqbasket LEFT JOIN borrowers ON aqbasket.authorisedby = borrowers.borrowernumber
1893 LEFT JOIN aqbooksellers ON aqbasket.booksellerid = aqbooksellers.id
1894 WHERE aqorders.basketno = aqbasket.basketno
1895 AND ( datereceived = ''
1896 OR datereceived IS NULL
1897 OR aqorders.quantityreceived < aqorders.quantity
1899 AND aqbasket.closedate IS NOT NULL
1900 AND (aqorders.datecancellationprinted IS NULL OR aqorders.datecancellationprinted='0000-00-00')
1903 if ($dbdriver eq "mysql") {
1905 aqorders.quantity - COALESCE(aqorders.quantityreceived,0) AS quantity,
1906 (aqorders.quantity - COALESCE(aqorders.quantityreceived,0)) * aqorders.rrp AS subtotal,
1907 DATEDIFF(CAST(now() AS date),closedate) AS latesince
1909 if ( defined $delay ) {
1910 $from .= " AND (closedate <= DATE_SUB(CAST(now() AS date),INTERVAL ? DAY)) " ;
1911 push @query_params, $delay;
1914 HAVING quantity <> 0
1915 AND unitpricesupplier <> 0
1916 AND unitpricelib <> 0
1919 # FIXME: account for IFNULL as above
1921 aqorders.quantity AS quantity,
1922 aqorders.quantity * aqorders.rrp AS subtotal,
1923 (CAST(now() AS date) - closedate) AS latesince
1925 if ( defined $delay ) {
1926 $from .= " AND (closedate <= (CAST(now() AS date) -(INTERVAL ? DAY)) ";
1927 push @query_params, $delay;
1930 if (defined $supplierid) {
1931 $from .= ' AND aqbasket.booksellerid = ? ';
1932 push @query_params, $supplierid;
1934 if (defined $branch) {
1935 $from .= ' AND borrowers.branchcode LIKE ? ';
1936 push @query_params, $branch;
1939 if ( defined $estimateddeliverydatefrom or defined $estimateddeliverydateto ) {
1940 $from .= ' AND aqbooksellers.deliverytime IS NOT NULL ';
1942 if ( defined $estimateddeliverydatefrom ) {
1943 $from .= ' AND ADDDATE(aqbasket.closedate, INTERVAL aqbooksellers.deliverytime DAY) >= ?';
1944 push @query_params, $estimateddeliverydatefrom;
1946 if ( defined $estimateddeliverydateto ) {
1947 $from .= ' AND ADDDATE(aqbasket.closedate, INTERVAL aqbooksellers.deliverytime DAY) <= ?';
1948 push @query_params, $estimateddeliverydateto;
1950 if ( defined $estimateddeliverydatefrom and not defined $estimateddeliverydateto ) {
1951 $from .= ' AND ADDDATE(aqbasket.closedate, INTERVAL aqbooksellers.deliverytime DAY) <= CAST(now() AS date)';
1953 if (C4::Context->preference("IndependantBranches")
1954 && C4::Context->userenv
1955 && C4::Context->userenv->{flags} != 1 ) {
1956 $from .= ' AND borrowers.branchcode LIKE ? ';
1957 push @query_params, C4::Context->userenv->{branch};
1959 my $query = "$select $from $having\nORDER BY latesince, basketno, borrowers.branchcode, supplier";
1960 $debug and print STDERR "GetLateOrders query: $query\nGetLateOrders args: " . join(" ",@query_params);
1961 my $sth = $dbh->prepare($query);
1962 $sth->execute(@query_params);
1964 while (my $data = $sth->fetchrow_hashref) {
1965 $data->{orderdate} = format_date($data->{orderdate});
1966 $data->{claimed_date} = format_date($data->{claimed_date});
1967 push @results, $data;
1972 #------------------------------------------------------------#
1976 (\@order_loop, $total_qty, $total_price, $total_qtyreceived) = GetHistory( %params );
1978 Retreives some acquisition history information
1986 basket - search both basket name and number
1987 booksellerinvoicenumber
1990 $order_loop is a list of hashrefs that each look like this:
1992 'author' => 'Twain, Mark',
1994 'biblionumber' => '215',
1996 'creationdate' => 'MM/DD/YYYY',
1997 'datereceived' => undef,
2000 'invoicenumber' => undef,
2002 'ordernumber' => '1',
2004 'quantityreceived' => undef,
2005 'title' => 'The Adventures of Huckleberry Finn'
2007 $total_qty is the sum of all of the quantities in $order_loop
2008 $total_price is the cost of each in $order_loop times the quantity
2009 $total_qtyreceived is the sum of all of the quantityreceived entries in $order_loop
2014 # don't run the query if there are no parameters (list would be too long for sure !)
2015 croak "No search params" unless @_;
2017 my $title = $params{title};
2018 my $author = $params{author};
2019 my $isbn = $params{isbn};
2020 my $ean = $params{ean};
2021 my $name = $params{name};
2022 my $from_placed_on = $params{from_placed_on};
2023 my $to_placed_on = $params{to_placed_on};
2024 my $basket = $params{basket};
2025 my $booksellerinvoicenumber = $params{booksellerinvoicenumber};
2026 my $basketgroupname = $params{basketgroupname};
2029 my $total_qtyreceived = 0;
2030 my $total_price = 0;
2032 my $dbh = C4::Context->dbh;
2040 aqbasket.basketname,
2041 aqbasket.basketgroupid,
2042 aqbasketgroups.name as groupname,
2044 aqbasket.creationdate,
2045 aqorders.datereceived,
2047 aqorders.quantityreceived,
2049 aqorders.ordernumber,
2050 aqinvoices.invoicenumber,
2051 aqbooksellers.id as id,
2052 aqorders.biblionumber
2054 LEFT JOIN aqbasket ON aqorders.basketno=aqbasket.basketno
2055 LEFT JOIN aqbasketgroups ON aqbasket.basketgroupid=aqbasketgroups.id
2056 LEFT JOIN aqbooksellers ON aqbasket.booksellerid=aqbooksellers.id
2057 LEFT JOIN biblioitems ON biblioitems.biblionumber=aqorders.biblionumber
2058 LEFT JOIN biblio ON biblio.biblionumber=aqorders.biblionumber
2059 LEFT JOIN aqinvoices ON aqorders.invoiceid = aqinvoices.invoiceid";
2061 $query .= " LEFT JOIN borrowers ON aqbasket.authorisedby=borrowers.borrowernumber"
2062 if ( C4::Context->preference("IndependantBranches") );
2064 $query .= " WHERE (datecancellationprinted is NULL or datecancellationprinted='0000-00-00') ";
2066 my @query_params = ();
2069 $query .= " AND biblio.title LIKE ? ";
2070 $title =~ s/\s+/%/g;
2071 push @query_params, "%$title%";
2075 $query .= " AND biblio.author LIKE ? ";
2076 push @query_params, "%$author%";
2080 $query .= " AND biblioitems.isbn LIKE ? ";
2081 push @query_params, "%$isbn%";
2083 if ( defined $ean and $ean ) {
2084 $query .= " AND biblioitems.ean = ? ";
2085 push @query_params, "$ean";
2088 $query .= " AND aqbooksellers.name LIKE ? ";
2089 push @query_params, "%$name%";
2092 if ( $from_placed_on ) {
2093 $query .= " AND creationdate >= ? ";
2094 push @query_params, $from_placed_on;
2097 if ( $to_placed_on ) {
2098 $query .= " AND creationdate <= ? ";
2099 push @query_params, $to_placed_on;
2103 if ($basket =~ m/^\d+$/) {
2104 $query .= " AND aqorders.basketno = ? ";
2105 push @query_params, $basket;
2107 $query .= " AND aqbasket.basketname LIKE ? ";
2108 push @query_params, "%$basket%";
2112 if ($booksellerinvoicenumber) {
2113 $query .= " AND aqinvoices.invoicenumber LIKE ? ";
2114 push @query_params, "%$booksellerinvoicenumber%";
2117 if ($basketgroupname) {
2118 $query .= " AND aqbasketgroups.name LIKE ? ";
2119 push @query_params, "%$basketgroupname%";
2122 if ( C4::Context->preference("IndependantBranches") ) {
2123 my $userenv = C4::Context->userenv;
2124 if ( $userenv && ($userenv->{flags} || 0) != 1 ) {
2125 $query .= " AND (borrowers.branchcode = ? OR borrowers.branchcode ='' ) ";
2126 push @query_params, $userenv->{branch};
2129 $query .= " ORDER BY id";
2130 my $sth = $dbh->prepare($query);
2131 $sth->execute( @query_params );
2133 while ( my $line = $sth->fetchrow_hashref ) {
2134 $line->{count} = $cnt++;
2135 $line->{toggle} = 1 if $cnt % 2;
2136 push @order_loop, $line;
2137 $total_qty += $line->{'quantity'};
2138 $total_qtyreceived += $line->{'quantityreceived'};
2139 $total_price += $line->{'quantity'} * $line->{'ecost'};
2141 return \@order_loop, $total_qty, $total_price, $total_qtyreceived;
2144 =head2 GetRecentAcqui
2146 $results = GetRecentAcqui($days);
2148 C<$results> is a ref to a table which containts hashref
2152 sub GetRecentAcqui {
2154 my $dbh = C4::Context->dbh;
2158 ORDER BY timestamp DESC
2161 my $sth = $dbh->prepare($query);
2163 my $results = $sth->fetchall_arrayref({});
2169 $contractlist = &GetContracts($booksellerid, $activeonly);
2171 Looks up the contracts that belong to a bookseller
2173 Returns a list of contracts
2177 =item C<$booksellerid> is the "id" field in the "aqbooksellers" table.
2179 =item C<$activeonly> if exists get only contracts that are still active.
2186 my ( $booksellerid, $activeonly ) = @_;
2187 my $dbh = C4::Context->dbh;
2189 if (! $activeonly) {
2193 WHERE booksellerid=?
2198 WHERE booksellerid=?
2199 AND contractenddate >= CURDATE( )";
2201 my $sth = $dbh->prepare($query);
2202 $sth->execute( $booksellerid );
2204 while (my $data = $sth->fetchrow_hashref ) {
2205 push(@results, $data);
2211 #------------------------------------------------------------#
2215 $contract = &GetContract($contractID);
2217 Looks up the contract that has PRIMKEY (contractnumber) value $contractID
2224 my ( $contractno ) = @_;
2225 my $dbh = C4::Context->dbh;
2229 WHERE contractnumber=?
2232 my $sth = $dbh->prepare($query);
2233 $sth->execute( $contractno );
2234 my $result = $sth->fetchrow_hashref;
2242 &AddClaim($ordernumber);
2244 Add a claim for an order
2250 my ($ordernumber) = @_;
2251 my $dbh = C4::Context->dbh;
2254 claims_count = claims_count + 1,
2255 claimed_date = CURDATE()
2256 WHERE ordernumber = ?
2258 my $sth = $dbh->prepare($query);
2259 $sth->execute($ordernumber);
2264 my @invoices = GetInvoices(
2265 invoicenumber => $invoicenumber,
2266 suppliername => $suppliername,
2267 shipmentdatefrom => $shipmentdatefrom, # ISO format
2268 shipmentdateto => $shipmentdateto, # ISO format
2269 billingdatefrom => $billingdatefrom, # ISO format
2270 billingdateto => $billingdateto, # ISO format
2271 isbneanissn => $isbn_or_ean_or_issn,
2274 publisher => $publisher,
2275 publicationyear => $publicationyear,
2276 branchcode => $branchcode,
2277 order_by => $order_by
2280 Return a list of invoices that match all given criteria.
2282 $order_by is "column_name (asc|desc)", where column_name is any of
2283 'invoicenumber', 'booksellerid', 'shipmentdate', 'billingdate', 'closedate',
2284 'shipmentcost', 'shipmentcost_budgetid'.
2286 asc is the default if omitted
2293 my @columns = qw(invoicenumber booksellerid shipmentdate billingdate
2294 closedate shipmentcost shipmentcost_budgetid);
2296 my $dbh = C4::Context->dbh;
2298 SELECT aqinvoices.*, aqbooksellers.name AS suppliername,
2301 aqorders.datereceived IS NOT NULL,
2302 aqorders.biblionumber,
2305 ) AS receivedbiblios,
2306 SUM(aqorders.quantityreceived) AS receiveditems
2308 LEFT JOIN aqbooksellers ON aqbooksellers.id = aqinvoices.booksellerid
2309 LEFT JOIN aqorders ON aqorders.invoiceid = aqinvoices.invoiceid
2310 LEFT JOIN biblio ON aqorders.biblionumber = biblio.biblionumber
2311 LEFT JOIN biblioitems ON biblio.biblionumber = biblioitems.biblionumber
2312 LEFT JOIN subscription ON biblio.biblionumber = subscription.biblionumber
2317 if($args{supplierid}) {
2318 push @bind_strs, " aqinvoices.booksellerid = ? ";
2319 push @bind_args, $args{supplierid};
2321 if($args{invoicenumber}) {
2322 push @bind_strs, " aqinvoices.invoicenumber LIKE ? ";
2323 push @bind_args, "%$args{invoicenumber}%";
2325 if($args{suppliername}) {
2326 push @bind_strs, " aqbooksellers.name LIKE ? ";
2327 push @bind_args, "%$args{suppliername}%";
2329 if($args{shipmentdatefrom}) {
2330 push @bind_strs, " aqinvoices.shipementdate >= ? ";
2331 push @bind_args, $args{shipmentdatefrom};
2333 if($args{shipmentdateto}) {
2334 push @bind_strs, " aqinvoices.shipementdate <= ? ";
2335 push @bind_args, $args{shipmentdateto};
2337 if($args{billingdatefrom}) {
2338 push @bind_strs, " aqinvoices.billingdate >= ? ";
2339 push @bind_args, $args{billingdatefrom};
2341 if($args{billingdateto}) {
2342 push @bind_strs, " aqinvoices.billingdate <= ? ";
2343 push @bind_args, $args{billingdateto};
2345 if($args{isbneanissn}) {
2346 push @bind_strs, " (biblioitems.isbn LIKE ? OR biblioitems.ean LIKE ? OR biblioitems.issn LIKE ? ) ";
2347 push @bind_args, $args{isbneanissn}, $args{isbneanissn}, $args{isbneanissn};
2350 push @bind_strs, " biblio.title LIKE ? ";
2351 push @bind_args, $args{title};
2354 push @bind_strs, " biblio.author LIKE ? ";
2355 push @bind_args, $args{author};
2357 if($args{publisher}) {
2358 push @bind_strs, " biblioitems.publishercode LIKE ? ";
2359 push @bind_args, $args{publisher};
2361 if($args{publicationyear}) {
2362 push @bind_strs, " biblioitems.publicationyear = ? ";
2363 push @bind_args, $args{publicationyear};
2365 if($args{branchcode}) {
2366 push @bind_strs, " aqorders.branchcode = ? ";
2367 push @bind_args, $args{branchcode};
2370 $query .= " WHERE " . join(" AND ", @bind_strs) if @bind_strs;
2371 $query .= " GROUP BY aqinvoices.invoiceid ";
2373 if($args{order_by}) {
2374 my ($column, $direction) = split / /, $args{order_by};
2375 if(grep /^$column$/, @columns) {
2376 $direction ||= 'ASC';
2377 $query .= " ORDER BY $column $direction";
2381 my $sth = $dbh->prepare($query);
2382 $sth->execute(@bind_args);
2384 my $results = $sth->fetchall_arrayref({});
2390 my $invoice = GetInvoice($invoiceid);
2392 Get informations about invoice with given $invoiceid
2394 Return a hash filled with aqinvoices.* fields
2399 my ($invoiceid) = @_;
2402 return unless $invoiceid;
2404 my $dbh = C4::Context->dbh;
2410 my $sth = $dbh->prepare($query);
2411 $sth->execute($invoiceid);
2413 $invoice = $sth->fetchrow_hashref;
2417 =head3 GetInvoiceDetails
2419 my $invoice = GetInvoiceDetails($invoiceid)
2421 Return informations about an invoice + the list of related order lines
2423 Orders informations are in $invoice->{orders} (array ref)
2427 sub GetInvoiceDetails {
2428 my ($invoiceid) = @_;
2430 if ( !defined $invoiceid ) {
2431 carp 'GetInvoiceDetails called without an invoiceid';
2435 my $dbh = C4::Context->dbh;
2437 SELECT aqinvoices.*, aqbooksellers.name AS suppliername
2439 LEFT JOIN aqbooksellers ON aqinvoices.booksellerid = aqbooksellers.id
2442 my $sth = $dbh->prepare($query);
2443 $sth->execute($invoiceid);
2445 my $invoice = $sth->fetchrow_hashref;
2448 SELECT aqorders.*, biblio.*
2450 LEFT JOIN biblio ON aqorders.biblionumber = biblio.biblionumber
2453 $sth = $dbh->prepare($query);
2454 $sth->execute($invoiceid);
2455 $invoice->{orders} = $sth->fetchall_arrayref({});
2456 $invoice->{orders} ||= []; # force an empty arrayref if fetchall_arrayref fails
2463 my $invoiceid = AddInvoice(
2464 invoicenumber => $invoicenumber,
2465 booksellerid => $booksellerid,
2466 shipmentdate => $shipmentdate,
2467 billingdate => $billingdate,
2468 closedate => $closedate,
2469 shipmentcost => $shipmentcost,
2470 shipmentcost_budgetid => $shipmentcost_budgetid
2473 Create a new invoice and return its id or undef if it fails.
2480 return unless(%invoice and $invoice{invoicenumber});
2482 my @columns = qw(invoicenumber booksellerid shipmentdate billingdate
2483 closedate shipmentcost shipmentcost_budgetid);
2487 foreach my $key (keys %invoice) {
2488 if(0 < grep(/^$key$/, @columns)) {
2489 push @set_strs, "$key = ?";
2490 push @set_args, ($invoice{$key} || undef);
2496 my $dbh = C4::Context->dbh;
2497 my $query = "INSERT INTO aqinvoices SET ";
2498 $query .= join (",", @set_strs);
2499 my $sth = $dbh->prepare($query);
2500 $rv = $sth->execute(@set_args);
2502 $rv = $dbh->last_insert_id(undef, undef, 'aqinvoices', undef);
2511 invoiceid => $invoiceid, # Mandatory
2512 invoicenumber => $invoicenumber,
2513 booksellerid => $booksellerid,
2514 shipmentdate => $shipmentdate,
2515 billingdate => $billingdate,
2516 closedate => $closedate,
2517 shipmentcost => $shipmentcost,
2518 shipmentcost_budgetid => $shipmentcost_budgetid
2521 Modify an invoice, invoiceid is mandatory.
2523 Return undef if it fails.
2530 return unless(%invoice and $invoice{invoiceid});
2532 my @columns = qw(invoicenumber booksellerid shipmentdate billingdate
2533 closedate shipmentcost shipmentcost_budgetid);
2537 foreach my $key (keys %invoice) {
2538 if(0 < grep(/^$key$/, @columns)) {
2539 push @set_strs, "$key = ?";
2540 push @set_args, ($invoice{$key} || undef);
2544 my $dbh = C4::Context->dbh;
2545 my $query = "UPDATE aqinvoices SET ";
2546 $query .= join(",", @set_strs);
2547 $query .= " WHERE invoiceid = ?";
2549 my $sth = $dbh->prepare($query);
2550 $sth->execute(@set_args, $invoice{invoiceid});
2555 CloseInvoice($invoiceid);
2559 Equivalent to ModInvoice(invoiceid => $invoiceid, closedate => undef);
2564 my ($invoiceid) = @_;
2566 return unless $invoiceid;
2568 my $dbh = C4::Context->dbh;
2571 SET closedate = CAST(NOW() AS DATE)
2574 my $sth = $dbh->prepare($query);
2575 $sth->execute($invoiceid);
2578 =head3 ReopenInvoice
2580 ReopenInvoice($invoiceid);
2584 Equivalent to ModInvoice(invoiceid => $invoiceid, closedate => C4::Dates->new()->output('iso'))
2589 my ($invoiceid) = @_;
2591 return unless $invoiceid;
2593 my $dbh = C4::Context->dbh;
2596 SET closedate = NULL
2599 my $sth = $dbh->prepare($query);
2600 $sth->execute($invoiceid);
2608 Koha Development Team <http://koha-community.org/>