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 with
17 # Koha; if not, write to the Free Software Foundation, Inc., 59 Temple Place,
18 # Suite 330, Boston, MA 02111-1307 USA
24 use C4::Dates qw(format_date format_date_in_iso);
28 use C4::SQLHelper qw(InsertInTable);
33 use vars qw($VERSION @ISA @EXPORT);
36 # set the version for version checking
41 &GetBasket &NewBasket &CloseBasket &DelBasket &ModBasket
42 &GetBasketsByBookseller &GetBasketsByBasketgroup
46 &ModBasketgroup &NewBasketgroup &DelBasketgroup &GetBasketgroup &CloseBasketgroup
47 &GetBasketgroups &ReOpenBasketgroup
49 &NewOrder &DelOrder &ModOrder &GetPendingOrders &GetOrder &GetOrders
50 &GetOrderNumber &GetLateOrders &GetOrderFromItemnumber
51 &SearchOrder &GetHistory &GetRecentAcqui
52 &ModReceiveOrder &ModOrderBiblioitemNumber
54 &NewOrderItem &ModOrderItem
56 &GetParcels &GetParcel
57 &GetContracts &GetContract
59 &GetItemnumbersFromOrder
67 sub GetOrderFromItemnumber {
68 my ($itemnumber) = @_;
69 my $dbh = C4::Context->dbh;
72 SELECT * from aqorders LEFT JOIN aqorders_items
73 ON ( aqorders.ordernumber = aqorders_items.ordernumber )
74 WHERE itemnumber = ? |;
76 my $sth = $dbh->prepare($query);
80 $sth->execute($itemnumber);
82 my $order = $sth->fetchrow_hashref;
87 # Returns the itemnumber(s) associated with the ordernumber given in parameter
88 sub GetItemnumbersFromOrder {
89 my ($ordernumber) = @_;
90 my $dbh = C4::Context->dbh;
91 my $query = "SELECT itemnumber FROM aqorders_items WHERE ordernumber=?";
92 my $sth = $dbh->prepare($query);
93 $sth->execute($ordernumber);
96 while (my $order = $sth->fetchrow_hashref) {
97 push @tab, $order->{'itemnumber'};
111 C4::Acquisition - Koha functions for dealing with orders and acquisitions
119 The functions in this module deal with acquisitions, managing book
120 orders, basket and parcels.
124 =head2 FUNCTIONS ABOUT BASKETS
130 $aqbasket = &GetBasket($basketnumber);
132 get all basket informations in aqbasket for a given basket
135 informations for a given basket returned as a hashref.
143 my $dbh = C4::Context->dbh;
146 concat( b.firstname,' ',b.surname) AS authorisedbyname,
147 b.branchcode AS branch
149 LEFT JOIN borrowers b ON aqbasket.authorisedby=b.borrowernumber
152 my $sth=$dbh->prepare($query);
153 $sth->execute($basketno);
154 my $basket = $sth->fetchrow_hashref;
158 #------------------------------------------------------------#
164 $basket = &NewBasket( $booksellerid, $authorizedby, $basketname, $basketnote, $basketbooksellernote, $basketcontractnumber );
166 Create a new basket in aqbasket table
168 =item C<$booksellerid> is a foreign key in the aqbasket table
170 =item C<$authorizedby> is the username of who created the basket
172 The other parameters are optional, see ModBasketHeader for more info on them.
178 # FIXME : this function seems to be unused.
181 my ( $booksellerid, $authorisedby, $basketname, $basketnote, $basketbooksellernote, $basketcontractnumber ) = @_;
182 my $dbh = C4::Context->dbh;
185 (creationdate,booksellerid,authorisedby)
186 VALUES (now(),'$booksellerid','$authorisedby')
190 #find & return basketno MYSQL dependant, but $dbh->last_insert_id always returns null :-(
191 my $basket = $dbh->{'mysql_insertid'};
192 ModBasketHeader($basket, $basketname || '', $basketnote || '', $basketbooksellernote || '', $basketcontractnumber || undef);
196 #------------------------------------------------------------#
202 &CloseBasket($basketno);
204 close a basket (becomes unmodifiable,except for recieves)
212 my $dbh = C4::Context->dbh;
218 my $sth = $dbh->prepare($query);
219 $sth->execute($basketno);
222 #------------------------------------------------------------#
224 =head3 CloseBasketgroup
228 &CloseBasketgroup($basketgroupno);
236 sub CloseBasketgroup {
237 my ($basketgroupno) = @_;
238 my $dbh = C4::Context->dbh;
239 my $sth = $dbh->prepare("
240 UPDATE aqbasketgroups
244 $sth->execute($basketgroupno);
247 #------------------------------------------------------------#
249 =head3 ReOpenBaskergroup($basketgroupno)
253 &ReOpenBaskergroup($basketgroupno);
261 sub ReOpenBasketgroup {
262 my ($basketgroupno) = @_;
263 my $dbh = C4::Context->dbh;
264 my $sth = $dbh->prepare("
265 UPDATE aqbasketgroups
269 $sth->execute($basketgroupno);
272 #------------------------------------------------------------#
279 &DelBasket($basketno);
281 Deletes the basket that has basketno field $basketno in the aqbasket table.
285 =item C<$basketno> is the primary key of the basket in the aqbasket table.
293 my ( $basketno ) = @_;
294 my $query = "DELETE FROM aqbasket WHERE basketno=?";
295 my $dbh = C4::Context->dbh;
296 my $sth = $dbh->prepare($query);
297 $sth->execute($basketno);
301 #------------------------------------------------------------#
307 &ModBasket($basketinfo);
309 Modifies a basket, using a hashref $basketinfo for the relevant information, only $basketinfo->{'basketno'} is required.
313 =item C<$basketno> is the primary key of the basket in the aqbasket table.
321 my $basketinfo = shift;
322 my $query = "UPDATE aqbasket SET ";
324 foreach my $key (keys %$basketinfo){
325 if ($key ne 'basketno'){
326 $query .= "$key=?, ";
327 push(@params, $basketinfo->{$key} || undef );
330 # get rid of the "," at the end of $query
331 if (substr($query, length($query)-2) eq ', '){
336 $query .= "WHERE basketno=?";
337 push(@params, $basketinfo->{'basketno'});
338 my $dbh = C4::Context->dbh;
339 my $sth = $dbh->prepare($query);
340 $sth->execute(@params);
344 #------------------------------------------------------------#
346 =head3 ModBasketHeader
350 &ModBasketHeader($basketno, $basketname, $note, $booksellernote, $contractnumber);
352 Modifies a basket's header.
356 =item C<$basketno> is the "basketno" field in the "aqbasket" table;
358 =item C<$basketname> is the "basketname" field in the "aqbasket" table;
360 =item C<$note> is the "note" field in the "aqbasket" table;
362 =item C<$booksellernote> is the "booksellernote" field in the "aqbasket" table;
364 =item C<$contractnumber> is the "contractnumber" (foreign) key in the "aqbasket" table.
371 sub ModBasketHeader {
372 my ($basketno, $basketname, $note, $booksellernote, $contractnumber) = @_;
373 my $query = "UPDATE aqbasket SET basketname=?, note=?, booksellernote=? WHERE basketno=?";
374 my $dbh = C4::Context->dbh;
375 my $sth = $dbh->prepare($query);
376 $sth->execute($basketname,$note,$booksellernote,$basketno);
377 if ( $contractnumber ) {
378 my $query2 ="UPDATE aqbasket SET contractnumber=? WHERE basketno=?";
379 my $sth2 = $dbh->prepare($query2);
380 $sth2->execute($contractnumber,$basketno);
386 #------------------------------------------------------------#
388 =head3 GetBasketsByBookseller
392 @results = &GetBasketsByBookseller($booksellerid, $extra);
394 Returns a list of hashes of all the baskets that belong to bookseller 'booksellerid'.
398 =item C<$booksellerid> is the 'id' field of the bookseller in the aqbooksellers table
400 =item C<$extra> is the extra sql parameters, can be
402 - $extra->{groupby}: group baskets by column
403 ex. $extra->{groupby} = aqbasket.basketgroupid
404 - $extra->{orderby}: order baskets by column
405 - $extra->{limit}: limit number of results (can be helpful for pagination)
413 sub GetBasketsByBookseller {
414 my ($booksellerid, $extra) = @_;
415 my $query = "SELECT * FROM aqbasket WHERE booksellerid=?";
417 if ($extra->{groupby}) {
418 $query .= " GROUP by $extra->{groupby}";
420 if ($extra->{orderby}){
421 $query .= " ORDER by $extra->{orderby}";
423 if ($extra->{limit}){
424 $query .= " LIMIT $extra->{limit}";
427 my $dbh = C4::Context->dbh;
428 my $sth = $dbh->prepare($query);
429 $sth->execute($booksellerid);
430 my $results = $sth->fetchall_arrayref({});
435 #------------------------------------------------------------#
437 =head3 GetBasketsByBasketgroup
441 $baskets = &GetBasketsByBasketgroup($basketgroupid);
445 Returns a reference to all baskets that belong to basketgroup $basketgroupid.
453 sub GetBasketsByBasketgroup {
454 my $basketgroupid = shift;
455 my $query = "SELECT * FROM aqbasket
456 LEFT JOIN aqcontract USING(contractnumber) WHERE basketgroupid=?";
457 my $dbh = C4::Context->dbh;
458 my $sth = $dbh->prepare($query);
459 $sth->execute($basketgroupid);
460 my $results = $sth->fetchall_arrayref({});
465 #------------------------------------------------------------#
467 =head3 NewBasketgroup
471 $basketgroupid = NewBasketgroup(\%hashref);
475 Adds a basketgroup to the aqbasketgroups table, and add the initial baskets to it.
477 $hashref->{'booksellerid'} is the 'id' field of the bookseller in the aqbooksellers table,
479 $hashref->{'name'} is the 'name' field of the basketgroup in the aqbasketgroups table,
481 $hashref->{'basketlist'} is a list reference of the 'id's of the baskets that belong to this group,
483 $hashref->{'deliveryplace'} is the 'deliveryplace' field of the basketgroup in the aqbasketgroups table,
485 $hashref->{'deliverycomment'} is the 'deliverycomment' field of the basketgroup in the aqbasketgroups table,
487 $hashref->{'closed'} is the 'closed' field of the aqbasketgroups table, it is false if 0, true otherwise.
496 my $basketgroupinfo = shift;
497 die "booksellerid is required to create a basketgroup" unless $basketgroupinfo->{'booksellerid'};
498 my $query = "INSERT INTO aqbasketgroups (";
500 foreach my $field ('name', 'deliveryplace', 'deliverycomment', 'closed') {
501 if ( $basketgroupinfo->{$field} ) {
502 $query .= "$field, ";
503 push(@params, $basketgroupinfo->{$field});
506 $query .= "booksellerid) VALUES (";
511 push(@params, $basketgroupinfo->{'booksellerid'});
512 my $dbh = C4::Context->dbh;
513 my $sth = $dbh->prepare($query);
514 $sth->execute(@params);
515 my $basketgroupid = $dbh->{'mysql_insertid'};
516 if( $basketgroupinfo->{'basketlist'} ) {
517 foreach my $basketno (@{$basketgroupinfo->{'basketlist'}}) {
518 my $query2 = "UPDATE aqbasket SET basketgroupid=? WHERE basketno=?";
519 my $sth2 = $dbh->prepare($query2);
520 $sth2->execute($basketgroupid, $basketno);
523 return $basketgroupid;
526 #------------------------------------------------------------#
528 =head3 ModBasketgroup
532 ModBasketgroup(\%hashref);
536 Modifies a basketgroup in the aqbasketgroups table, and add the baskets to it.
538 $hashref->{'id'} is the 'id' field of the basketgroup in the aqbasketgroup table, this parameter is mandatory,
540 $hashref->{'name'} is the 'name' field of the basketgroup in the aqbasketgroups table,
542 $hashref->{'basketlist'} is a list reference of the 'id's of the baskets that belong to this group,
544 $hashref->{'deliveryplace'} is the 'deliveryplace' field of the basketgroup in the aqbasketgroups table,
546 $hashref->{'deliverycomment'} is the 'deliverycomment' field of the basketgroup in the aqbasketgroups table,
548 $hashref->{'closed'} is the 'closed' field of the aqbasketgroups table, it is false if 0, true otherwise.
557 my $basketgroupinfo = shift;
558 die "basketgroup id is required to edit a basketgroup" unless $basketgroupinfo->{'id'};
559 my $dbh = C4::Context->dbh;
560 my $query = "UPDATE aqbasketgroups SET ";
562 foreach my $field (qw(name deliveryplace deliverycomment closed)) {
563 if ( $basketgroupinfo->{$field} ne undef) {
564 $query .= "$field=?, ";
565 push(@params, $basketgroupinfo->{$field});
570 $query .= " WHERE id=?";
571 push(@params, $basketgroupinfo->{'id'});
572 my $sth = $dbh->prepare($query);
573 $sth->execute(@params);
575 $sth = $dbh->prepare('UPDATE aqbasket SET basketgroupid = NULL WHERE basketgroupid = ?');
576 $sth->execute($basketgroupinfo->{'id'});
578 if($basketgroupinfo->{'basketlist'} && @{$basketgroupinfo->{'basketlist'}}){
579 $sth = $dbh->prepare("UPDATE aqbasket SET basketgroupid=? WHERE basketno=?");
580 foreach my $basketno (@{$basketgroupinfo->{'basketlist'}}) {
581 $sth->execute($basketgroupinfo->{'id'}, $basketno);
588 #------------------------------------------------------------#
590 =head3 DelBasketgroup
594 DelBasketgroup($basketgroupid);
598 Deletes a basketgroup in the aqbasketgroups table, and removes the reference to it from the baskets,
600 =item C<$basketgroupid> is the 'id' field of the basket in the aqbasketgroup table
609 my $basketgroupid = shift;
610 die "basketgroup id is required to edit a basketgroup" unless $basketgroupid;
611 my $query = "DELETE FROM aqbasketgroups WHERE id=?";
612 my $dbh = C4::Context->dbh;
613 my $sth = $dbh->prepare($query);
614 $sth->execute($basketgroupid);
618 #------------------------------------------------------------#
622 =head2 FUNCTIONS ABOUT ORDERS
628 =head3 GetBasketgroup
632 $basketgroup = &GetBasketgroup($basketgroupid);
636 Returns a reference to the hash containing all infermation about the basketgroup.
645 my $basketgroupid = shift;
646 die "basketgroup id is required to edit a basketgroup" unless $basketgroupid;
647 my $query = "SELECT * FROM aqbasketgroups WHERE id=?";
648 my $dbh = C4::Context->dbh;
649 my $sth = $dbh->prepare($query);
650 $sth->execute($basketgroupid);
651 my $result = $sth->fetchrow_hashref;
656 #------------------------------------------------------------#
658 =head3 GetBasketgroups
662 $basketgroups = &GetBasketgroups($booksellerid);
666 Returns a reference to the array of all the basketgroups of bookseller $booksellerid.
674 sub GetBasketgroups {
675 my $booksellerid = shift;
676 die "bookseller id is required to edit a basketgroup" unless $booksellerid;
677 my $query = "SELECT * FROM aqbasketgroups WHERE booksellerid=?";
678 my $dbh = C4::Context->dbh;
679 my $sth = $dbh->prepare($query);
680 $sth->execute($booksellerid);
681 my $results = $sth->fetchall_arrayref({});
686 #------------------------------------------------------------#
690 =head2 FUNCTIONS ABOUT ORDERS
696 #------------------------------------------------------------#
698 =head3 GetPendingOrders
702 $orders = &GetPendingOrders($booksellerid, $grouped, $owner);
704 Finds pending orders from the bookseller with the given ID. Ignores
705 completed and cancelled orders.
707 C<$booksellerid> contains the bookseller identifier
708 C<$grouped> contains 0 or 1. 0 means returns the list, 1 means return the total
709 C<$owner> contains 0 or 1. 0 means any owner. 1 means only the list of orders entered by the user itself.
711 C<$orders> is a reference-to-array; each element is a
712 reference-to-hash with the following fields:
713 C<$grouped> is a boolean that, if set to 1 will group all order lines of the same basket
714 in a single result line
718 =item C<authorizedby>
724 These give the value of the corresponding field in the aqorders table
725 of the Koha database.
731 Results are ordered from most to least recent.
735 sub GetPendingOrders {
736 my ($supplierid,$grouped,$owner,$basketno) = @_;
737 my $dbh = C4::Context->dbh;
739 SELECT ".($grouped?"count(*),":"")."aqbasket.basketno,
740 surname,firstname,aqorders.*,biblio.*,biblioitems.isbn,
741 aqbasket.closedate, aqbasket.creationdate, aqbasket.basketname
743 LEFT JOIN aqbasket ON aqbasket.basketno=aqorders.basketno
744 LEFT JOIN borrowers ON aqbasket.authorisedby=borrowers.borrowernumber
745 LEFT JOIN biblio ON biblio.biblionumber=aqorders.biblionumber
746 LEFT JOIN biblioitems ON biblioitems.biblionumber=biblio.biblionumber
748 AND (quantity > quantityreceived OR quantityreceived is NULL)
749 AND datecancellationprinted IS NULL
750 AND (to_days(now())-to_days(closedate) < 180 OR closedate IS NULL)
752 ## FIXME Why 180 days ???
753 my @query_params = ( $supplierid );
754 my $userenv = C4::Context->userenv;
755 if ( C4::Context->preference("IndependantBranches") ) {
756 if ( ($userenv) && ( $userenv->{flags} != 1 ) ) {
757 $strsth .= " and (borrowers.branchcode = ?
758 or borrowers.branchcode = '')";
759 push @query_params, $userenv->{branch};
763 $strsth .= " AND aqbasket.authorisedby=? ";
764 push @query_params, $userenv->{'number'};
767 $strsth .= " AND aqbasket.basketno=? ";
768 push @query_params, $basketno;
770 $strsth .= " group by aqbasket.basketno" if $grouped;
771 $strsth .= " order by aqbasket.basketno";
773 my $sth = $dbh->prepare($strsth);
774 $sth->execute( @query_params );
775 my $results = $sth->fetchall_arrayref({});
780 #------------------------------------------------------------#
786 @orders = &GetOrders($basketnumber, $orderby);
788 Looks up the pending (non-cancelled) orders with the given basket
789 number. If C<$booksellerID> is non-empty, only orders from that seller
793 C<&basket> returns a two-element array. C<@orders> is an array of
794 references-to-hash, whose keys are the fields from the aqorders,
795 biblio, and biblioitems tables in the Koha database.
802 my ( $basketno, $orderby ) = @_;
803 my $dbh = C4::Context->dbh;
805 SELECT biblio.*,biblioitems.*,
810 LEFT JOIN aqbudgets ON aqbudgets.budget_id = aqorders.budget_id
811 LEFT JOIN biblio ON biblio.biblionumber = aqorders.biblionumber
812 LEFT JOIN biblioitems ON biblioitems.biblionumber =biblio.biblionumber
814 AND (datecancellationprinted IS NULL OR datecancellationprinted='0000-00-00')
817 $orderby = "biblioitems.publishercode,biblio.title" unless $orderby;
818 $query .= " ORDER BY $orderby";
819 my $sth = $dbh->prepare($query);
820 $sth->execute($basketno);
821 my $results = $sth->fetchall_arrayref({});
826 #------------------------------------------------------------#
828 =head3 GetOrderNumber
832 $ordernumber = &GetOrderNumber($biblioitemnumber, $biblionumber);
836 Looks up the ordernumber with the given biblionumber and biblioitemnumber.
838 Returns the number of this order.
842 =item C<$ordernumber> is the order number.
848 my ( $biblionumber,$biblioitemnumber ) = @_;
849 my $dbh = C4::Context->dbh;
854 AND biblioitemnumber=?
856 my $sth = $dbh->prepare($query);
857 $sth->execute( $biblionumber, $biblioitemnumber );
859 return $sth->fetchrow;
862 #------------------------------------------------------------#
868 $order = &GetOrder($ordernumber);
870 Looks up an order by order number.
872 Returns a reference-to-hash describing the order. The keys of
873 C<$order> are fields from the biblio, biblioitems, aqorders tables of the Koha database.
880 my ($ordernumber) = @_;
881 my $dbh = C4::Context->dbh;
883 SELECT biblioitems.*, biblio.*, aqorders.*
885 LEFT JOIN biblio on biblio.biblionumber=aqorders.biblionumber
886 LEFT JOIN biblioitems on biblioitems.biblionumber=aqorders.biblionumber
887 WHERE aqorders.ordernumber=?
890 my $sth= $dbh->prepare($query);
891 $sth->execute($ordernumber);
892 my $data = $sth->fetchrow_hashref;
897 #------------------------------------------------------------#
903 &NewOrder(\%hashref);
905 Adds a new order to the database. Any argument that isn't described
906 below is the new value of the field with the same name in the aqorders
907 table of the Koha database.
911 =item $hashref->{'basketno'} is the basketno foreign key in aqorders, it is mandatory
914 =item $hashref->{'ordernumber'} is a "minimum order number."
916 =item $hashref->{'budgetdate'} is effectively ignored.
917 If it's undef (anything false) or the string 'now', the current day is used.
918 Else, the upcoming July 1st is used.
920 =item $hashref->{'subscription'} may be either "yes", or anything else for "no".
922 =item $hashref->{'uncertainprice'} may be 0 for "the price is known" or 1 for "the price is uncertain"
924 =item defaults entrydate to Now
926 The following keys are used: "biblionumber", "title", "basketno", "quantity", "notes", "biblioitemnumber", "rrp", "ecost", "gst", "unitprice", "subscription", "sort1", "sort2", "booksellerinvoicenumber", "listprice", "budgetdate", "purchaseordernumber", "branchcode", "booksellerinvoicenumber", "bookfundid".
935 my $orderinfo = shift;
936 #### ------------------------------
937 my $dbh = C4::Context->dbh;
941 # if these parameters are missing, we can't continue
942 for my $key (qw/basketno quantity biblionumber budget_id/) {
943 die "Mandatory parameter $key missing" unless $orderinfo->{$key};
946 if ( $orderinfo->{'subscription'} eq 'yes' ) {
947 $orderinfo->{'subscription'} = 1;
949 $orderinfo->{'subscription'} = 0;
951 $orderinfo->{'entrydate'} ||= C4::Dates->new()->output("iso");
953 my $ordernumber=InsertInTable("aqorders",$orderinfo);
954 return ( $orderinfo->{'basketno'}, $ordernumber );
959 #------------------------------------------------------------#
973 #my ($biblioitemnumber,$ordernumber, $biblionumber) = @_;
974 my ($itemnumber, $ordernumber) = @_;
975 my $dbh = C4::Context->dbh;
977 INSERT INTO aqorders_items
978 (itemnumber, ordernumber)
981 my $sth = $dbh->prepare($query);
982 $sth->execute( $itemnumber, $ordernumber);
985 #------------------------------------------------------------#
991 &ModOrder(\%hashref);
995 Modifies an existing order. Updates the order with order number
996 $hashref->{'ordernumber'} and biblionumber $hashref->{'biblionumber'}. All other keys of the hash
997 update the fields with the same name in the aqorders table of the Koha database.
1006 my $orderinfo = shift;
1008 die "Ordernumber is required" if $orderinfo->{'ordernumber'} eq '' ;
1009 die "Biblionumber is required" if $orderinfo->{'biblionumber'} eq '';
1011 my $dbh = C4::Context->dbh;
1013 # delete($orderinfo->{'branchcode'});
1014 # the hash contains a lot of entries not in aqorders, so get the columns ...
1015 my $sth = $dbh->prepare("SELECT * FROM aqorders LIMIT 1;");
1017 my $colnames = $sth->{NAME};
1018 my $query = "UPDATE aqorders SET ";
1020 foreach my $orderinfokey (grep(!/ordernumber/, keys %$orderinfo)){
1021 # ... and skip hash entries that are not in the aqorders table
1022 # FIXME : probably not the best way to do it (would be better to have a correct hash)
1023 next unless grep(/^$orderinfokey$/, @$colnames);
1024 $query .= "$orderinfokey=?, ";
1025 push(@params, $orderinfo->{$orderinfokey});
1028 $query .= "timestamp=NOW() WHERE ordernumber=?";
1029 # push(@params, $specorderinfo{'ordernumber'});
1030 push(@params, $orderinfo->{'ordernumber'} );
1031 $sth = $dbh->prepare($query);
1032 $sth->execute(@params);
1036 #------------------------------------------------------------#
1042 &ModOrderItem(\%hashref);
1046 Modifies the itemnumber in the aqorders_items table. The input hash needs three entities:
1047 - itemnumber: the old itemnumber
1048 - ordernumber: the order this item is attached to
1049 - newitemnumber: the new itemnumber we want to attach the line to
1058 my $orderiteminfo = shift;
1059 if (! $orderiteminfo->{'ordernumber'} || ! $orderiteminfo->{'itemnumber'} || ! $orderiteminfo->{'newitemnumber'}){
1060 die "Ordernumber, itemnumber and newitemnumber is required";
1063 my $dbh = C4::Context->dbh;
1065 my $query = "UPDATE aqorders_items set itemnumber=? where itemnumber=? and ordernumber=?";
1066 my @params = ($orderiteminfo->{'newitemnumber'}, $orderiteminfo->{'itemnumber'}, $orderiteminfo->{'ordernumber'});
1068 warn Data::Dumper::Dumper(@params);
1069 my $sth = $dbh->prepare($query);
1070 $sth->execute(@params);
1074 #------------------------------------------------------------#
1077 =head3 ModOrderBibliotemNumber
1081 &ModOrderBiblioitemNumber($biblioitemnumber,$ordernumber, $biblionumber);
1083 Modifies the biblioitemnumber for an existing order.
1084 Updates the order with order number C<$ordernum> and biblionumber C<$biblionumber>.
1090 #FIXME: is this used at all?
1091 sub ModOrderBiblioitemNumber {
1092 my ($biblioitemnumber,$ordernumber, $biblionumber) = @_;
1093 my $dbh = C4::Context->dbh;
1096 SET biblioitemnumber = ?
1097 WHERE ordernumber = ?
1098 AND biblionumber = ?";
1099 my $sth = $dbh->prepare($query);
1100 $sth->execute( $biblioitemnumber, $ordernumber, $biblionumber );
1103 #------------------------------------------------------------#
1105 =head3 ModReceiveOrder
1109 &ModReceiveOrder($biblionumber, $ordernumber, $quantityreceived, $user,
1110 $unitprice, $booksellerinvoicenumber, $biblioitemnumber,
1111 $freight, $bookfund, $rrp);
1113 Updates an order, to reflect the fact that it was received, at least
1114 in part. All arguments not mentioned below update the fields with the
1115 same name in the aqorders table of the Koha database.
1117 If a partial order is received, splits the order into two. The received
1118 portion must have a booksellerinvoicenumber.
1120 Updates the order with bibilionumber C<$biblionumber> and ordernumber
1128 sub ModReceiveOrder {
1130 $biblionumber, $ordernumber, $quantrec, $user, $cost,
1131 $invoiceno, $freight, $rrp, $budget_id, $datereceived
1134 my $dbh = C4::Context->dbh;
1135 # warn "DATE BEFORE : $daterecieved";
1136 # $daterecieved=POSIX::strftime("%Y-%m-%d",CORE::localtime) unless $daterecieved;
1137 # warn "DATE REC : $daterecieved";
1138 $datereceived = C4::Dates->output('iso') unless $datereceived;
1139 my $suggestionid = GetSuggestionFromBiblionumber( $dbh, $biblionumber );
1140 if ($suggestionid) {
1141 ModStatus( $suggestionid, 'AVAILABLE', '', $biblionumber );
1144 my $sth=$dbh->prepare("
1145 SELECT * FROM aqorders
1146 WHERE biblionumber=? AND aqorders.ordernumber=?");
1148 $sth->execute($biblionumber,$ordernumber);
1149 my $order = $sth->fetchrow_hashref();
1152 if ( $order->{quantity} > $quantrec ) {
1153 $sth=$dbh->prepare("
1155 SET quantityreceived=?
1157 , booksellerinvoicenumber=?
1161 , quantityreceived=?
1162 WHERE biblionumber=? AND ordernumber=?");
1164 $sth->execute($quantrec,$datereceived,$invoiceno,$cost,$freight,$rrp,$quantrec,$biblionumber,$ordernumber);
1167 # create a new order for the remaining items, and set its bookfund.
1168 foreach my $orderkey ( "linenumber", "allocation" ) {
1169 delete($order->{'$orderkey'});
1171 my $newOrder = NewOrder($order);
1173 $sth=$dbh->prepare("update aqorders
1174 set quantityreceived=?,datereceived=?,booksellerinvoicenumber=?,
1175 unitprice=?,freight=?,rrp=?
1176 where biblionumber=? and ordernumber=?");
1177 $sth->execute($quantrec,$datereceived,$invoiceno,$cost,$freight,$rrp,$biblionumber,$ordernumber);
1180 return $datereceived;
1182 #------------------------------------------------------------#
1186 @results = &SearchOrder($search, $biblionumber, $complete);
1188 Searches for orders.
1190 C<$search> may take one of several forms: if it is an ISBN,
1191 C<&ordersearch> returns orders with that ISBN. If C<$search> is an
1192 order number, C<&ordersearch> returns orders with that order number
1193 and biblionumber C<$biblionumber>. Otherwise, C<$search> is considered
1194 to be a space-separated list of search terms; in this case, all of the
1195 terms must appear in the title (matching the beginning of title
1198 If C<$complete> is C<yes>, the results will include only completed
1199 orders. In any case, C<&ordersearch> ignores cancelled orders.
1201 C<&ordersearch> returns an array.
1202 C<@results> is an array of references-to-hash with the following keys:
1208 =item C<seriestitle>
1219 #### -------- SearchOrder-------------------------------
1220 my ($ordernumber, $search, $supplierid, $basket) = @_;
1222 my $dbh = C4::Context->dbh;
1227 LEFT JOIN biblio ON aqorders.biblionumber=biblio.biblionumber
1228 LEFT JOIN biblioitems ON biblioitems.biblionumber=biblio.biblionumber
1229 LEFT JOIN aqbasket ON aqorders.basketno = aqbasket.basketno
1230 WHERE (datecancellationprinted is NULL)";
1233 $query .= " AND (aqorders.ordernumber=?)";
1234 push @args, $ordernumber;
1237 $query .= " AND (biblio.title like ? OR biblio.author LIKE ? OR biblioitems.isbn like ?)";
1238 push @args, ("%$search%","%$search%","%$search%");
1241 $query .= "AND aqbasket.booksellerid = ?";
1242 push @args, $supplierid;
1245 $query .= "AND aqorders.basketno = ?";
1246 push @args, $basket;
1249 my $sth = $dbh->prepare($query);
1250 $sth->execute(@args);
1251 my $results = $sth->fetchall_arrayref({});
1256 #------------------------------------------------------------#
1262 &DelOrder($biblionumber, $ordernumber);
1264 Cancel the order with the given order and biblio numbers. It does not
1265 delete any entries in the aqorders table, it merely marks them as
1273 my ( $bibnum, $ordernumber ) = @_;
1274 my $dbh = C4::Context->dbh;
1277 SET datecancellationprinted=now()
1278 WHERE biblionumber=? AND ordernumber=?
1280 my $sth = $dbh->prepare($query);
1281 $sth->execute( $bibnum, $ordernumber );
1285 =head2 FUNCTIONS ABOUT PARCELS
1289 #------------------------------------------------------------#
1295 @results = &GetParcel($booksellerid, $code, $date);
1297 Looks up all of the received items from the supplier with the given
1298 bookseller ID at the given date, for the given code (bookseller Invoice number). Ignores cancelled and completed orders.
1300 C<@results> is an array of references-to-hash. The keys of each element are fields from
1301 the aqorders, biblio, and biblioitems tables of the Koha database.
1303 C<@results> is sorted alphabetically by book title.
1310 #gets all orders from a certain supplier, orders them alphabetically
1311 my ( $supplierid, $code, $datereceived ) = @_;
1312 my $dbh = C4::Context->dbh;
1315 if $code; # add % if we search on a given code (otherwise, let him empty)
1317 SELECT authorisedby,
1322 aqorders.biblionumber,
1323 aqorders.ordernumber,
1325 aqorders.quantityreceived,
1332 LEFT JOIN aqbasket ON aqbasket.basketno=aqorders.basketno
1333 LEFT JOIN borrowers ON aqbasket.authorisedby=borrowers.borrowernumber
1334 LEFT JOIN biblio ON aqorders.biblionumber=biblio.biblionumber
1336 aqbasket.booksellerid = ?
1337 AND aqorders.booksellerinvoicenumber LIKE ?
1338 AND aqorders.datereceived = ? ";
1340 my @query_params = ( $supplierid, $code, $datereceived );
1341 if ( C4::Context->preference("IndependantBranches") ) {
1342 my $userenv = C4::Context->userenv;
1343 if ( ($userenv) && ( $userenv->{flags} != 1 ) ) {
1344 $strsth .= " and (borrowers.branchcode = ?
1345 or borrowers.branchcode = '')";
1346 push @query_params, $userenv->{branch};
1349 $strsth .= " ORDER BY aqbasket.basketno";
1350 # ## parcelinformation : $strsth
1351 my $sth = $dbh->prepare($strsth);
1352 $sth->execute( @query_params );
1353 while ( my $data = $sth->fetchrow_hashref ) {
1354 push( @results, $data );
1356 # ## countparcelbiblio: scalar(@results)
1362 #------------------------------------------------------------#
1368 $results = &GetParcels($bookseller, $order, $code, $datefrom, $dateto);
1369 get a lists of parcels.
1378 is the bookseller this function has to get parcels.
1381 To know on what criteria the results list has to be ordered.
1384 is the booksellerinvoicenumber.
1386 =item $datefrom & $dateto
1387 to know on what date this function has to filter its search.
1390 a pointer on a hash list containing parcel informations as such :
1394 =item Last operation
1396 =item Number of biblio
1398 =item Number of items
1405 my ($bookseller,$order, $code, $datefrom, $dateto) = @_;
1406 my $dbh = C4::Context->dbh;
1407 my @query_params = ();
1409 SELECT aqorders.booksellerinvoicenumber,
1410 datereceived,purchaseordernumber,
1411 count(DISTINCT biblionumber) AS biblio,
1412 sum(quantity) AS itemsexpected,
1413 sum(quantityreceived) AS itemsreceived
1414 FROM aqorders LEFT JOIN aqbasket ON aqbasket.basketno = aqorders.basketno
1415 WHERE aqbasket.booksellerid = $bookseller and datereceived IS NOT NULL
1418 if ( defined $code ) {
1419 $strsth .= ' and aqorders.booksellerinvoicenumber like ? ';
1420 # add a % to the end of the code to allow stemming.
1421 push @query_params, "$code%";
1424 if ( defined $datefrom ) {
1425 $strsth .= ' and datereceived >= ? ';
1426 push @query_params, $datefrom;
1429 if ( defined $dateto ) {
1430 $strsth .= 'and datereceived <= ? ';
1431 push @query_params, $dateto;
1434 $strsth .= "group by aqorders.booksellerinvoicenumber,datereceived ";
1436 # can't use a placeholder to place this column name.
1437 # but, we could probably be checking to make sure it is a column that will be fetched.
1438 $strsth .= "order by $order " if ($order);
1440 my $sth = $dbh->prepare($strsth);
1442 $sth->execute( @query_params );
1443 my $results = $sth->fetchall_arrayref({});
1448 #------------------------------------------------------------#
1450 =head3 GetLateOrders
1454 @results = &GetLateOrders;
1456 Searches for bookseller with late orders.
1459 the table of supplier with late issues. This table is full of hashref.
1467 my $supplierid = shift;
1470 my $dbh = C4::Context->dbh;
1472 #BEWARE, order of parenthesis and LEFT JOIN is important for speed
1473 my $dbdriver = C4::Context->config("db_scheme") || "mysql";
1475 my @query_params = ($delay); # delay is the first argument regardless
1477 SELECT aqbasket.basketno,
1478 aqorders.ordernumber,
1479 DATE(aqbasket.closedate) AS orderdate,
1480 aqorders.rrp AS unitpricesupplier,
1481 aqorders.ecost AS unitpricelib,
1482 aqbudgets.budget_name AS budget,
1483 borrowers.branchcode AS branch,
1484 aqbooksellers.name AS supplier,
1486 biblioitems.publishercode AS publisher,
1487 biblioitems.publicationyear,
1491 (aqorders LEFT JOIN biblio ON biblio.biblionumber = aqorders.biblionumber)
1492 LEFT JOIN biblioitems ON biblioitems.biblionumber = biblio.biblionumber)
1493 LEFT JOIN aqbudgets ON aqorders.budget_id = aqbudgets.budget_id),
1494 (aqbasket LEFT JOIN borrowers ON aqbasket.authorisedby = borrowers.borrowernumber)
1495 LEFT JOIN aqbooksellers ON aqbasket.booksellerid = aqbooksellers.id
1496 WHERE aqorders.basketno = aqbasket.basketno
1497 AND ( (datereceived = '' OR datereceived IS NULL)
1498 OR (aqorders.quantityreceived < aqorders.quantity)
1502 if ($dbdriver eq "mysql") {
1504 aqorders.quantity - IFNULL(aqorders.quantityreceived,0) AS quantity,
1505 (aqorders.quantity - IFNULL(aqorders.quantityreceived,0)) * aqorders.rrp AS subtotal,
1506 DATEDIFF(CURDATE( ),closedate) AS latesince
1508 $from .= " AND (closedate <= DATE_SUB(CURDATE( ),INTERVAL ? DAY)) ";
1510 HAVING quantity <> 0
1511 AND unitpricesupplier <> 0
1512 AND unitpricelib <> 0
1515 # FIXME: account for IFNULL as above
1517 aqorders.quantity AS quantity,
1518 aqorders.quantity * aqorders.rrp AS subtotal,
1519 (CURDATE - closedate) AS latesince
1521 $from .= " AND (closedate <= (CURDATE -(INTERVAL ? DAY)) ";
1523 if (defined $supplierid) {
1524 $from .= ' AND aqbasket.booksellerid = ? ';
1525 push @query_params, $supplierid;
1527 if (defined $branch) {
1528 $from .= ' AND borrowers.branchcode LIKE ? ';
1529 push @query_params, $branch;
1531 if (C4::Context->preference("IndependantBranches")
1532 && C4::Context->userenv
1533 && C4::Context->userenv->{flags} != 1 ) {
1534 $from .= ' AND borrowers.branchcode LIKE ? ';
1535 push @query_params, C4::Context->userenv->{branch};
1537 my $query = "$select $from $having\nORDER BY latesince, basketno, borrowers.branchcode, supplier";
1538 $debug and print STDERR "GetLateOrders query: $query\nGetLateOrders args: " . join(" ",@query_params);
1539 my $sth = $dbh->prepare($query);
1540 $sth->execute(@query_params);
1542 while (my $data = $sth->fetchrow_hashref) {
1543 $data->{orderdate} = format_date($data->{orderdate});
1544 push @results, $data;
1549 #------------------------------------------------------------#
1555 (\@order_loop, $total_qty, $total_price, $total_qtyreceived) = GetHistory( $title, $author, $name, $from_placed_on, $to_placed_on );
1557 Retreives some acquisition history information
1560 $order_loop is a list of hashrefs that each look like this:
1562 'author' => 'Twain, Mark',
1564 'biblionumber' => '215',
1566 'creationdate' => 'MM/DD/YYYY',
1567 'datereceived' => undef,
1570 'invoicenumber' => undef,
1572 'ordernumber' => '1',
1574 'quantityreceived' => undef,
1575 'title' => 'The Adventures of Huckleberry Finn'
1577 $total_qty is the sum of all of the quantities in $order_loop
1578 $total_price is the cost of each in $order_loop times the quantity
1579 $total_qtyreceived is the sum of all of the quantityreceived entries in $order_loop
1586 my ( $title, $author, $name, $from_placed_on, $to_placed_on ) = @_;
1589 my $total_qtyreceived = 0;
1590 my $total_price = 0;
1592 # don't run the query if there are no parameters (list would be too long for sure !)
1593 if ( $title || $author || $name || $from_placed_on || $to_placed_on ) {
1594 my $dbh = C4::Context->dbh;
1600 name,aqbasket.creationdate,
1601 aqorders.datereceived,
1603 aqorders.quantityreceived,
1605 aqorders.ordernumber,
1606 aqorders.booksellerinvoicenumber as invoicenumber,
1607 aqbooksellers.id as id,
1608 aqorders.biblionumber
1610 LEFT JOIN aqbasket ON aqorders.basketno=aqbasket.basketno
1611 LEFT JOIN aqbooksellers ON aqbasket.booksellerid=aqbooksellers.id
1612 LEFT JOIN biblio ON biblio.biblionumber=aqorders.biblionumber";
1614 $query .= " LEFT JOIN borrowers ON aqbasket.authorisedby=borrowers.borrowernumber"
1615 if ( C4::Context->preference("IndependantBranches") );
1617 $query .= " WHERE (datecancellationprinted is NULL or datecancellationprinted='0000-00-00') ";
1619 my @query_params = ();
1621 if ( defined $title ) {
1622 $query .= " AND biblio.title LIKE ? ";
1623 push @query_params, "%$title%";
1626 if ( defined $author ) {
1627 $query .= " AND biblio.author LIKE ? ";
1628 push @query_params, "%$author%";
1631 if ( defined $name ) {
1632 $query .= " AND name LIKE ? ";
1633 push @query_params, "%$name%";
1636 if ( defined $from_placed_on ) {
1637 $query .= " AND creationdate >= ? ";
1638 push @query_params, $from_placed_on;
1641 if ( defined $to_placed_on ) {
1642 $query .= " AND creationdate <= ? ";
1643 push @query_params, $to_placed_on;
1646 if ( C4::Context->preference("IndependantBranches") ) {
1647 my $userenv = C4::Context->userenv;
1648 if ( ($userenv) && ( $userenv->{flags} != 1 ) ) {
1649 $query .= " AND (borrowers.branchcode = ? OR borrowers.branchcode ='' ) ";
1650 push @query_params, $userenv->{branch};
1653 $query .= " ORDER BY booksellerid";
1654 my $sth = $dbh->prepare($query);
1655 $sth->execute( @query_params );
1657 while ( my $line = $sth->fetchrow_hashref ) {
1658 $line->{count} = $cnt++;
1659 $line->{toggle} = 1 if $cnt % 2;
1660 push @order_loop, $line;
1661 $line->{creationdate} = format_date( $line->{creationdate} );
1662 $line->{datereceived} = format_date( $line->{datereceived} );
1663 $total_qty += $line->{'quantity'};
1664 $total_qtyreceived += $line->{'quantityreceived'};
1665 $total_price += $line->{'quantity'} * $line->{'ecost'};
1668 return \@order_loop, $total_qty, $total_price, $total_qtyreceived;
1671 =head2 GetRecentAcqui
1673 $results = GetRecentAcqui($days);
1675 C<$results> is a ref to a table which containts hashref
1679 sub GetRecentAcqui {
1681 my $dbh = C4::Context->dbh;
1685 ORDER BY timestamp DESC
1688 my $sth = $dbh->prepare($query);
1690 my $results = $sth->fetchall_arrayref({});
1698 $contractlist = &GetContracts($booksellerid, $activeonly);
1700 Looks up the contracts that belong to a bookseller
1702 Returns a list of contracts
1704 =item C<$booksellerid> is the "id" field in the "aqbooksellers" table.
1706 =item C<$activeonly> if exists get only contracts that are still active.
1712 my ( $booksellerid, $activeonly ) = @_;
1713 my $dbh = C4::Context->dbh;
1715 if (! $activeonly) {
1719 WHERE booksellerid=?
1724 WHERE booksellerid=?
1725 AND contractenddate >= CURDATE( )";
1727 my $sth = $dbh->prepare($query);
1728 $sth->execute( $booksellerid );
1730 while (my $data = $sth->fetchrow_hashref ) {
1731 push(@results, $data);
1737 #------------------------------------------------------------#
1743 $contract = &GetContract($contractID);
1745 Looks up the contract that has PRIMKEY (contractnumber) value $contractID
1753 my ( $contractno ) = @_;
1754 my $dbh = C4::Context->dbh;
1758 WHERE contractnumber=?
1761 my $sth = $dbh->prepare($query);
1762 $sth->execute( $contractno );
1763 my $result = $sth->fetchrow_hashref;
1772 Koha Developement team <info@koha.org>