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
57 &GetOrderNumber &GetLateOrders &GetOrderFromItemnumber
58 &SearchOrder &GetHistory &GetRecentAcqui
59 &ModReceiveOrder &CancelReceipt &ModOrderBiblioitemNumber
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, $basketbooksellernote, $basketcontractnumber, $deliveryplace, $billingplace ) = @_;
194 my $dbh = C4
::Context
->dbh;
197 (creationdate,booksellerid,authorisedby)
198 VALUES (now(),'$booksellerid','$authorisedby')
202 #find & return basketno MYSQL dependant, but $dbh->last_insert_id always returns null :-(
203 my $basket = $dbh->{'mysql_insertid'};
204 ModBasketHeader
($basket, $basketname || '', $basketnote || '', $basketbooksellernote || '', $basketcontractnumber || undef, $booksellerid, $deliveryplace || undef, $billingplace || undef );
208 #------------------------------------------------------------#
212 &CloseBasket($basketno);
214 close a basket (becomes unmodifiable,except for recieves)
220 my $dbh = C4
::Context
->dbh;
226 my $sth = $dbh->prepare($query);
227 $sth->execute($basketno);
230 #------------------------------------------------------------#
232 =head3 GetBasketAsCSV
234 &GetBasketAsCSV($basketno);
236 Export a basket as CSV
238 $cgi parameter is needed for column name translation
243 my ($basketno, $cgi) = @_;
244 my $basket = GetBasket
($basketno);
245 my @orders = GetOrders
($basketno);
246 my $contract = GetContract
($basket->{'contractnumber'});
248 my $template = C4
::Templates
::gettemplate
("acqui/csv/basket.tmpl", "intranet", $cgi);
251 foreach my $order (@orders) {
252 my $bd = GetBiblioData
( $order->{'biblionumber'} );
254 contractname
=> $contract->{'contractname'},
255 ordernumber
=> $order->{'ordernumber'},
256 entrydate
=> $order->{'entrydate'},
257 isbn
=> $order->{'isbn'},
258 author
=> $bd->{'author'},
259 title
=> $bd->{'title'},
260 publicationyear
=> $bd->{'publicationyear'},
261 publishercode
=> $bd->{'publishercode'},
262 collectiontitle
=> $bd->{'collectiontitle'},
263 notes
=> $order->{'notes'},
264 quantity
=> $order->{'quantity'},
265 rrp
=> $order->{'rrp'},
266 deliveryplace
=> C4
::Branch
::GetBranchName
( $basket->{'deliveryplace'} ),
267 billingplace
=> C4
::Branch
::GetBranchName
( $basket->{'billingplace'} ),
270 contractname author title publishercode collectiontitle notes
271 deliveryplace billingplace
273 # Double the quotes to not be interpreted as a field end
274 $row->{$_} =~ s/"/""/g if $row->{$_};
280 if(defined $a->{publishercode
} and defined $b->{publishercode
}) {
281 $a->{publishercode
} cmp $b->{publishercode
};
285 $template->param(rows
=> \
@rows);
287 return $template->output;
291 =head3 GetBasketGroupAsCSV
295 &GetBasketGroupAsCSV($basketgroupid);
297 Export a basket group as CSV
299 $cgi parameter is needed for column name translation
305 sub GetBasketGroupAsCSV
{
306 my ($basketgroupid, $cgi) = @_;
307 my $baskets = GetBasketsByBasketgroup
($basketgroupid);
309 my $template = C4
::Templates
::gettemplate
('acqui/csv/basketgroup.tmpl', 'intranet', $cgi);
312 for my $basket (@
$baskets) {
313 my @orders = GetOrders
( $$basket{basketno
} );
314 my $contract = GetContract
( $$basket{contractnumber
} );
315 my $bookseller = GetBookSellerFromId
( $$basket{booksellerid
} );
316 my $basketgroup = GetBasketgroup
( $$basket{basketgroupid
} );
318 foreach my $order (@orders) {
319 my $bd = GetBiblioData
( $order->{'biblionumber'} );
321 clientnumber
=> $bookseller->{accountnumber
},
322 basketname
=> $basket->{basketname
},
323 ordernumber
=> $order->{ordernumber
},
324 author
=> $bd->{author
},
325 title
=> $bd->{title
},
326 publishercode
=> $bd->{publishercode
},
327 publicationyear
=> $bd->{publicationyear
},
328 collectiontitle
=> $bd->{collectiontitle
},
329 isbn
=> $order->{isbn
},
330 quantity
=> $order->{quantity
},
331 rrp
=> $order->{rrp
},
332 discount
=> $bookseller->{discount
},
333 ecost
=> $order->{ecost
},
334 notes
=> $order->{notes
},
335 entrydate
=> $order->{entrydate
},
336 booksellername
=> $bookseller->{name
},
337 bookselleraddress
=> $bookseller->{address1
},
338 booksellerpostal
=> $bookseller->{postal
},
339 contractnumber
=> $contract->{contractnumber
},
340 contractname
=> $contract->{contractname
},
341 basketgroupdeliveryplace
=> C4
::Branch
::GetBranchName
( $basketgroup->{deliveryplace
} ),
342 basketgroupbillingplace
=> C4
::Branch
::GetBranchName
( $basketgroup->{billingplace
} ),
343 basketdeliveryplace
=> C4
::Branch
::GetBranchName
( $basket->{deliveryplace
} ),
344 basketbillingplace
=> C4
::Branch
::GetBranchName
( $basket->{billingplace
} ),
347 basketname author title publishercode collectiontitle notes
348 booksellername bookselleraddress booksellerpostal contractname
349 basketgroupdeliveryplace basketgroupbillingplace
350 basketdeliveryplace basketbillingplace
352 # Double the quotes to not be interpreted as a field end
353 $row->{$_} =~ s/"/""/g if $row->{$_};
358 $template->param(rows
=> \
@rows);
360 return $template->output;
364 =head3 CloseBasketgroup
366 &CloseBasketgroup($basketgroupno);
372 sub CloseBasketgroup
{
373 my ($basketgroupno) = @_;
374 my $dbh = C4
::Context
->dbh;
375 my $sth = $dbh->prepare("
376 UPDATE aqbasketgroups
380 $sth->execute($basketgroupno);
383 #------------------------------------------------------------#
385 =head3 ReOpenBaskergroup($basketgroupno)
387 &ReOpenBaskergroup($basketgroupno);
393 sub ReOpenBasketgroup
{
394 my ($basketgroupno) = @_;
395 my $dbh = C4
::Context
->dbh;
396 my $sth = $dbh->prepare("
397 UPDATE aqbasketgroups
401 $sth->execute($basketgroupno);
404 #------------------------------------------------------------#
409 &DelBasket($basketno);
411 Deletes the basket that has basketno field $basketno in the aqbasket table.
415 =item C<$basketno> is the primary key of the basket in the aqbasket table.
422 my ( $basketno ) = @_;
423 my $query = "DELETE FROM aqbasket WHERE basketno=?";
424 my $dbh = C4
::Context
->dbh;
425 my $sth = $dbh->prepare($query);
426 $sth->execute($basketno);
430 #------------------------------------------------------------#
434 &ModBasket($basketinfo);
436 Modifies a basket, using a hashref $basketinfo for the relevant information, only $basketinfo->{'basketno'} is required.
440 =item C<$basketno> is the primary key of the basket in the aqbasket table.
447 my $basketinfo = shift;
448 my $query = "UPDATE aqbasket SET ";
450 foreach my $key (keys %$basketinfo){
451 if ($key ne 'basketno'){
452 $query .= "$key=?, ";
453 push(@params, $basketinfo->{$key} || undef );
456 # get rid of the "," at the end of $query
457 if (substr($query, length($query)-2) eq ', '){
462 $query .= "WHERE basketno=?";
463 push(@params, $basketinfo->{'basketno'});
464 my $dbh = C4
::Context
->dbh;
465 my $sth = $dbh->prepare($query);
466 $sth->execute(@params);
470 #------------------------------------------------------------#
472 =head3 ModBasketHeader
474 &ModBasketHeader($basketno, $basketname, $note, $booksellernote, $contractnumber, $booksellerid);
476 Modifies a basket's header.
480 =item C<$basketno> is the "basketno" field in the "aqbasket" table;
482 =item C<$basketname> is the "basketname" field in the "aqbasket" table;
484 =item C<$note> is the "note" field in the "aqbasket" table;
486 =item C<$booksellernote> is the "booksellernote" field in the "aqbasket" table;
488 =item C<$contractnumber> is the "contractnumber" (foreign) key in the "aqbasket" table.
490 =item C<$booksellerid> is the id (foreign) key in the "aqbooksellers" table for the vendor.
492 =item C<$deliveryplace> is the "deliveryplace" field in the aqbasket table.
494 =item C<$billingplace> is the "billingplace" field in the aqbasket table.
500 sub ModBasketHeader
{
501 my ($basketno, $basketname, $note, $booksellernote, $contractnumber, $booksellerid, $deliveryplace, $billingplace) = @_;
504 SET basketname
=?
, note
=?
, booksellernote
=?
, booksellerid
=?
, deliveryplace
=?
, billingplace
=?
508 my $dbh = C4
::Context
->dbh;
509 my $sth = $dbh->prepare($query);
510 $sth->execute($basketname, $note, $booksellernote, $booksellerid, $deliveryplace, $billingplace, $basketno);
512 if ( $contractnumber ) {
513 my $query2 ="UPDATE aqbasket SET contractnumber=? WHERE basketno=?";
514 my $sth2 = $dbh->prepare($query2);
515 $sth2->execute($contractnumber,$basketno);
521 #------------------------------------------------------------#
523 =head3 GetBasketsByBookseller
525 @results = &GetBasketsByBookseller($booksellerid, $extra);
527 Returns a list of hashes of all the baskets that belong to bookseller 'booksellerid'.
531 =item C<$booksellerid> is the 'id' field of the bookseller in the aqbooksellers table
533 =item C<$extra> is the extra sql parameters, can be
535 $extra->{groupby}: group baskets by column
536 ex. $extra->{groupby} = aqbasket.basketgroupid
537 $extra->{orderby}: order baskets by column
538 $extra->{limit}: limit number of results (can be helpful for pagination)
544 sub GetBasketsByBookseller
{
545 my ($booksellerid, $extra) = @_;
546 my $query = "SELECT * FROM aqbasket WHERE booksellerid=?";
548 if ($extra->{groupby
}) {
549 $query .= " GROUP by $extra->{groupby}";
551 if ($extra->{orderby
}){
552 $query .= " ORDER by $extra->{orderby}";
554 if ($extra->{limit
}){
555 $query .= " LIMIT $extra->{limit}";
558 my $dbh = C4
::Context
->dbh;
559 my $sth = $dbh->prepare($query);
560 $sth->execute($booksellerid);
561 my $results = $sth->fetchall_arrayref({});
566 =head3 GetBasketsInfosByBookseller
568 my $baskets = GetBasketsInfosByBookseller($supplierid);
570 Returns in a arrayref of hashref all about booksellers baskets, plus:
571 total_biblios: Number of distinct biblios in basket
572 total_items: Number of items in basket
573 expected_items: Number of non-received items in basket
577 sub GetBasketsInfosByBookseller
{
578 my ($supplierid) = @_;
580 return unless $supplierid;
582 my $dbh = C4
::Context
->dbh;
585 SUM
(aqorders
.quantity
) AS total_items
,
586 COUNT
(DISTINCT aqorders
.biblionumber
) AS total_biblios
,
588 IF
(aqorders
.datereceived IS NULL
589 AND aqorders
.datecancellationprinted IS NULL
594 LEFT JOIN aqorders ON aqorders
.basketno
= aqbasket
.basketno
595 WHERE booksellerid
= ?
596 GROUP BY aqbasket
.basketno
598 my $sth = $dbh->prepare($query);
599 $sth->execute($supplierid);
600 return $sth->fetchall_arrayref({});
604 #------------------------------------------------------------#
606 =head3 GetBasketsByBasketgroup
608 $baskets = &GetBasketsByBasketgroup($basketgroupid);
610 Returns a reference to all baskets that belong to basketgroup $basketgroupid.
614 sub GetBasketsByBasketgroup
{
615 my $basketgroupid = shift;
617 SELECT
*, aqbasket
.booksellerid as booksellerid
619 LEFT JOIN aqcontract USING
(contractnumber
) WHERE basketgroupid
=?
621 my $dbh = C4
::Context
->dbh;
622 my $sth = $dbh->prepare($query);
623 $sth->execute($basketgroupid);
624 my $results = $sth->fetchall_arrayref({});
629 #------------------------------------------------------------#
631 =head3 NewBasketgroup
633 $basketgroupid = NewBasketgroup(\%hashref);
635 Adds a basketgroup to the aqbasketgroups table, and add the initial baskets to it.
637 $hashref->{'booksellerid'} is the 'id' field of the bookseller in the aqbooksellers table,
639 $hashref->{'name'} is the 'name' field of the basketgroup in the aqbasketgroups table,
641 $hashref->{'basketlist'} is a list reference of the 'id's of the baskets that belong to this group,
643 $hashref->{'deliveryplace'} is the 'deliveryplace' field of the basketgroup in the aqbasketgroups table,
645 $hashref->{'deliverycomment'} is the 'deliverycomment' field of the basketgroup in the aqbasketgroups table,
647 $hashref->{'closed'} is the 'closed' field of the aqbasketgroups table, it is false if 0, true otherwise.
652 my $basketgroupinfo = shift;
653 die "booksellerid is required to create a basketgroup" unless $basketgroupinfo->{'booksellerid'};
654 my $query = "INSERT INTO aqbasketgroups (";
656 foreach my $field ('name', 'deliveryplace', 'deliverycomment', 'closed') {
657 if ( $basketgroupinfo->{$field} ) {
658 $query .= "$field, ";
659 push(@params, $basketgroupinfo->{$field});
662 $query .= "booksellerid) VALUES (";
667 push(@params, $basketgroupinfo->{'booksellerid'});
668 my $dbh = C4
::Context
->dbh;
669 my $sth = $dbh->prepare($query);
670 $sth->execute(@params);
671 my $basketgroupid = $dbh->{'mysql_insertid'};
672 if( $basketgroupinfo->{'basketlist'} ) {
673 foreach my $basketno (@
{$basketgroupinfo->{'basketlist'}}) {
674 my $query2 = "UPDATE aqbasket SET basketgroupid=? WHERE basketno=?";
675 my $sth2 = $dbh->prepare($query2);
676 $sth2->execute($basketgroupid, $basketno);
679 return $basketgroupid;
682 #------------------------------------------------------------#
684 =head3 ModBasketgroup
686 ModBasketgroup(\%hashref);
688 Modifies a basketgroup in the aqbasketgroups table, and add the baskets to it.
690 $hashref->{'id'} is the 'id' field of the basketgroup in the aqbasketgroup table, this parameter is mandatory,
692 $hashref->{'name'} is the 'name' field of the basketgroup in the aqbasketgroups table,
694 $hashref->{'basketlist'} is a list reference of the 'id's of the baskets that belong to this group,
696 $hashref->{'billingplace'} is the 'billingplace' field of the basketgroup in the aqbasketgroups table,
698 $hashref->{'deliveryplace'} is the 'deliveryplace' field of the basketgroup in the aqbasketgroups table,
700 $hashref->{'deliverycomment'} is the 'deliverycomment' field of the basketgroup in the aqbasketgroups table,
702 $hashref->{'closed'} is the 'closed' field of the aqbasketgroups table, it is false if 0, true otherwise.
707 my $basketgroupinfo = shift;
708 die "basketgroup id is required to edit a basketgroup" unless $basketgroupinfo->{'id'};
709 my $dbh = C4
::Context
->dbh;
710 my $query = "UPDATE aqbasketgroups SET ";
712 foreach my $field (qw(name billingplace deliveryplace freedeliveryplace deliverycomment closed)) {
713 if ( defined $basketgroupinfo->{$field} ) {
714 $query .= "$field=?, ";
715 push(@params, $basketgroupinfo->{$field});
720 $query .= " WHERE id=?";
721 push(@params, $basketgroupinfo->{'id'});
722 my $sth = $dbh->prepare($query);
723 $sth->execute(@params);
725 $sth = $dbh->prepare('UPDATE aqbasket SET basketgroupid = NULL WHERE basketgroupid = ?');
726 $sth->execute($basketgroupinfo->{'id'});
728 if($basketgroupinfo->{'basketlist'} && @
{$basketgroupinfo->{'basketlist'}}){
729 $sth = $dbh->prepare("UPDATE aqbasket SET basketgroupid=? WHERE basketno=?");
730 foreach my $basketno (@
{$basketgroupinfo->{'basketlist'}}) {
731 $sth->execute($basketgroupinfo->{'id'}, $basketno);
738 #------------------------------------------------------------#
740 =head3 DelBasketgroup
742 DelBasketgroup($basketgroupid);
744 Deletes a basketgroup in the aqbasketgroups table, and removes the reference to it from the baskets,
748 =item C<$basketgroupid> is the 'id' field of the basket in the aqbasketgroup table
755 my $basketgroupid = shift;
756 die "basketgroup id is required to edit a basketgroup" unless $basketgroupid;
757 my $query = "DELETE FROM aqbasketgroups WHERE id=?";
758 my $dbh = C4
::Context
->dbh;
759 my $sth = $dbh->prepare($query);
760 $sth->execute($basketgroupid);
764 #------------------------------------------------------------#
767 =head2 FUNCTIONS ABOUT ORDERS
769 =head3 GetBasketgroup
771 $basketgroup = &GetBasketgroup($basketgroupid);
773 Returns a reference to the hash containing all infermation about the basketgroup.
778 my $basketgroupid = shift;
779 die "basketgroup id is required to edit a basketgroup" unless $basketgroupid;
780 my $query = "SELECT * FROM aqbasketgroups WHERE id=?";
781 my $dbh = C4
::Context
->dbh;
782 my $sth = $dbh->prepare($query);
783 $sth->execute($basketgroupid);
784 my $result = $sth->fetchrow_hashref;
789 #------------------------------------------------------------#
791 =head3 GetBasketgroups
793 $basketgroups = &GetBasketgroups($booksellerid);
795 Returns a reference to the array of all the basketgroups of bookseller $booksellerid.
799 sub GetBasketgroups
{
800 my $booksellerid = shift;
801 die "bookseller id is required to edit a basketgroup" unless $booksellerid;
802 my $query = "SELECT * FROM aqbasketgroups WHERE booksellerid=? ORDER BY `id` DESC";
803 my $dbh = C4
::Context
->dbh;
804 my $sth = $dbh->prepare($query);
805 $sth->execute($booksellerid);
806 my $results = $sth->fetchall_arrayref({});
811 #------------------------------------------------------------#
813 =head2 FUNCTIONS ABOUT ORDERS
817 #------------------------------------------------------------#
819 =head3 GetPendingOrders
821 $orders = &GetPendingOrders($supplierid,$grouped,$owner,$basketno,$ordernumber,$search,$ean);
823 Finds pending orders from the bookseller with the given ID. Ignores
824 completed and cancelled orders.
826 C<$booksellerid> contains the bookseller identifier
827 C<$owner> contains 0 or 1. 0 means any owner. 1 means only the list of orders entered by the user itself.
828 C<$grouped> is a boolean that, if set to 1 will group all order lines of the same basket
829 in a single result line
830 C<$orders> is a reference-to-array; each element is a reference-to-hash.
832 Used also by the filter in parcel.pl
839 These give the value of the corresponding field in the aqorders table
840 of the Koha database.
842 Results are ordered from most to least recent.
846 sub GetPendingOrders
{
847 my ($supplierid,$grouped,$owner,$basketno,$ordernumber,$search,$ean) = @_;
848 my $dbh = C4
::Context
->dbh;
850 SELECT ".($grouped?
"count(*),":"")."aqbasket.basketno,
851 surname,firstname,biblio.*,biblioitems.isbn,
852 aqbasket.closedate, aqbasket.creationdate, aqbasket.basketname,
855 LEFT JOIN aqbasket ON aqbasket.basketno=aqorders.basketno
856 LEFT JOIN borrowers ON aqbasket.authorisedby=borrowers.borrowernumber
857 LEFT JOIN biblio ON biblio.biblionumber=aqorders.biblionumber
858 LEFT JOIN biblioitems ON biblioitems.biblionumber=biblio.biblionumber
859 WHERE (quantity > quantityreceived OR quantityreceived is NULL)
860 AND datecancellationprinted IS NULL";
862 my $userenv = C4
::Context
->userenv;
863 if ( C4
::Context
->preference("IndependantBranches") ) {
864 if ( ($userenv) && ( $userenv->{flags
} != 1 ) ) {
865 $strsth .= " AND (borrowers.branchcode = ?
866 or borrowers.branchcode = '')";
867 push @query_params, $userenv->{branch
};
871 $strsth .= " AND aqbasket.booksellerid = ?";
872 push @query_params, $supplierid;
875 $strsth .= " AND (aqorders.ordernumber=?)";
876 push @query_params, $ordernumber;
879 $strsth .= " AND (biblio.title like ? OR biblio.author LIKE ? OR biblioitems.isbn like ?)";
880 push @query_params, ("%$search%","%$search%","%$search%");
883 $strsth .= " AND biblioitems.ean = ?";
884 push @query_params, $ean;
887 $strsth .= " AND aqbasket.basketno=? ";
888 push @query_params, $basketno;
891 $strsth .= " AND aqbasket.authorisedby=? ";
892 push @query_params, $userenv->{'number'};
894 $strsth .= " group by aqbasket.basketno" if $grouped;
895 $strsth .= " order by aqbasket.basketno";
896 my $sth = $dbh->prepare($strsth);
897 $sth->execute( @query_params );
898 my $results = $sth->fetchall_arrayref({});
903 #------------------------------------------------------------#
907 @orders = &GetOrders($basketnumber, $orderby);
909 Looks up the pending (non-cancelled) orders with the given basket
910 number. If C<$booksellerID> is non-empty, only orders from that seller
914 C<&basket> returns a two-element array. C<@orders> is an array of
915 references-to-hash, whose keys are the fields from the aqorders,
916 biblio, and biblioitems tables in the Koha database.
921 my ( $basketno, $orderby ) = @_;
922 my $dbh = C4
::Context
->dbh;
924 SELECT biblio.*,biblioitems.*,
929 LEFT JOIN aqbudgets ON aqbudgets.budget_id = aqorders.budget_id
930 LEFT JOIN biblio ON biblio.biblionumber = aqorders.biblionumber
931 LEFT JOIN biblioitems ON biblioitems.biblionumber =biblio.biblionumber
933 AND (datecancellationprinted IS NULL OR datecancellationprinted='0000-00-00')
936 $orderby = "biblioitems.publishercode,biblio.title" unless $orderby;
937 $query .= " ORDER BY $orderby";
938 my $sth = $dbh->prepare($query);
939 $sth->execute($basketno);
940 my $results = $sth->fetchall_arrayref({});
945 #------------------------------------------------------------#
947 =head3 GetOrderNumber
949 $ordernumber = &GetOrderNumber($biblioitemnumber, $biblionumber);
951 Looks up the ordernumber with the given biblionumber and biblioitemnumber.
953 Returns the number of this order.
957 =item C<$ordernumber> is the order number.
964 my ( $biblionumber,$biblioitemnumber ) = @_;
965 my $dbh = C4
::Context
->dbh;
970 AND biblioitemnumber=?
972 my $sth = $dbh->prepare($query);
973 $sth->execute( $biblionumber, $biblioitemnumber );
975 return $sth->fetchrow;
978 #------------------------------------------------------------#
982 $order = &GetOrder($ordernumber);
984 Looks up an order by order number.
986 Returns a reference-to-hash describing the order. The keys of
987 C<$order> are fields from the biblio, biblioitems, aqorders tables of the Koha database.
992 my ($ordernumber) = @_;
993 my $dbh = C4
::Context
->dbh;
995 SELECT biblioitems.*, biblio.*, aqorders.*
997 LEFT JOIN biblio on biblio.biblionumber=aqorders.biblionumber
998 LEFT JOIN biblioitems on biblioitems.biblionumber=aqorders.biblionumber
999 WHERE aqorders.ordernumber=?
1002 my $sth= $dbh->prepare($query);
1003 $sth->execute($ordernumber);
1004 my $data = $sth->fetchrow_hashref;
1009 #------------------------------------------------------------#
1013 &NewOrder(\%hashref);
1015 Adds a new order to the database. Any argument that isn't described
1016 below is the new value of the field with the same name in the aqorders
1017 table of the Koha database.
1021 =item $hashref->{'basketno'} is the basketno foreign key in aqorders, it is mandatory
1023 =item $hashref->{'ordernumber'} is a "minimum order number."
1025 =item $hashref->{'budgetdate'} is effectively ignored.
1026 If it's undef (anything false) or the string 'now', the current day is used.
1027 Else, the upcoming July 1st is used.
1029 =item $hashref->{'subscription'} may be either "yes", or anything else for "no".
1031 =item $hashref->{'uncertainprice'} may be 0 for "the price is known" or 1 for "the price is uncertain"
1033 =item defaults entrydate to Now
1035 The following keys are used: "biblionumber", "title", "basketno", "quantity", "notes", "biblioitemnumber", "rrp", "ecost", "gstrate", "unitprice", "subscription", "sort1", "sort2", "booksellerinvoicenumber", "listprice", "budgetdate", "purchaseordernumber", "branchcode", "booksellerinvoicenumber", "bookfundid".
1042 my $orderinfo = shift;
1043 #### ------------------------------
1044 my $dbh = C4
::Context
->dbh;
1048 # if these parameters are missing, we can't continue
1049 for my $key (qw
/basketno quantity biblionumber budget_id/) {
1050 croak
"Mandatory parameter $key missing" unless $orderinfo->{$key};
1053 if ( defined $orderinfo->{subscription
} && $orderinfo->{'subscription'} eq 'yes' ) {
1054 $orderinfo->{'subscription'} = 1;
1056 $orderinfo->{'subscription'} = 0;
1058 $orderinfo->{'entrydate'} ||= C4
::Dates
->new()->output("iso");
1059 if (!$orderinfo->{quantityreceived
}) {
1060 $orderinfo->{quantityreceived
} = 0;
1063 my $ordernumber=InsertInTable
("aqorders",$orderinfo);
1064 if (not $orderinfo->{parent_ordernumber
}) {
1065 my $sth = $dbh->prepare("
1067 SET parent_ordernumber = ordernumber
1068 WHERE ordernumber = ?
1070 $sth->execute($ordernumber);
1072 return ( $orderinfo->{'basketno'}, $ordernumber );
1077 #------------------------------------------------------------#
1086 my ($itemnumber, $ordernumber) = @_;
1087 my $dbh = C4
::Context
->dbh;
1089 INSERT INTO aqorders_items
1090 (itemnumber
, ordernumber
)
1093 my $sth = $dbh->prepare($query);
1094 $sth->execute( $itemnumber, $ordernumber);
1097 #------------------------------------------------------------#
1101 &ModOrder(\%hashref);
1103 Modifies an existing order. Updates the order with order number
1104 $hashref->{'ordernumber'} and biblionumber $hashref->{'biblionumber'}. All
1105 other keys of the hash update the fields with the same name in the aqorders
1106 table of the Koha database.
1111 my $orderinfo = shift;
1113 die "Ordernumber is required" if $orderinfo->{'ordernumber'} eq '' ;
1114 die "Biblionumber is required" if $orderinfo->{'biblionumber'} eq '';
1116 my $dbh = C4
::Context
->dbh;
1119 # update uncertainprice to an integer, just in case (under FF, checked boxes have the value "ON" by default)
1120 $orderinfo->{uncertainprice
}=1 if $orderinfo->{uncertainprice
};
1122 # delete($orderinfo->{'branchcode'});
1123 # the hash contains a lot of entries not in aqorders, so get the columns ...
1124 my $sth = $dbh->prepare("SELECT * FROM aqorders LIMIT 1;");
1126 my $colnames = $sth->{NAME
};
1127 my $query = "UPDATE aqorders SET ";
1129 foreach my $orderinfokey (grep(!/ordernumber/, keys %$orderinfo)){
1130 # ... and skip hash entries that are not in the aqorders table
1131 # FIXME : probably not the best way to do it (would be better to have a correct hash)
1132 next unless grep(/^$orderinfokey$/, @
$colnames);
1133 $query .= "$orderinfokey=?, ";
1134 push(@params, $orderinfo->{$orderinfokey});
1137 $query .= "timestamp=NOW() WHERE ordernumber=?";
1138 # push(@params, $specorderinfo{'ordernumber'});
1139 push(@params, $orderinfo->{'ordernumber'} );
1140 $sth = $dbh->prepare($query);
1141 $sth->execute(@params);
1145 #------------------------------------------------------------#
1149 &ModOrderItem(\%hashref);
1151 Modifies the itemnumber in the aqorders_items table. The input hash needs three entities:
1155 =item - itemnumber: the old itemnumber
1156 =item - ordernumber: the order this item is attached to
1157 =item - newitemnumber: the new itemnumber we want to attach the line to
1164 my $orderiteminfo = shift;
1165 if (! $orderiteminfo->{'ordernumber'} || ! $orderiteminfo->{'itemnumber'} || ! $orderiteminfo->{'newitemnumber'}){
1166 die "Ordernumber, itemnumber and newitemnumber is required";
1169 my $dbh = C4
::Context
->dbh;
1171 my $query = "UPDATE aqorders_items set itemnumber=? where itemnumber=? and ordernumber=?";
1172 my @params = ($orderiteminfo->{'newitemnumber'}, $orderiteminfo->{'itemnumber'}, $orderiteminfo->{'ordernumber'});
1173 my $sth = $dbh->prepare($query);
1174 $sth->execute(@params);
1180 ModItemOrder($itemnumber, $ordernumber);
1182 Modifies the ordernumber of an item in aqorders_items.
1187 my ($itemnumber, $ordernumber) = @_;
1189 return unless ($itemnumber and $ordernumber);
1191 my $dbh = C4
::Context
->dbh;
1193 UPDATE aqorders_items
1195 WHERE itemnumber
= ?
1197 my $sth = $dbh->prepare($query);
1198 return $sth->execute($ordernumber, $itemnumber);
1201 #------------------------------------------------------------#
1204 =head3 ModOrderBibliotemNumber
1206 &ModOrderBiblioitemNumber($biblioitemnumber,$ordernumber, $biblionumber);
1208 Modifies the biblioitemnumber for an existing order.
1209 Updates the order with order number C<$ordernum> and biblionumber C<$biblionumber>.
1213 #FIXME: is this used at all?
1214 sub ModOrderBiblioitemNumber
{
1215 my ($biblioitemnumber,$ordernumber, $biblionumber) = @_;
1216 my $dbh = C4
::Context
->dbh;
1219 SET biblioitemnumber = ?
1220 WHERE ordernumber = ?
1221 AND biblionumber = ?";
1222 my $sth = $dbh->prepare($query);
1223 $sth->execute( $biblioitemnumber, $ordernumber, $biblionumber );
1226 =head3 GetCancelledOrders
1228 my @orders = GetCancelledOrders($basketno, $orderby);
1230 Returns cancelled orders for a basket
1234 sub GetCancelledOrders
{
1235 my ( $basketno, $orderby ) = @_;
1237 return () unless $basketno;
1239 my $dbh = C4
::Context
->dbh;
1241 SELECT biblio.*, biblioitems.*, aqorders.*, aqbudgets.*
1243 LEFT JOIN aqbudgets ON aqbudgets.budget_id = aqorders.budget_id
1244 LEFT JOIN biblio ON biblio.biblionumber = aqorders.biblionumber
1245 LEFT JOIN biblioitems ON biblioitems.biblionumber = biblio.biblionumber
1247 AND (datecancellationprinted IS NOT NULL
1248 AND datecancellationprinted <> '0000-00-00')
1251 $orderby = "aqorders.datecancellationprinted desc, aqorders.timestamp desc"
1253 $query .= " ORDER BY $orderby";
1254 my $sth = $dbh->prepare($query);
1255 $sth->execute($basketno);
1256 my $results = $sth->fetchall_arrayref( {} );
1262 #------------------------------------------------------------#
1264 =head3 ModReceiveOrder
1266 &ModReceiveOrder($biblionumber, $ordernumber, $quantityreceived, $user,
1267 $unitprice, $invoiceid, $biblioitemnumber,
1268 $bookfund, $rrp, \@received_itemnumbers);
1270 Updates an order, to reflect the fact that it was received, at least
1271 in part. All arguments not mentioned below update the fields with the
1272 same name in the aqorders table of the Koha database.
1274 If a partial order is received, splits the order into two.
1276 Updates the order with bibilionumber C<$biblionumber> and ordernumber
1282 sub ModReceiveOrder
{
1284 $biblionumber, $ordernumber, $quantrec, $user, $cost, $ecost,
1285 $invoiceid, $rrp, $budget_id, $datereceived, $received_items
1289 my $dbh = C4
::Context
->dbh;
1290 $datereceived = C4
::Dates
->output('iso') unless $datereceived;
1291 my $suggestionid = GetSuggestionFromBiblionumber
( $biblionumber );
1292 if ($suggestionid) {
1293 ModSuggestion
( {suggestionid
=>$suggestionid,
1294 STATUS
=>'AVAILABLE',
1295 biblionumber
=> $biblionumber}
1299 my $sth=$dbh->prepare("
1300 SELECT * FROM aqorders
1301 WHERE biblionumber=? AND aqorders.ordernumber=?");
1303 $sth->execute($biblionumber,$ordernumber);
1304 my $order = $sth->fetchrow_hashref();
1307 my $new_ordernumber = $ordernumber;
1308 if ( $order->{quantity
} > $quantrec ) {
1309 # Split order line in two parts: the first is the original order line
1310 # without received items (the quantity is decreased),
1311 # the second part is a new order line with quantity=quantityrec
1312 # (entirely received)
1313 $sth=$dbh->prepare("
1316 WHERE ordernumber = ?
1319 $sth->execute($order->{quantity
} - $quantrec, $ordernumber);
1323 delete $order->{'ordernumber'};
1324 $order->{'quantity'} = $quantrec;
1325 $order->{'quantityreceived'} = $quantrec;
1326 $order->{'datereceived'} = $datereceived;
1327 $order->{'invoiceid'} = $invoiceid;
1328 $order->{'unitprice'} = $cost;
1329 $order->{'rrp'} = $rrp;
1330 $order->{ecost
} = $ecost;
1331 $order->{'orderstatus'} = 3; # totally received
1332 $new_ordernumber = NewOrder
($order);
1334 if ($received_items) {
1335 foreach my $itemnumber (@
$received_items) {
1336 ModItemOrder
($itemnumber, $new_ordernumber);
1340 $sth=$dbh->prepare("update aqorders
1341 set quantityreceived=?,datereceived=?,invoiceid=?,
1342 unitprice=?,rrp=?,ecost=?
1343 where biblionumber=? and ordernumber=?");
1344 $sth->execute($quantrec,$datereceived,$invoiceid,$cost,$rrp,$ecost,$biblionumber,$ordernumber);
1347 return ($datereceived, $new_ordernumber);
1350 =head3 CancelReceipt
1352 my $parent_ordernumber = CancelReceipt($ordernumber);
1354 Cancel an order line receipt and update the parent order line, as if no
1356 If items are created at receipt (AcqCreateItem = receiving) then delete
1362 my $ordernumber = shift;
1364 return unless $ordernumber;
1366 my $dbh = C4
::Context
->dbh;
1368 SELECT datereceived
, parent_ordernumber
, quantity
1370 WHERE ordernumber
= ?
1372 my $sth = $dbh->prepare($query);
1373 $sth->execute($ordernumber);
1374 my $order = $sth->fetchrow_hashref;
1376 warn "CancelReceipt: order $ordernumber does not exist";
1379 unless($order->{'datereceived'}) {
1380 warn "CancelReceipt: order $ordernumber is not received";
1384 my $parent_ordernumber = $order->{'parent_ordernumber'};
1386 if($parent_ordernumber == $ordernumber || not $parent_ordernumber) {
1387 # The order line has no parent, just mark it as not received
1390 SET quantityreceived
= ?
,
1393 WHERE ordernumber
= ?
1395 $sth = $dbh->prepare($query);
1396 $sth->execute(0, undef, undef, $ordernumber);
1398 # The order line has a parent, increase parent quantity and delete
1401 SELECT quantity
, datereceived
1403 WHERE ordernumber
= ?
1405 $sth = $dbh->prepare($query);
1406 $sth->execute($parent_ordernumber);
1407 my $parent_order = $sth->fetchrow_hashref;
1408 unless($parent_order) {
1409 warn "Parent order $parent_ordernumber does not exist.";
1412 if($parent_order->{'datereceived'}) {
1413 warn "CancelReceipt: parent order is received.".
1414 " Can't cancel receipt.";
1420 WHERE ordernumber
= ?
1422 $sth = $dbh->prepare($query);
1423 my $rv = $sth->execute(
1424 $order->{'quantity'} + $parent_order->{'quantity'},
1428 warn "Cannot update parent order line, so do not cancel".
1432 if(C4
::Context
->preference('AcqCreateItem') eq 'receiving') {
1433 # Remove items that were created at receipt
1435 DELETE FROM items
, aqorders_items
1436 USING items
, aqorders_items
1437 WHERE items
.itemnumber
= ? AND aqorders_items
.itemnumber
= ?
1439 $sth = $dbh->prepare($query);
1440 my @itemnumbers = GetItemnumbersFromOrder
($ordernumber);
1441 foreach my $itemnumber (@itemnumbers) {
1442 $sth->execute($itemnumber, $itemnumber);
1446 my @itemnumbers = GetItemnumbersFromOrder
($ordernumber);
1447 foreach my $itemnumber (@itemnumbers) {
1448 ModItemOrder
($itemnumber, $parent_ordernumber);
1453 DELETE FROM aqorders
1454 WHERE ordernumber
= ?
1456 $sth = $dbh->prepare($query);
1457 $sth->execute($ordernumber);
1461 return $parent_ordernumber;
1464 #------------------------------------------------------------#
1468 @results = &SearchOrder($search, $biblionumber, $complete);
1470 Searches for orders.
1472 C<$search> may take one of several forms: if it is an ISBN,
1473 C<&ordersearch> returns orders with that ISBN. If C<$search> is an
1474 order number, C<&ordersearch> returns orders with that order number
1475 and biblionumber C<$biblionumber>. Otherwise, C<$search> is considered
1476 to be a space-separated list of search terms; in this case, all of the
1477 terms must appear in the title (matching the beginning of title
1480 If C<$complete> is C<yes>, the results will include only completed
1481 orders. In any case, C<&ordersearch> ignores cancelled orders.
1483 C<&ordersearch> returns an array.
1484 C<@results> is an array of references-to-hash with the following keys:
1490 =item C<seriestitle>
1501 #### -------- SearchOrder-------------------------------
1502 my ( $ordernumber, $search, $ean, $supplierid, $basket ) = @_;
1504 my $dbh = C4
::Context
->dbh;
1509 LEFT JOIN biblio ON aqorders.biblionumber=biblio.biblionumber
1510 LEFT JOIN biblioitems ON biblioitems.biblionumber=biblio.biblionumber
1511 LEFT JOIN aqbasket ON aqorders.basketno = aqbasket.basketno
1512 WHERE (datecancellationprinted is NULL)";
1515 $query .= " AND (aqorders.ordernumber=?)";
1516 push @args, $ordernumber;
1519 $query .= " AND (biblio.title like ? OR biblio.author LIKE ? OR biblioitems.isbn like ?)";
1520 push @args, ("%$search%","%$search%","%$search%");
1523 $query .= " AND biblioitems.ean = ?";
1527 $query .= "AND aqbasket.booksellerid = ?";
1528 push @args, $supplierid;
1531 $query .= "AND aqorders.basketno = ?";
1532 push @args, $basket;
1535 my $sth = $dbh->prepare($query);
1536 $sth->execute(@args);
1537 my $results = $sth->fetchall_arrayref({});
1542 #------------------------------------------------------------#
1546 &DelOrder($biblionumber, $ordernumber);
1548 Cancel the order with the given order and biblio numbers. It does not
1549 delete any entries in the aqorders table, it merely marks them as
1555 my ( $bibnum, $ordernumber ) = @_;
1556 my $dbh = C4
::Context
->dbh;
1559 SET datecancellationprinted=now()
1560 WHERE biblionumber=? AND ordernumber=?
1562 my $sth = $dbh->prepare($query);
1563 $sth->execute( $bibnum, $ordernumber );
1565 my @itemnumbers = GetItemnumbersFromOrder
( $ordernumber );
1566 foreach my $itemnumber (@itemnumbers){
1567 C4
::Items
::DelItem
( $dbh, $bibnum, $itemnumber );
1572 =head2 FUNCTIONS ABOUT PARCELS
1576 #------------------------------------------------------------#
1580 @results = &GetParcel($booksellerid, $code, $date);
1582 Looks up all of the received items from the supplier with the given
1583 bookseller ID at the given date, for the given code (bookseller Invoice number). Ignores cancelled and completed orders.
1585 C<@results> is an array of references-to-hash. The keys of each element are fields from
1586 the aqorders, biblio, and biblioitems tables of the Koha database.
1588 C<@results> is sorted alphabetically by book title.
1593 #gets all orders from a certain supplier, orders them alphabetically
1594 my ( $supplierid, $code, $datereceived ) = @_;
1595 my $dbh = C4
::Context
->dbh;
1598 if $code; # add % if we search on a given code (otherwise, let him empty)
1600 SELECT authorisedby,
1605 aqorders.biblionumber,
1606 aqorders.ordernumber,
1607 aqorders.parent_ordernumber,
1609 aqorders.quantityreceived,
1617 LEFT JOIN aqbasket ON aqbasket.basketno=aqorders.basketno
1618 LEFT JOIN borrowers ON aqbasket.authorisedby=borrowers.borrowernumber
1619 LEFT JOIN biblio ON aqorders.biblionumber=biblio.biblionumber
1620 LEFT JOIN aqinvoices ON aqorders.invoiceid = aqinvoices.invoiceid
1622 aqbasket.booksellerid = ?
1623 AND aqinvoices.invoicenumber LIKE ?
1624 AND aqorders.datereceived = ? ";
1626 my @query_params = ( $supplierid, $code, $datereceived );
1627 if ( C4
::Context
->preference("IndependantBranches") ) {
1628 my $userenv = C4
::Context
->userenv;
1629 if ( ($userenv) && ( $userenv->{flags
} != 1 ) ) {
1630 $strsth .= " and (borrowers.branchcode = ?
1631 or borrowers.branchcode = '')";
1632 push @query_params, $userenv->{branch
};
1635 $strsth .= " ORDER BY aqbasket.basketno";
1636 # ## parcelinformation : $strsth
1637 my $sth = $dbh->prepare($strsth);
1638 $sth->execute( @query_params );
1639 while ( my $data = $sth->fetchrow_hashref ) {
1640 push( @results, $data );
1642 # ## countparcelbiblio: scalar(@results)
1648 #------------------------------------------------------------#
1652 $results = &GetParcels($bookseller, $order, $code, $datefrom, $dateto);
1654 get a lists of parcels.
1661 is the bookseller this function has to get parcels.
1664 To know on what criteria the results list has to be ordered.
1667 is the booksellerinvoicenumber.
1669 =item $datefrom & $dateto
1670 to know on what date this function has to filter its search.
1675 a pointer on a hash list containing parcel informations as such :
1681 =item Last operation
1683 =item Number of biblio
1685 =item Number of items
1692 my ($bookseller,$order, $code, $datefrom, $dateto) = @_;
1693 my $dbh = C4
::Context
->dbh;
1694 my @query_params = ();
1696 SELECT aqinvoices.invoicenumber,
1697 datereceived,purchaseordernumber,
1698 count(DISTINCT biblionumber) AS biblio,
1699 sum(quantity) AS itemsexpected,
1700 sum(quantityreceived) AS itemsreceived
1701 FROM aqorders LEFT JOIN aqbasket ON aqbasket.basketno = aqorders.basketno
1702 LEFT JOIN aqinvoices ON aqorders.invoiceid = aqinvoices.invoiceid
1703 WHERE aqbasket.booksellerid = ? and datereceived IS NOT NULL
1705 push @query_params, $bookseller;
1707 if ( defined $code ) {
1708 $strsth .= ' and aqinvoices.invoicenumber like ? ';
1709 # add a % to the end of the code to allow stemming.
1710 push @query_params, "$code%";
1713 if ( defined $datefrom ) {
1714 $strsth .= ' and datereceived >= ? ';
1715 push @query_params, $datefrom;
1718 if ( defined $dateto ) {
1719 $strsth .= 'and datereceived <= ? ';
1720 push @query_params, $dateto;
1723 $strsth .= "group by aqinvoices.invoicenumber,datereceived ";
1725 # can't use a placeholder to place this column name.
1726 # but, we could probably be checking to make sure it is a column that will be fetched.
1727 $strsth .= "order by $order " if ($order);
1729 my $sth = $dbh->prepare($strsth);
1731 $sth->execute( @query_params );
1732 my $results = $sth->fetchall_arrayref({});
1737 #------------------------------------------------------------#
1739 =head3 GetLateOrders
1741 @results = &GetLateOrders;
1743 Searches for bookseller with late orders.
1746 the table of supplier with late issues. This table is full of hashref.
1752 my $supplierid = shift;
1754 my $estimateddeliverydatefrom = shift;
1755 my $estimateddeliverydateto = shift;
1757 my $dbh = C4
::Context
->dbh;
1759 #BEWARE, order of parenthesis and LEFT JOIN is important for speed
1760 my $dbdriver = C4
::Context
->config("db_scheme") || "mysql";
1762 my @query_params = ();
1764 SELECT aqbasket.basketno,
1765 aqorders.ordernumber,
1766 DATE(aqbasket.closedate) AS orderdate,
1767 aqorders.rrp AS unitpricesupplier,
1768 aqorders.ecost AS unitpricelib,
1769 aqorders.claims_count AS claims_count,
1770 aqorders.claimed_date AS claimed_date,
1771 aqbudgets.budget_name AS budget,
1772 borrowers.branchcode AS branch,
1773 aqbooksellers.name AS supplier,
1774 aqbooksellers.id AS supplierid,
1775 biblio.author, biblio.title,
1776 biblioitems.publishercode AS publisher,
1777 biblioitems.publicationyear,
1778 ADDDATE(aqbasket.closedate, INTERVAL aqbooksellers.deliverytime DAY) AS estimateddeliverydate,
1782 aqorders LEFT JOIN biblio ON biblio.biblionumber = aqorders.biblionumber
1783 LEFT JOIN biblioitems ON biblioitems.biblionumber = biblio.biblionumber
1784 LEFT JOIN aqbudgets ON aqorders.budget_id = aqbudgets.budget_id,
1785 aqbasket LEFT JOIN borrowers ON aqbasket.authorisedby = borrowers.borrowernumber
1786 LEFT JOIN aqbooksellers ON aqbasket.booksellerid = aqbooksellers.id
1787 WHERE aqorders.basketno = aqbasket.basketno
1788 AND ( datereceived = ''
1789 OR datereceived IS NULL
1790 OR aqorders.quantityreceived < aqorders.quantity
1792 AND aqbasket.closedate IS NOT NULL
1793 AND (aqorders.datecancellationprinted IS NULL OR aqorders.datecancellationprinted='0000-00-00')
1796 if ($dbdriver eq "mysql") {
1798 aqorders.quantity - IFNULL(aqorders.quantityreceived,0) AS quantity,
1799 (aqorders.quantity - IFNULL(aqorders.quantityreceived,0)) * aqorders.rrp AS subtotal,
1800 DATEDIFF(CAST(now() AS date),closedate) AS latesince
1802 if ( defined $delay ) {
1803 $from .= " AND (closedate <= DATE_SUB(CAST(now() AS date),INTERVAL ? DAY)) " ;
1804 push @query_params, $delay;
1807 HAVING quantity <> 0
1808 AND unitpricesupplier <> 0
1809 AND unitpricelib <> 0
1812 # FIXME: account for IFNULL as above
1814 aqorders.quantity AS quantity,
1815 aqorders.quantity * aqorders.rrp AS subtotal,
1816 (CAST(now() AS date) - closedate) AS latesince
1818 if ( defined $delay ) {
1819 $from .= " AND (closedate <= (CAST(now() AS date) -(INTERVAL ? DAY)) ";
1820 push @query_params, $delay;
1823 if (defined $supplierid) {
1824 $from .= ' AND aqbasket.booksellerid = ? ';
1825 push @query_params, $supplierid;
1827 if (defined $branch) {
1828 $from .= ' AND borrowers.branchcode LIKE ? ';
1829 push @query_params, $branch;
1832 if ( defined $estimateddeliverydatefrom or defined $estimateddeliverydateto ) {
1833 $from .= ' AND aqbooksellers.deliverytime IS NOT NULL ';
1835 if ( defined $estimateddeliverydatefrom ) {
1836 $from .= ' AND ADDDATE(aqbasket.closedate, INTERVAL aqbooksellers.deliverytime DAY) >= ?';
1837 push @query_params, $estimateddeliverydatefrom;
1839 if ( defined $estimateddeliverydateto ) {
1840 $from .= ' AND ADDDATE(aqbasket.closedate, INTERVAL aqbooksellers.deliverytime DAY) <= ?';
1841 push @query_params, $estimateddeliverydateto;
1843 if ( defined $estimateddeliverydatefrom and not defined $estimateddeliverydateto ) {
1844 $from .= ' AND ADDDATE(aqbasket.closedate, INTERVAL aqbooksellers.deliverytime DAY) <= CAST(now() AS date)';
1846 if (C4
::Context
->preference("IndependantBranches")
1847 && C4
::Context
->userenv
1848 && C4
::Context
->userenv->{flags
} != 1 ) {
1849 $from .= ' AND borrowers.branchcode LIKE ? ';
1850 push @query_params, C4
::Context
->userenv->{branch
};
1852 my $query = "$select $from $having\nORDER BY latesince, basketno, borrowers.branchcode, supplier";
1853 $debug and print STDERR
"GetLateOrders query: $query\nGetLateOrders args: " . join(" ",@query_params);
1854 my $sth = $dbh->prepare($query);
1855 $sth->execute(@query_params);
1857 while (my $data = $sth->fetchrow_hashref) {
1858 $data->{orderdate
} = format_date
($data->{orderdate
});
1859 $data->{claimed_date
} = format_date
($data->{claimed_date
});
1860 push @results, $data;
1865 #------------------------------------------------------------#
1869 (\@order_loop, $total_qty, $total_price, $total_qtyreceived) = GetHistory( %params );
1871 Retreives some acquisition history information
1879 basket - search both basket name and number
1880 booksellerinvoicenumber
1883 $order_loop is a list of hashrefs that each look like this:
1885 'author' => 'Twain, Mark',
1887 'biblionumber' => '215',
1889 'creationdate' => 'MM/DD/YYYY',
1890 'datereceived' => undef,
1893 'invoicenumber' => undef,
1895 'ordernumber' => '1',
1897 'quantityreceived' => undef,
1898 'title' => 'The Adventures of Huckleberry Finn'
1900 $total_qty is the sum of all of the quantities in $order_loop
1901 $total_price is the cost of each in $order_loop times the quantity
1902 $total_qtyreceived is the sum of all of the quantityreceived entries in $order_loop
1907 # don't run the query if there are no parameters (list would be too long for sure !)
1908 croak
"No search params" unless @_;
1910 my $title = $params{title
};
1911 my $author = $params{author
};
1912 my $isbn = $params{isbn
};
1913 my $ean = $params{ean
};
1914 my $name = $params{name
};
1915 my $from_placed_on = $params{from_placed_on
};
1916 my $to_placed_on = $params{to_placed_on
};
1917 my $basket = $params{basket
};
1918 my $booksellerinvoicenumber = $params{booksellerinvoicenumber
};
1919 my $basketgroupname = $params{basketgroupname
};
1922 my $total_qtyreceived = 0;
1923 my $total_price = 0;
1925 my $dbh = C4
::Context
->dbh;
1933 aqbasket.basketname,
1934 aqbasket.basketgroupid,
1935 aqbasketgroups.name as groupname,
1937 aqbasket.creationdate,
1938 aqorders.datereceived,
1940 aqorders.quantityreceived,
1942 aqorders.ordernumber,
1943 aqinvoices.invoicenumber,
1944 aqbooksellers.id as id,
1945 aqorders.biblionumber
1947 LEFT JOIN aqbasket ON aqorders.basketno=aqbasket.basketno
1948 LEFT JOIN aqbasketgroups ON aqbasket.basketgroupid=aqbasketgroups.id
1949 LEFT JOIN aqbooksellers ON aqbasket.booksellerid=aqbooksellers.id
1950 LEFT JOIN biblioitems ON biblioitems.biblionumber=aqorders.biblionumber
1951 LEFT JOIN biblio ON biblio.biblionumber=aqorders.biblionumber
1952 LEFT JOIN aqinvoices ON aqorders.invoiceid = aqinvoices.invoiceid";
1954 $query .= " LEFT JOIN borrowers ON aqbasket.authorisedby=borrowers.borrowernumber"
1955 if ( C4
::Context
->preference("IndependantBranches") );
1957 $query .= " WHERE (datecancellationprinted is NULL or datecancellationprinted='0000-00-00') ";
1959 my @query_params = ();
1962 $query .= " AND biblio.title LIKE ? ";
1963 $title =~ s/\s+/%/g;
1964 push @query_params, "%$title%";
1968 $query .= " AND biblio.author LIKE ? ";
1969 push @query_params, "%$author%";
1973 $query .= " AND biblioitems.isbn LIKE ? ";
1974 push @query_params, "%$isbn%";
1976 if ( defined $ean and $ean ) {
1977 $query .= " AND biblioitems.ean = ? ";
1978 push @query_params, "$ean";
1981 $query .= " AND aqbooksellers.name LIKE ? ";
1982 push @query_params, "%$name%";
1985 if ( $from_placed_on ) {
1986 $query .= " AND creationdate >= ? ";
1987 push @query_params, $from_placed_on;
1990 if ( $to_placed_on ) {
1991 $query .= " AND creationdate <= ? ";
1992 push @query_params, $to_placed_on;
1996 if ($basket =~ m/^\d+$/) {
1997 $query .= " AND aqorders.basketno = ? ";
1998 push @query_params, $basket;
2000 $query .= " AND aqbasket.basketname LIKE ? ";
2001 push @query_params, "%$basket%";
2005 if ($booksellerinvoicenumber) {
2006 $query .= " AND aqinvoices.invoicenumber LIKE ? ";
2007 push @query_params, "%$booksellerinvoicenumber%";
2010 if ($basketgroupname) {
2011 $query .= " AND aqbasketgroups.name LIKE ? ";
2012 push @query_params, "%$basketgroupname%";
2015 if ( C4
::Context
->preference("IndependantBranches") ) {
2016 my $userenv = C4
::Context
->userenv;
2017 if ( $userenv && ($userenv->{flags
} || 0) != 1 ) {
2018 $query .= " AND (borrowers.branchcode = ? OR borrowers.branchcode ='' ) ";
2019 push @query_params, $userenv->{branch
};
2022 $query .= " ORDER BY id";
2023 my $sth = $dbh->prepare($query);
2024 $sth->execute( @query_params );
2026 while ( my $line = $sth->fetchrow_hashref ) {
2027 $line->{count
} = $cnt++;
2028 $line->{toggle
} = 1 if $cnt % 2;
2029 push @order_loop, $line;
2030 $total_qty += $line->{'quantity'};
2031 $total_qtyreceived += $line->{'quantityreceived'};
2032 $total_price += $line->{'quantity'} * $line->{'ecost'};
2034 return \
@order_loop, $total_qty, $total_price, $total_qtyreceived;
2037 =head2 GetRecentAcqui
2039 $results = GetRecentAcqui($days);
2041 C<$results> is a ref to a table which containts hashref
2045 sub GetRecentAcqui
{
2047 my $dbh = C4
::Context
->dbh;
2051 ORDER BY timestamp DESC
2054 my $sth = $dbh->prepare($query);
2056 my $results = $sth->fetchall_arrayref({});
2062 $contractlist = &GetContracts($booksellerid, $activeonly);
2064 Looks up the contracts that belong to a bookseller
2066 Returns a list of contracts
2070 =item C<$booksellerid> is the "id" field in the "aqbooksellers" table.
2072 =item C<$activeonly> if exists get only contracts that are still active.
2079 my ( $booksellerid, $activeonly ) = @_;
2080 my $dbh = C4
::Context
->dbh;
2082 if (! $activeonly) {
2086 WHERE booksellerid=?
2091 WHERE booksellerid=?
2092 AND contractenddate >= CURDATE( )";
2094 my $sth = $dbh->prepare($query);
2095 $sth->execute( $booksellerid );
2097 while (my $data = $sth->fetchrow_hashref ) {
2098 push(@results, $data);
2104 #------------------------------------------------------------#
2108 $contract = &GetContract($contractID);
2110 Looks up the contract that has PRIMKEY (contractnumber) value $contractID
2117 my ( $contractno ) = @_;
2118 my $dbh = C4
::Context
->dbh;
2122 WHERE contractnumber=?
2125 my $sth = $dbh->prepare($query);
2126 $sth->execute( $contractno );
2127 my $result = $sth->fetchrow_hashref;
2135 &AddClaim($ordernumber);
2137 Add a claim for an order
2143 my ($ordernumber) = @_;
2144 my $dbh = C4
::Context
->dbh;
2147 claims_count = claims_count + 1,
2148 claimed_date = CURDATE()
2149 WHERE ordernumber = ?
2151 my $sth = $dbh->prepare($query);
2152 $sth->execute($ordernumber);
2157 my @invoices = GetInvoices(
2158 invoicenumber => $invoicenumber,
2159 suppliername => $suppliername,
2160 shipmentdatefrom => $shipmentdatefrom, # ISO format
2161 shipmentdateto => $shipmentdateto, # ISO format
2162 billingdatefrom => $billingdatefrom, # ISO format
2163 billingdateto => $billingdateto, # ISO format
2164 isbneanissn => $isbn_or_ean_or_issn,
2167 publisher => $publisher,
2168 publicationyear => $publicationyear,
2169 branchcode => $branchcode,
2170 order_by => $order_by
2173 Return a list of invoices that match all given criteria.
2175 $order_by is "column_name (asc|desc)", where column_name is any of
2176 'invoicenumber', 'booksellerid', 'shipmentdate', 'billingdate', 'closedate',
2177 'shipmentcost', 'shipmentcost_budgetid'.
2179 asc is the default if omitted
2186 my @columns = qw(invoicenumber booksellerid shipmentdate billingdate
2187 closedate shipmentcost shipmentcost_budgetid);
2189 my $dbh = C4
::Context
->dbh;
2191 SELECT aqinvoices
.*, aqbooksellers
.name AS suppliername
,
2194 aqorders
.datereceived IS NOT NULL
,
2195 aqorders
.biblionumber
,
2198 ) AS receivedbiblios
,
2199 SUM
(aqorders
.quantityreceived
) AS receiveditems
2201 LEFT JOIN aqbooksellers ON aqbooksellers
.id
= aqinvoices
.booksellerid
2202 LEFT JOIN aqorders ON aqorders
.invoiceid
= aqinvoices
.invoiceid
2203 LEFT JOIN biblio ON aqorders
.biblionumber
= biblio
.biblionumber
2204 LEFT JOIN biblioitems ON biblio
.biblionumber
= biblioitems
.biblionumber
2205 LEFT JOIN subscription ON biblio
.biblionumber
= subscription
.biblionumber
2210 if($args{supplierid
}) {
2211 push @bind_strs, " aqinvoices.booksellerid = ? ";
2212 push @bind_args, $args{supplierid
};
2214 if($args{invoicenumber
}) {
2215 push @bind_strs, " aqinvoices.invoicenumber LIKE ? ";
2216 push @bind_args, "%$args{invoicenumber}%";
2218 if($args{suppliername
}) {
2219 push @bind_strs, " aqbooksellers.name LIKE ? ";
2220 push @bind_args, "%$args{suppliername}%";
2222 if($args{shipmentdatefrom
}) {
2223 push @bind_strs, " aqinvoices.shipementdate >= ? ";
2224 push @bind_args, $args{shipmentdatefrom
};
2226 if($args{shipmentdateto
}) {
2227 push @bind_strs, " aqinvoices.shipementdate <= ? ";
2228 push @bind_args, $args{shipmentdateto
};
2230 if($args{billingdatefrom
}) {
2231 push @bind_strs, " aqinvoices.billingdate >= ? ";
2232 push @bind_args, $args{billingdatefrom
};
2234 if($args{billingdateto
}) {
2235 push @bind_strs, " aqinvoices.billingdate <= ? ";
2236 push @bind_args, $args{billingdateto
};
2238 if($args{isbneanissn
}) {
2239 push @bind_strs, " (biblioitems.isbn LIKE ? OR biblioitems.ean LIKE ? OR biblioitems.issn LIKE ? ) ";
2240 push @bind_args, $args{isbneanissn
}, $args{isbneanissn
}, $args{isbneanissn
};
2243 push @bind_strs, " biblio.title LIKE ? ";
2244 push @bind_args, $args{title
};
2247 push @bind_strs, " biblio.author LIKE ? ";
2248 push @bind_args, $args{author
};
2250 if($args{publisher
}) {
2251 push @bind_strs, " biblioitems.publishercode LIKE ? ";
2252 push @bind_args, $args{publisher
};
2254 if($args{publicationyear
}) {
2255 push @bind_strs, " biblioitems.publicationyear = ? ";
2256 push @bind_args, $args{publicationyear
};
2258 if($args{branchcode
}) {
2259 push @bind_strs, " aqorders.branchcode = ? ";
2260 push @bind_args, $args{branchcode
};
2263 $query .= " WHERE " . join(" AND ", @bind_strs) if @bind_strs;
2264 $query .= " GROUP BY aqinvoices.invoiceid ";
2266 if($args{order_by
}) {
2267 my ($column, $direction) = split / /, $args{order_by
};
2268 if(grep /^$column$/, @columns) {
2269 $direction ||= 'ASC';
2270 $query .= " ORDER BY $column $direction";
2274 my $sth = $dbh->prepare($query);
2275 $sth->execute(@bind_args);
2277 my $results = $sth->fetchall_arrayref({});
2283 my $invoice = GetInvoice($invoiceid);
2285 Get informations about invoice with given $invoiceid
2287 Return a hash filled with aqinvoices.* fields
2292 my ($invoiceid) = @_;
2295 return unless $invoiceid;
2297 my $dbh = C4
::Context
->dbh;
2303 my $sth = $dbh->prepare($query);
2304 $sth->execute($invoiceid);
2306 $invoice = $sth->fetchrow_hashref;
2310 =head3 GetInvoiceDetails
2312 my $invoice = GetInvoiceDetails($invoiceid)
2314 Return informations about an invoice + the list of related order lines
2316 Orders informations are in $invoice->{orders} (array ref)
2320 sub GetInvoiceDetails
{
2321 my ($invoiceid) = @_;
2324 return unless $invoiceid;
2326 my $dbh = C4
::Context
->dbh;
2328 SELECT aqinvoices
.*, aqbooksellers
.name AS suppliername
2330 LEFT JOIN aqbooksellers ON aqinvoices
.booksellerid
= aqbooksellers
.id
2333 my $sth = $dbh->prepare($query);
2334 $sth->execute($invoiceid);
2336 $invoice = $sth->fetchrow_hashref;
2339 SELECT aqorders
.*, biblio
.*
2341 LEFT JOIN biblio ON aqorders
.biblionumber
= biblio
.biblionumber
2344 $sth = $dbh->prepare($query);
2345 $sth->execute($invoiceid);
2346 $invoice->{orders
} = $sth->fetchall_arrayref({});
2347 $invoice->{orders
} ||= []; # force an empty arrayref if fetchall_arrayref fails
2354 my $invoiceid = AddInvoice(
2355 invoicenumber => $invoicenumber,
2356 booksellerid => $booksellerid,
2357 shipmentdate => $shipmentdate,
2358 billingdate => $billingdate,
2359 closedate => $closedate,
2360 shipmentcost => $shipmentcost,
2361 shipmentcost_budgetid => $shipmentcost_budgetid
2364 Create a new invoice and return its id or undef if it fails.
2371 return unless(%invoice and $invoice{invoicenumber
});
2373 my @columns = qw(invoicenumber booksellerid shipmentdate billingdate
2374 closedate shipmentcost shipmentcost_budgetid);
2378 foreach my $key (keys %invoice) {
2379 if(0 < grep(/^$key$/, @columns)) {
2380 push @set_strs, "$key = ?";
2381 push @set_args, ($invoice{$key} || undef);
2387 my $dbh = C4
::Context
->dbh;
2388 my $query = "INSERT INTO aqinvoices SET ";
2389 $query .= join (",", @set_strs);
2390 my $sth = $dbh->prepare($query);
2391 $rv = $sth->execute(@set_args);
2393 $rv = $dbh->last_insert_id(undef, undef, 'aqinvoices', undef);
2402 invoiceid => $invoiceid, # Mandatory
2403 invoicenumber => $invoicenumber,
2404 booksellerid => $booksellerid,
2405 shipmentdate => $shipmentdate,
2406 billingdate => $billingdate,
2407 closedate => $closedate,
2408 shipmentcost => $shipmentcost,
2409 shipmentcost_budgetid => $shipmentcost_budgetid
2412 Modify an invoice, invoiceid is mandatory.
2414 Return undef if it fails.
2421 return unless(%invoice and $invoice{invoiceid
});
2423 my @columns = qw(invoicenumber booksellerid shipmentdate billingdate
2424 closedate shipmentcost shipmentcost_budgetid);
2428 foreach my $key (keys %invoice) {
2429 if(0 < grep(/^$key$/, @columns)) {
2430 push @set_strs, "$key = ?";
2431 push @set_args, ($invoice{$key} || undef);
2435 my $dbh = C4
::Context
->dbh;
2436 my $query = "UPDATE aqinvoices SET ";
2437 $query .= join(",", @set_strs);
2438 $query .= " WHERE invoiceid = ?";
2440 my $sth = $dbh->prepare($query);
2441 $sth->execute(@set_args, $invoice{invoiceid
});
2446 CloseInvoice($invoiceid);
2450 Equivalent to ModInvoice(invoiceid => $invoiceid, closedate => undef);
2455 my ($invoiceid) = @_;
2457 return unless $invoiceid;
2459 my $dbh = C4
::Context
->dbh;
2462 SET closedate
= CAST
(NOW
() AS DATE
)
2465 my $sth = $dbh->prepare($query);
2466 $sth->execute($invoiceid);
2469 =head3 ReopenInvoice
2471 ReopenInvoice($invoiceid);
2475 Equivalent to ModInvoice(invoiceid => $invoiceid, closedate => C4::Dates->new()->output('iso'))
2480 my ($invoiceid) = @_;
2482 return unless $invoiceid;
2484 my $dbh = C4
::Context
->dbh;
2487 SET closedate
= NULL
2490 my $sth = $dbh->prepare($query);
2491 $sth->execute($invoiceid);
2499 Koha Development Team <http://koha-community.org/>