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 &CloseBasketgroup &ReOpenBasketgroup &DelBasket &ModBasket
42 &ModBasketHeader &GetBasketsByBookseller &GetBasketsByBasketgroup
43 &ModBasketgroup &NewBasketgroup &DelBasketgroup &GetBasketgroup
46 &GetPendingOrders &GetOrder &GetOrders
47 &GetOrderNumber &GetLateOrders &NewOrder &DelOrder
48 &SearchOrder &GetHistory &GetRecentAcqui
49 &ModOrder &ModOrderItem &ModReceiveOrder &ModOrderBiblioitemNumber
53 &GetParcels &GetParcel
54 &GetContracts &GetContract
56 &GetOrderFromItemnumber
57 &GetItemnumbersFromOrder
65 sub GetOrderFromItemnumber {
66 my ($itemnumber) = @_;
67 my $dbh = C4::Context->dbh;
70 SELECT * from aqorders LEFT JOIN aqorders_items
71 ON ( aqorders.ordernumber = aqorders_items.ordernumber )
72 WHERE itemnumber = ? |;
74 my $sth = $dbh->prepare($query);
78 $sth->execute($itemnumber);
80 my $order = $sth->fetchrow_hashref;
85 # Returns the itemnumber(s) associated with the ordernumber given in parameter
86 sub GetItemnumbersFromOrder {
87 my ($ordernumber) = @_;
88 my $dbh = C4::Context->dbh;
89 my $query = "SELECT itemnumber FROM aqorders_items WHERE ordernumber=?";
90 my $sth = $dbh->prepare($query);
91 $sth->execute($ordernumber);
94 while (my $order = $sth->fetchrow_hashref) {
95 push @tab, $order->{'itemnumber'};
109 C4::Acquisition - Koha functions for dealing with orders and acquisitions
117 The functions in this module deal with acquisitions, managing book
118 orders, basket and parcels.
122 =head2 FUNCTIONS ABOUT BASKETS
128 $aqbasket = &GetBasket($basketnumber);
130 get all basket informations in aqbasket for a given basket
133 informations for a given basket returned as a hashref.
141 my $dbh = C4::Context->dbh;
144 concat( b.firstname,' ',b.surname) AS authorisedbyname,
145 b.branchcode AS branch
147 LEFT JOIN borrowers b ON aqbasket.authorisedby=b.borrowernumber
150 my $sth=$dbh->prepare($query);
151 $sth->execute($basketno);
152 my $basket = $sth->fetchrow_hashref;
156 #------------------------------------------------------------#
162 $basket = &NewBasket( $booksellerid, $authorizedby, $basketname, $basketnote, $basketbooksellernote, $basketcontractnumber );
164 Create a new basket in aqbasket table
166 =item C<$booksellerid> is a foreign key in the aqbasket table
168 =item C<$authorizedby> is the username of who created the basket
170 The other parameters are optional, see ModBasketHeader for more info on them.
176 # FIXME : this function seems to be unused.
179 my ( $booksellerid, $authorisedby, $basketname, $basketnote, $basketbooksellernote, $basketcontractnumber ) = @_;
180 my $dbh = C4::Context->dbh;
183 (creationdate,booksellerid,authorisedby)
184 VALUES (now(),'$booksellerid','$authorisedby')
188 #find & return basketno MYSQL dependant, but $dbh->last_insert_id always returns null :-(
189 my $basket = $dbh->{'mysql_insertid'};
190 ModBasketHeader($basket, $basketname || '', $basketnote || '', $basketbooksellernote || '', $basketcontractnumber || undef);
194 #------------------------------------------------------------#
200 &CloseBasket($basketno);
202 close a basket (becomes unmodifiable,except for recieves)
210 my $dbh = C4::Context->dbh;
216 my $sth = $dbh->prepare($query);
217 $sth->execute($basketno);
220 #------------------------------------------------------------#
222 =head3 CloseBasketgroup
226 &CloseBasketgroup($basketgroupno);
234 sub CloseBasketgroup {
235 my ($basketgroupno) = @_;
236 my $dbh = C4::Context->dbh;
237 my $sth = $dbh->prepare("
238 UPDATE aqbasketgroups
242 $sth->execute($basketgroupno);
245 #------------------------------------------------------------#
247 =head3 ReOpenBaskergroup($basketgroupno)
251 &ReOpenBaskergroup($basketgroupno);
259 sub ReOpenBasketgroup {
260 my ($basketgroupno) = @_;
261 my $dbh = C4::Context->dbh;
262 my $sth = $dbh->prepare("
263 UPDATE aqbasketgroups
267 $sth->execute($basketgroupno);
270 #------------------------------------------------------------#
277 &DelBasket($basketno);
279 Deletes the basket that has basketno field $basketno in the aqbasket table.
283 =item C<$basketno> is the primary key of the basket in the aqbasket table.
291 my ( $basketno ) = @_;
292 my $query = "DELETE FROM aqbasket WHERE basketno=?";
293 my $dbh = C4::Context->dbh;
294 my $sth = $dbh->prepare($query);
295 $sth->execute($basketno);
299 #------------------------------------------------------------#
305 &ModBasket($basketinfo);
307 Modifies a basket, using a hashref $basketinfo for the relevant information, only $basketinfo->{'basketno'} is required.
311 =item C<$basketno> is the primary key of the basket in the aqbasket table.
319 my $basketinfo = shift;
320 my $query = "UPDATE aqbasket SET ";
322 foreach my $key (keys %$basketinfo){
323 if ($key ne 'basketno'){
324 $query .= "$key=?, ";
325 push(@params, $basketinfo->{$key} || undef );
328 # get rid of the "," at the end of $query
329 if (substr($query, length($query)-2) eq ', '){
334 $query .= "WHERE basketno=?";
335 push(@params, $basketinfo->{'basketno'});
336 my $dbh = C4::Context->dbh;
337 my $sth = $dbh->prepare($query);
338 $sth->execute(@params);
342 #------------------------------------------------------------#
344 =head3 ModBasketHeader
348 &ModBasketHeader($basketno, $basketname, $note, $booksellernote, $contractnumber);
350 Modifies a basket's header.
354 =item C<$basketno> is the "basketno" field in the "aqbasket" table;
356 =item C<$basketname> is the "basketname" field in the "aqbasket" table;
358 =item C<$note> is the "note" field in the "aqbasket" table;
360 =item C<$booksellernote> is the "booksellernote" field in the "aqbasket" table;
362 =item C<$contractnumber> is the "contractnumber" (foreign) key in the "aqbasket" table.
369 sub ModBasketHeader {
370 my ($basketno, $basketname, $note, $booksellernote, $contractnumber) = @_;
371 my $query = "UPDATE aqbasket SET basketname=?, note=?, booksellernote=? WHERE basketno=?";
372 my $dbh = C4::Context->dbh;
373 my $sth = $dbh->prepare($query);
374 $sth->execute($basketname,$note,$booksellernote,$basketno);
375 if ( $contractnumber ) {
376 my $query2 ="UPDATE aqbasket SET contractnumber=? WHERE basketno=?";
377 my $sth2 = $dbh->prepare($query2);
378 $sth2->execute($contractnumber,$basketno);
384 #------------------------------------------------------------#
386 =head3 GetBasketsByBookseller
390 @results = &GetBasketsByBookseller($booksellerid, $extra);
392 Returns a list of hashes of all the baskets that belong to bookseller 'booksellerid'.
396 =item C<$booksellerid> is the 'id' field of the bookseller in the aqbooksellers table
398 =item C<$extra> is the extra sql parameters, can be
400 - $extra->{groupby}: group baskets by column
401 ex. $extra->{groupby} = aqbasket.basketgroupid
402 - $extra->{orderby}: order baskets by column
403 - $extra->{limit}: limit number of results (can be helpful for pagination)
411 sub GetBasketsByBookseller {
412 my ($booksellerid, $extra) = @_;
413 my $query = "SELECT * FROM aqbasket WHERE booksellerid=?";
415 if ($extra->{groupby}) {
416 $query .= " GROUP by $extra->{groupby}";
418 if ($extra->{orderby}){
419 $query .= " ORDER by $extra->{orderby}";
421 if ($extra->{limit}){
422 $query .= " LIMIT $extra->{limit}";
425 my $dbh = C4::Context->dbh;
426 my $sth = $dbh->prepare($query);
427 $sth->execute($booksellerid);
428 my $results = $sth->fetchall_arrayref({});
433 #------------------------------------------------------------#
435 =head3 GetBasketsByBasketgroup
439 $baskets = &GetBasketsByBasketgroup($basketgroupid);
443 Returns a reference to all baskets that belong to basketgroup $basketgroupid.
451 sub GetBasketsByBasketgroup {
452 my $basketgroupid = shift;
453 my $query = "SELECT * FROM aqbasket
454 LEFT JOIN aqcontract USING(contractnumber) WHERE basketgroupid=?";
455 my $dbh = C4::Context->dbh;
456 my $sth = $dbh->prepare($query);
457 $sth->execute($basketgroupid);
458 my $results = $sth->fetchall_arrayref({});
463 #------------------------------------------------------------#
465 =head3 NewBasketgroup
469 $basketgroupid = NewBasketgroup(\%hashref);
473 Adds a basketgroup to the aqbasketgroups table, and add the initial baskets to it.
475 $hashref->{'booksellerid'} is the 'id' field of the bookseller in the aqbooksellers table,
477 $hashref->{'name'} is the 'name' field of the basketgroup in the aqbasketgroups table,
479 $hashref->{'basketlist'} is a list reference of the 'id's of the baskets that belong to this group,
481 $hashref->{'closed'} is the 'closed' field of the aqbasketgroups table, it is false if 0, true otherwise.
490 my $basketgroupinfo = shift;
491 die "booksellerid is required to create a basketgroup" unless $basketgroupinfo->{'booksellerid'};
492 my $query = "INSERT INTO aqbasketgroups (";
494 foreach my $field ('name', 'closed') {
495 if ( $basketgroupinfo->{$field} ) {
496 $query .= "$field, ";
497 push(@params, $basketgroupinfo->{$field});
500 $query .= "booksellerid) VALUES (";
505 push(@params, $basketgroupinfo->{'booksellerid'});
506 my $dbh = C4::Context->dbh;
507 my $sth = $dbh->prepare($query);
508 $sth->execute(@params);
509 my $basketgroupid = $dbh->{'mysql_insertid'};
510 if( $basketgroupinfo->{'basketlist'} ) {
511 foreach my $basketno (@{$basketgroupinfo->{'basketlist'}}) {
512 my $query2 = "UPDATE aqbasket SET basketgroupid=? WHERE basketno=?";
513 my $sth2 = $dbh->prepare($query2);
514 $sth2->execute($basketgroupid, $basketno);
517 return $basketgroupid;
520 #------------------------------------------------------------#
522 =head3 ModBasketgroup
526 ModBasketgroup(\%hashref);
530 Modifies a basketgroup in the aqbasketgroups table, and add the baskets to it.
532 $hashref->{'id'} is the 'id' field of the basketgroup in the aqbasketgroup table, this parameter is mandatory,
534 $hashref->{'name'} is the 'name' field of the basketgroup in the aqbasketgroups table,
536 $hashref->{'basketlist'} is a list reference of the 'id's of the baskets that belong to this group,
538 $hashref->{'closed'} is the 'closed' field of the aqbasketgroups table, it is false if 0, true otherwise.
547 my $basketgroupinfo = shift;
548 die "basketgroup id is required to edit a basketgroup" unless $basketgroupinfo->{'id'};
549 my $dbh = C4::Context->dbh;
550 my $query = "UPDATE aqbasketgroups SET ";
552 foreach my $field (qw(name closed)) {
553 if ( $basketgroupinfo->{$field} ne undef) {
554 $query .= "$field=?, ";
555 push(@params, $basketgroupinfo->{$field});
560 $query .= " WHERE id=?";
561 push(@params, $basketgroupinfo->{'id'});
562 my $sth = $dbh->prepare($query);
563 $sth->execute(@params);
565 $sth = $dbh->prepare('UPDATE aqbasket SET basketgroupid = NULL WHERE basketgroupid = ?');
566 $sth->execute($basketgroupinfo->{'id'});
568 if($basketgroupinfo->{'basketlist'} && @{$basketgroupinfo->{'basketlist'}}){
569 $sth = $dbh->prepare("UPDATE aqbasket SET basketgroupid=? WHERE basketno=?");
570 foreach my $basketno (@{$basketgroupinfo->{'basketlist'}}) {
571 $sth->execute($basketgroupinfo->{'id'}, $basketno);
578 #------------------------------------------------------------#
580 =head3 DelBasketgroup
584 DelBasketgroup($basketgroupid);
588 Deletes a basketgroup in the aqbasketgroups table, and removes the reference to it from the baskets,
590 =item C<$basketgroupid> is the 'id' field of the basket in the aqbasketgroup table
599 my $basketgroupid = shift;
600 die "basketgroup id is required to edit a basketgroup" unless $basketgroupid;
601 my $query = "DELETE FROM aqbasketgroups WHERE id=?";
602 my $dbh = C4::Context->dbh;
603 my $sth = $dbh->prepare($query);
604 $sth->execute($basketgroupid);
608 #------------------------------------------------------------#
612 =head2 FUNCTIONS ABOUT ORDERS
618 =head3 GetBasketgroup
622 $basketgroup = &GetBasketgroup($basketgroupid);
626 Returns a reference to the hash containing all infermation about the basketgroup.
635 my $basketgroupid = shift;
636 die "basketgroup id is required to edit a basketgroup" unless $basketgroupid;
637 my $query = "SELECT * FROM aqbasketgroups WHERE id=?";
638 my $dbh = C4::Context->dbh;
639 my $sth = $dbh->prepare($query);
640 $sth->execute($basketgroupid);
641 my $result = $sth->fetchrow_hashref;
646 #------------------------------------------------------------#
648 =head3 GetBasketgroups
652 $basketgroups = &GetBasketgroups($booksellerid);
656 Returns a reference to the array of all the basketgroups of bookseller $booksellerid.
664 sub GetBasketgroups {
665 my $booksellerid = shift;
666 die "bookseller id is required to edit a basketgroup" unless $booksellerid;
667 my $query = "SELECT * FROM aqbasketgroups WHERE booksellerid=?";
668 my $dbh = C4::Context->dbh;
669 my $sth = $dbh->prepare($query);
670 $sth->execute($booksellerid);
671 my $results = $sth->fetchall_arrayref({});
676 #------------------------------------------------------------#
680 =head2 FUNCTIONS ABOUT ORDERS
686 #------------------------------------------------------------#
688 =head3 GetPendingOrders
692 $orders = &GetPendingOrders($booksellerid, $grouped, $owner);
694 Finds pending orders from the bookseller with the given ID. Ignores
695 completed and cancelled orders.
697 C<$booksellerid> contains the bookseller identifier
698 C<$grouped> contains 0 or 1. 0 means returns the list, 1 means return the total
699 C<$owner> contains 0 or 1. 0 means any owner. 1 means only the list of orders entered by the user itself.
701 C<$orders> is a reference-to-array; each element is a
702 reference-to-hash with the following fields:
703 C<$grouped> is a boolean that, if set to 1 will group all order lines of the same basket
704 in a single result line
708 =item C<authorizedby>
714 These give the value of the corresponding field in the aqorders table
715 of the Koha database.
721 Results are ordered from most to least recent.
725 sub GetPendingOrders {
726 my ($supplierid,$grouped,$owner,$basketno) = @_;
727 my $dbh = C4::Context->dbh;
729 SELECT ".($grouped?"count(*),":"")."aqbasket.basketno,
730 surname,firstname,aqorders.*,biblio.*,biblioitems.isbn,
731 aqbasket.closedate, aqbasket.creationdate, aqbasket.basketname
733 LEFT JOIN aqbasket ON aqbasket.basketno=aqorders.basketno
734 LEFT JOIN borrowers ON aqbasket.authorisedby=borrowers.borrowernumber
735 LEFT JOIN biblio ON biblio.biblionumber=aqorders.biblionumber
736 LEFT JOIN biblioitems ON biblioitems.biblionumber=biblio.biblionumber
738 AND (quantity > quantityreceived OR quantityreceived is NULL)
739 AND datecancellationprinted IS NULL
740 AND (to_days(now())-to_days(closedate) < 180 OR closedate IS NULL)
742 ## FIXME Why 180 days ???
743 my @query_params = ( $supplierid );
744 my $userenv = C4::Context->userenv;
745 if ( C4::Context->preference("IndependantBranches") ) {
746 if ( ($userenv) && ( $userenv->{flags} != 1 ) ) {
747 $strsth .= " and (borrowers.branchcode = ?
748 or borrowers.branchcode = '')";
749 push @query_params, $userenv->{branch};
753 $strsth .= " AND aqbasket.authorisedby=? ";
754 push @query_params, $userenv->{'number'};
757 $strsth .= " AND aqbasket.basketno=? ";
758 push @query_params, $basketno;
760 $strsth .= " group by aqbasket.basketno" if $grouped;
761 $strsth .= " order by aqbasket.basketno";
763 my $sth = $dbh->prepare($strsth);
764 $sth->execute( @query_params );
765 my $results = $sth->fetchall_arrayref({});
770 #------------------------------------------------------------#
776 @orders = &GetOrders($basketnumber, $orderby);
778 Looks up the pending (non-cancelled) orders with the given basket
779 number. If C<$booksellerID> is non-empty, only orders from that seller
783 C<&basket> returns a two-element array. C<@orders> is an array of
784 references-to-hash, whose keys are the fields from the aqorders,
785 biblio, and biblioitems tables in the Koha database.
792 my ( $basketno, $orderby ) = @_;
793 my $dbh = C4::Context->dbh;
795 SELECT biblio.*,biblioitems.*,
800 LEFT JOIN aqbudgets ON aqbudgets.budget_id = aqorders.budget_id
801 LEFT JOIN biblio ON biblio.biblionumber = aqorders.biblionumber
802 LEFT JOIN biblioitems ON biblioitems.biblionumber =biblio.biblionumber
804 AND (datecancellationprinted IS NULL OR datecancellationprinted='0000-00-00')
807 $orderby = "biblioitems.publishercode,biblio.title" unless $orderby;
808 $query .= " ORDER BY $orderby";
809 my $sth = $dbh->prepare($query);
810 $sth->execute($basketno);
811 my $results = $sth->fetchall_arrayref({});
816 #------------------------------------------------------------#
818 =head3 GetOrderNumber
822 $ordernumber = &GetOrderNumber($biblioitemnumber, $biblionumber);
826 Looks up the ordernumber with the given biblionumber and biblioitemnumber.
828 Returns the number of this order.
832 =item C<$ordernumber> is the order number.
838 my ( $biblionumber,$biblioitemnumber ) = @_;
839 my $dbh = C4::Context->dbh;
844 AND biblioitemnumber=?
846 my $sth = $dbh->prepare($query);
847 $sth->execute( $biblionumber, $biblioitemnumber );
849 return $sth->fetchrow;
852 #------------------------------------------------------------#
858 $order = &GetOrder($ordernumber);
860 Looks up an order by order number.
862 Returns a reference-to-hash describing the order. The keys of
863 C<$order> are fields from the biblio, biblioitems, aqorders tables of the Koha database.
871 my $dbh = C4::Context->dbh;
873 SELECT biblioitems.*, biblio.*, aqorders.*
875 LEFT JOIN biblio on biblio.biblionumber=aqorders.biblionumber
876 LEFT JOIN biblioitems on biblioitems.biblionumber=aqorders.biblionumber
877 WHERE aqorders.ordernumber=?
880 my $sth= $dbh->prepare($query);
881 $sth->execute($ordnum);
882 my $data = $sth->fetchrow_hashref;
887 #------------------------------------------------------------#
893 &NewOrder(\%hashref);
895 Adds a new order to the database. Any argument that isn't described
896 below is the new value of the field with the same name in the aqorders
897 table of the Koha database.
901 =item $hashref->{'basketno'} is the basketno foreign key in aqorders, it is mandatory
904 =item $hashref->{'ordnum'} is a "minimum order number."
906 =item $hashref->{'budgetdate'} is effectively ignored.
907 If it's undef (anything false) or the string 'now', the current day is used.
908 Else, the upcoming July 1st is used.
910 =item $hashref->{'subscription'} may be either "yes", or anything else for "no".
912 =item $hashref->{'uncertainprice'} may be 0 for "the price is known" or 1 for "the price is uncertain"
914 =item defaults entrydate to Now
916 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".
925 my $orderinfo = shift;
926 #### ------------------------------
927 my $dbh = C4::Context->dbh;
931 # if these parameters are missing, we can't continue
932 for my $key (qw/basketno quantity biblionumber budget_id/) {
933 die "Mandatory parameter $key missing" unless $orderinfo->{$key};
936 if ( $orderinfo->{'subscription'} eq 'yes' ) {
937 $orderinfo->{'subscription'} = 1;
939 $orderinfo->{'subscription'} = 0;
941 $orderinfo->{'entrydate'} ||= C4::Dates->new()->output("iso");
943 my $ordnum=InsertInTable("aqorders",$orderinfo);
944 return ( $orderinfo->{'basketno'}, $ordnum );
949 #------------------------------------------------------------#
963 #my ($biblioitemnumber,$ordnum, $biblionumber) = @_;
964 my ($itemnumber, $ordernumber) = @_;
965 my $dbh = C4::Context->dbh;
967 INSERT INTO aqorders_items
968 (itemnumber, ordernumber)
971 my $sth = $dbh->prepare($query);
972 $sth->execute( $itemnumber, $ordernumber);
975 #------------------------------------------------------------#
981 &ModOrder(\%hashref);
985 Modifies an existing order. Updates the order with order number
986 $hashref->{'ordernumber'} and biblionumber $hashref->{'biblionumber'}. All other keys of the hash
987 update the fields with the same name in the aqorders table of the Koha database.
996 my $orderinfo = shift;
998 die "Ordernumber is required" if $orderinfo->{'ordernumber'} eq '' ;
999 die "Biblionumber is required" if $orderinfo->{'biblionumber'} eq '';
1001 my $dbh = C4::Context->dbh;
1003 # delete($orderinfo->{'branchcode'});
1004 # the hash contains a lot of entries not in aqorders, so get the columns ...
1005 my $sth = $dbh->prepare("SELECT * FROM aqorders LIMIT 1;");
1007 my $colnames = $sth->{NAME};
1008 my $query = "UPDATE aqorders SET ";
1010 foreach my $orderinfokey (grep(!/ordernumber/, keys %$orderinfo)){
1011 # ... and skip hash entries that are not in the aqorders table
1012 # FIXME : probably not the best way to do it (would be better to have a correct hash)
1013 next unless grep(/^$orderinfokey$/, @$colnames);
1014 $query .= "$orderinfokey=?, ";
1015 push(@params, $orderinfo->{$orderinfokey});
1018 $query .= "timestamp=NOW() WHERE ordernumber=?";
1019 # push(@params, $specorderinfo{'ordernumber'});
1020 push(@params, $orderinfo->{'ordernumber'} );
1021 $sth = $dbh->prepare($query);
1022 $sth->execute(@params);
1026 #------------------------------------------------------------#
1032 &ModOrderItem(\%hashref);
1036 Modifies the itemnumber in the aqorders_items table. The input hash needs three entities:
1037 - itemnumber: the old itemnumber
1038 - ordernumber: the order this item is attached to
1039 - newitemnumber: the new itemnumber we want to attach the line to
1048 my $orderiteminfo = shift;
1049 if (! $orderiteminfo->{'ordernumber'} || ! $orderiteminfo->{'itemnumber'} || ! $orderiteminfo->{'newitemnumber'}){
1050 die "Ordernumber, itemnumber and newitemnumber is required";
1053 my $dbh = C4::Context->dbh;
1055 my $query = "UPDATE aqorders_items set itemnumber=? where itemnumber=? and ordernumber=?";
1056 my @params = ($orderiteminfo->{'newitemnumber'}, $orderiteminfo->{'itemnumber'}, $orderiteminfo->{'ordernumber'});
1058 warn Data::Dumper::Dumper(@params);
1059 my $sth = $dbh->prepare($query);
1060 $sth->execute(@params);
1064 #------------------------------------------------------------#
1067 =head3 ModOrderBibliotemNumber
1071 &ModOrderBiblioitemNumber($biblioitemnumber,$ordnum, $biblionumber);
1073 Modifies the biblioitemnumber for an existing order.
1074 Updates the order with order number C<$ordernum> and biblionumber C<$biblionumber>.
1080 #FIXME: is this used at all?
1081 sub ModOrderBiblioitemNumber {
1082 my ($biblioitemnumber,$ordnum, $biblionumber) = @_;
1083 my $dbh = C4::Context->dbh;
1086 SET biblioitemnumber = ?
1087 WHERE ordernumber = ?
1088 AND biblionumber = ?";
1089 my $sth = $dbh->prepare($query);
1090 $sth->execute( $biblioitemnumber, $ordnum, $biblionumber );
1093 #------------------------------------------------------------#
1095 =head3 ModReceiveOrder
1099 &ModReceiveOrder($biblionumber, $ordernumber, $quantityreceived, $user,
1100 $unitprice, $booksellerinvoicenumber, $biblioitemnumber,
1101 $freight, $bookfund, $rrp);
1103 Updates an order, to reflect the fact that it was received, at least
1104 in part. All arguments not mentioned below update the fields with the
1105 same name in the aqorders table of the Koha database.
1107 If a partial order is received, splits the order into two. The received
1108 portion must have a booksellerinvoicenumber.
1110 Updates the order with bibilionumber C<$biblionumber> and ordernumber
1118 sub ModReceiveOrder {
1120 $biblionumber, $ordnum, $quantrec, $user, $cost,
1121 $invoiceno, $freight, $rrp, $budget_id, $datereceived
1124 my $dbh = C4::Context->dbh;
1125 # warn "DATE BEFORE : $daterecieved";
1126 # $daterecieved=POSIX::strftime("%Y-%m-%d",CORE::localtime) unless $daterecieved;
1127 # warn "DATE REC : $daterecieved";
1128 $datereceived = C4::Dates->output('iso') unless $datereceived;
1129 my $suggestionid = GetSuggestionFromBiblionumber( $dbh, $biblionumber );
1130 if ($suggestionid) {
1131 ModStatus( $suggestionid, 'AVAILABLE', '', $biblionumber );
1134 my $sth=$dbh->prepare("
1135 SELECT * FROM aqorders
1136 WHERE biblionumber=? AND aqorders.ordernumber=?");
1138 $sth->execute($biblionumber,$ordnum);
1139 my $order = $sth->fetchrow_hashref();
1142 if ( $order->{quantity} > $quantrec ) {
1143 $sth=$dbh->prepare("
1145 SET quantityreceived=?
1147 , booksellerinvoicenumber=?
1151 , quantityreceived=?
1152 WHERE biblionumber=? AND ordernumber=?");
1154 $sth->execute($quantrec,$datereceived,$invoiceno,$cost,$freight,$rrp,$quantrec,$biblionumber,$ordnum);
1157 # create a new order for the remaining items, and set its bookfund.
1158 foreach my $orderkey ( "linenumber", "allocation" ) {
1159 delete($order->{'$orderkey'});
1161 my $newOrder = NewOrder($order);
1163 $sth=$dbh->prepare("update aqorders
1164 set quantityreceived=?,datereceived=?,booksellerinvoicenumber=?,
1165 unitprice=?,freight=?,rrp=?
1166 where biblionumber=? and ordernumber=?");
1167 $sth->execute($quantrec,$datereceived,$invoiceno,$cost,$freight,$rrp,$biblionumber,$ordnum);
1170 return $datereceived;
1172 #------------------------------------------------------------#
1176 @results = &SearchOrder($search, $biblionumber, $complete);
1178 Searches for orders.
1180 C<$search> may take one of several forms: if it is an ISBN,
1181 C<&ordersearch> returns orders with that ISBN. If C<$search> is an
1182 order number, C<&ordersearch> returns orders with that order number
1183 and biblionumber C<$biblionumber>. Otherwise, C<$search> is considered
1184 to be a space-separated list of search terms; in this case, all of the
1185 terms must appear in the title (matching the beginning of title
1188 If C<$complete> is C<yes>, the results will include only completed
1189 orders. In any case, C<&ordersearch> ignores cancelled orders.
1191 C<&ordersearch> returns an array.
1192 C<@results> is an array of references-to-hash with the following keys:
1198 =item C<seriestitle>
1209 #### -------- SearchOrder-------------------------------
1210 my ($ordernumber, $search, $supplierid, $basket) = @_;
1212 my $dbh = C4::Context->dbh;
1217 LEFT JOIN biblio ON aqorders.biblionumber=biblio.biblionumber
1218 LEFT JOIN biblioitems ON biblioitems.biblionumber=biblio.biblionumber
1219 LEFT JOIN aqbasket ON aqorders.basketno = aqbasket.basketno
1220 WHERE (datecancellationprinted is NULL)";
1223 $query .= " AND (aqorders.ordernumber=?)";
1224 push @args, $ordernumber;
1227 $query .= " AND (biblio.title like ? OR biblio.author LIKE ? OR biblioitems.isbn like ?)";
1228 push @args, ("%$search%","%$search%","%$search%");
1231 $query .= "AND aqbasket.booksellerid = ?";
1232 push @args, $supplierid;
1235 $query .= "AND aqorders.basketno = ?";
1236 push @args, $basket;
1239 my $sth = $dbh->prepare($query);
1240 $sth->execute(@args);
1241 my $results = $sth->fetchall_arrayref({});
1246 #------------------------------------------------------------#
1252 &DelOrder($biblionumber, $ordernumber);
1254 Cancel the order with the given order and biblio numbers. It does not
1255 delete any entries in the aqorders table, it merely marks them as
1263 my ( $bibnum, $ordnum ) = @_;
1264 my $dbh = C4::Context->dbh;
1267 SET datecancellationprinted=now()
1268 WHERE biblionumber=? AND ordernumber=?
1270 my $sth = $dbh->prepare($query);
1271 $sth->execute( $bibnum, $ordnum );
1275 =head2 FUNCTIONS ABOUT PARCELS
1279 #------------------------------------------------------------#
1285 @results = &GetParcel($booksellerid, $code, $date);
1287 Looks up all of the received items from the supplier with the given
1288 bookseller ID at the given date, for the given code (bookseller Invoice number). Ignores cancelled and completed orders.
1290 C<@results> is an array of references-to-hash. The keys of each element are fields from
1291 the aqorders, biblio, and biblioitems tables of the Koha database.
1293 C<@results> is sorted alphabetically by book title.
1300 #gets all orders from a certain supplier, orders them alphabetically
1301 my ( $supplierid, $code, $datereceived ) = @_;
1302 my $dbh = C4::Context->dbh;
1305 if $code; # add % if we search on a given code (otherwise, let him empty)
1307 SELECT authorisedby,
1312 aqorders.biblionumber,
1313 aqorders.ordernumber,
1315 aqorders.quantityreceived,
1322 LEFT JOIN aqbasket ON aqbasket.basketno=aqorders.basketno
1323 LEFT JOIN borrowers ON aqbasket.authorisedby=borrowers.borrowernumber
1324 LEFT JOIN biblio ON aqorders.biblionumber=biblio.biblionumber
1326 aqbasket.booksellerid = ?
1327 AND aqorders.booksellerinvoicenumber LIKE ?
1328 AND aqorders.datereceived = ? ";
1330 my @query_params = ( $supplierid, $code, $datereceived );
1331 if ( C4::Context->preference("IndependantBranches") ) {
1332 my $userenv = C4::Context->userenv;
1333 if ( ($userenv) && ( $userenv->{flags} != 1 ) ) {
1334 $strsth .= " and (borrowers.branchcode = ?
1335 or borrowers.branchcode = '')";
1336 push @query_params, $userenv->{branch};
1339 $strsth .= " ORDER BY aqbasket.basketno";
1340 # ## parcelinformation : $strsth
1341 my $sth = $dbh->prepare($strsth);
1342 $sth->execute( @query_params );
1343 while ( my $data = $sth->fetchrow_hashref ) {
1344 push( @results, $data );
1346 # ## countparcelbiblio: scalar(@results)
1352 #------------------------------------------------------------#
1358 $results = &GetParcels($bookseller, $order, $code, $datefrom, $dateto);
1359 get a lists of parcels.
1368 is the bookseller this function has to get parcels.
1371 To know on what criteria the results list has to be ordered.
1374 is the booksellerinvoicenumber.
1376 =item $datefrom & $dateto
1377 to know on what date this function has to filter its search.
1380 a pointer on a hash list containing parcel informations as such :
1384 =item Last operation
1386 =item Number of biblio
1388 =item Number of items
1395 my ($bookseller,$order, $code, $datefrom, $dateto) = @_;
1396 my $dbh = C4::Context->dbh;
1397 my @query_params = ();
1399 SELECT aqorders.booksellerinvoicenumber,
1400 datereceived,purchaseordernumber,
1401 count(DISTINCT biblionumber) AS biblio,
1402 sum(quantity) AS itemsexpected,
1403 sum(quantityreceived) AS itemsreceived
1404 FROM aqorders LEFT JOIN aqbasket ON aqbasket.basketno = aqorders.basketno
1405 WHERE aqbasket.booksellerid = $bookseller and datereceived IS NOT NULL
1408 if ( defined $code ) {
1409 $strsth .= ' and aqorders.booksellerinvoicenumber like ? ';
1410 # add a % to the end of the code to allow stemming.
1411 push @query_params, "$code%";
1414 if ( defined $datefrom ) {
1415 $strsth .= ' and datereceived >= ? ';
1416 push @query_params, $datefrom;
1419 if ( defined $dateto ) {
1420 $strsth .= 'and datereceived <= ? ';
1421 push @query_params, $dateto;
1424 $strsth .= "group by aqorders.booksellerinvoicenumber,datereceived ";
1426 # can't use a placeholder to place this column name.
1427 # but, we could probably be checking to make sure it is a column that will be fetched.
1428 $strsth .= "order by $order " if ($order);
1430 my $sth = $dbh->prepare($strsth);
1432 $sth->execute( @query_params );
1433 my $results = $sth->fetchall_arrayref({});
1438 #------------------------------------------------------------#
1440 =head3 GetLateOrders
1444 @results = &GetLateOrders;
1446 Searches for bookseller with late orders.
1449 the table of supplier with late issues. This table is full of hashref.
1457 my $supplierid = shift;
1460 my $dbh = C4::Context->dbh;
1462 #BEWARE, order of parenthesis and LEFT JOIN is important for speed
1463 my $dbdriver = C4::Context->config("db_scheme") || "mysql";
1465 my @query_params = ($delay); # delay is the first argument regardless
1467 SELECT aqbasket.basketno,
1468 aqorders.ordernumber,
1469 DATE(aqbasket.closedate) AS orderdate,
1470 aqorders.rrp AS unitpricesupplier,
1471 aqorders.ecost AS unitpricelib,
1472 aqbudgets.budget_name AS budget,
1473 borrowers.branchcode AS branch,
1474 aqbooksellers.name AS supplier,
1476 biblioitems.publishercode AS publisher,
1477 biblioitems.publicationyear,
1481 (aqorders LEFT JOIN biblio ON biblio.biblionumber = aqorders.biblionumber)
1482 LEFT JOIN biblioitems ON biblioitems.biblionumber = biblio.biblionumber)
1483 LEFT JOIN aqbudgets ON aqorders.budget_id = aqbudgets.budget_id),
1484 (aqbasket LEFT JOIN borrowers ON aqbasket.authorisedby = borrowers.borrowernumber)
1485 LEFT JOIN aqbooksellers ON aqbasket.booksellerid = aqbooksellers.id
1486 WHERE aqorders.basketno = aqbasket.basketno
1487 AND ( (datereceived = '' OR datereceived IS NULL)
1488 OR (aqorders.quantityreceived < aqorders.quantity)
1492 if ($dbdriver eq "mysql") {
1494 aqorders.quantity - IFNULL(aqorders.quantityreceived,0) AS quantity,
1495 (aqorders.quantity - IFNULL(aqorders.quantityreceived,0)) * aqorders.rrp AS subtotal,
1496 DATEDIFF(CURDATE( ),closedate) AS latesince
1498 $from .= " AND (closedate <= DATE_SUB(CURDATE( ),INTERVAL ? DAY)) ";
1500 HAVING quantity <> 0
1501 AND unitpricesupplier <> 0
1502 AND unitpricelib <> 0
1505 # FIXME: account for IFNULL as above
1507 aqorders.quantity AS quantity,
1508 aqorders.quantity * aqorders.rrp AS subtotal,
1509 (CURDATE - closedate) AS latesince
1511 $from .= " AND (closedate <= (CURDATE -(INTERVAL ? DAY)) ";
1513 if (defined $supplierid) {
1514 $from .= ' AND aqbasket.booksellerid = ? ';
1515 push @query_params, $supplierid;
1517 if (defined $branch) {
1518 $from .= ' AND borrowers.branchcode LIKE ? ';
1519 push @query_params, $branch;
1521 if (C4::Context->preference("IndependantBranches")
1522 && C4::Context->userenv
1523 && C4::Context->userenv->{flags} != 1 ) {
1524 $from .= ' AND borrowers.branchcode LIKE ? ';
1525 push @query_params, C4::Context->userenv->{branch};
1527 my $query = "$select $from $having\nORDER BY latesince, basketno, borrowers.branchcode, supplier";
1528 $debug and print STDERR "GetLateOrders query: $query\nGetLateOrders args: " . join(" ",@query_params);
1529 my $sth = $dbh->prepare($query);
1530 $sth->execute(@query_params);
1532 while (my $data = $sth->fetchrow_hashref) {
1533 $data->{orderdate} = format_date($data->{orderdate});
1534 push @results, $data;
1539 #------------------------------------------------------------#
1545 (\@order_loop, $total_qty, $total_price, $total_qtyreceived) = GetHistory( $title, $author, $name, $from_placed_on, $to_placed_on );
1547 Retreives some acquisition history information
1550 $order_loop is a list of hashrefs that each look like this:
1552 'author' => 'Twain, Mark',
1554 'biblionumber' => '215',
1556 'creationdate' => 'MM/DD/YYYY',
1557 'datereceived' => undef,
1560 'invoicenumber' => undef,
1562 'ordernumber' => '1',
1564 'quantityreceived' => undef,
1565 'title' => 'The Adventures of Huckleberry Finn'
1567 $total_qty is the sum of all of the quantities in $order_loop
1568 $total_price is the cost of each in $order_loop times the quantity
1569 $total_qtyreceived is the sum of all of the quantityreceived entries in $order_loop
1576 my ( $title, $author, $name, $from_placed_on, $to_placed_on ) = @_;
1579 my $total_qtyreceived = 0;
1580 my $total_price = 0;
1582 # don't run the query if there are no parameters (list would be too long for sure !)
1583 if ( $title || $author || $name || $from_placed_on || $to_placed_on ) {
1584 my $dbh = C4::Context->dbh;
1590 name,aqbasket.creationdate,
1591 aqorders.datereceived,
1593 aqorders.quantityreceived,
1595 aqorders.ordernumber,
1596 aqorders.booksellerinvoicenumber as invoicenumber,
1597 aqbooksellers.id as id,
1598 aqorders.biblionumber
1600 LEFT JOIN aqbasket ON aqorders.basketno=aqbasket.basketno
1601 LEFT JOIN aqbooksellers ON aqbasket.booksellerid=aqbooksellers.id
1602 LEFT JOIN biblio ON biblio.biblionumber=aqorders.biblionumber";
1604 $query .= " LEFT JOIN borrowers ON aqbasket.authorisedby=borrowers.borrowernumber"
1605 if ( C4::Context->preference("IndependantBranches") );
1607 $query .= " WHERE (datecancellationprinted is NULL or datecancellationprinted='0000-00-00') ";
1609 my @query_params = ();
1611 if ( defined $title ) {
1612 $query .= " AND biblio.title LIKE ? ";
1613 push @query_params, "%$title%";
1616 if ( defined $author ) {
1617 $query .= " AND biblio.author LIKE ? ";
1618 push @query_params, "%$author%";
1621 if ( defined $name ) {
1622 $query .= " AND name LIKE ? ";
1623 push @query_params, "%$name%";
1626 if ( defined $from_placed_on ) {
1627 $query .= " AND creationdate >= ? ";
1628 push @query_params, $from_placed_on;
1631 if ( defined $to_placed_on ) {
1632 $query .= " AND creationdate <= ? ";
1633 push @query_params, $to_placed_on;
1636 if ( C4::Context->preference("IndependantBranches") ) {
1637 my $userenv = C4::Context->userenv;
1638 if ( ($userenv) && ( $userenv->{flags} != 1 ) ) {
1639 $query .= " AND (borrowers.branchcode = ? OR borrowers.branchcode ='' ) ";
1640 push @query_params, $userenv->{branch};
1643 $query .= " ORDER BY booksellerid";
1644 my $sth = $dbh->prepare($query);
1645 $sth->execute( @query_params );
1647 while ( my $line = $sth->fetchrow_hashref ) {
1648 $line->{count} = $cnt++;
1649 $line->{toggle} = 1 if $cnt % 2;
1650 push @order_loop, $line;
1651 $line->{creationdate} = format_date( $line->{creationdate} );
1652 $line->{datereceived} = format_date( $line->{datereceived} );
1653 $total_qty += $line->{'quantity'};
1654 $total_qtyreceived += $line->{'quantityreceived'};
1655 $total_price += $line->{'quantity'} * $line->{'ecost'};
1658 return \@order_loop, $total_qty, $total_price, $total_qtyreceived;
1661 =head2 GetRecentAcqui
1663 $results = GetRecentAcqui($days);
1665 C<$results> is a ref to a table which containts hashref
1669 sub GetRecentAcqui {
1671 my $dbh = C4::Context->dbh;
1675 ORDER BY timestamp DESC
1678 my $sth = $dbh->prepare($query);
1680 my $results = $sth->fetchall_arrayref({});
1688 $contractlist = &GetContracts($booksellerid, $activeonly);
1690 Looks up the contracts that belong to a bookseller
1692 Returns a list of contracts
1694 =item C<$booksellerid> is the "id" field in the "aqbooksellers" table.
1696 =item C<$activeonly> if exists get only contracts that are still active.
1702 my ( $booksellerid, $activeonly ) = @_;
1703 my $dbh = C4::Context->dbh;
1705 if (! $activeonly) {
1709 WHERE booksellerid=?
1714 WHERE booksellerid=?
1715 AND contractenddate >= CURDATE( )";
1717 my $sth = $dbh->prepare($query);
1718 $sth->execute( $booksellerid );
1720 while (my $data = $sth->fetchrow_hashref ) {
1721 push(@results, $data);
1727 #------------------------------------------------------------#
1733 $contract = &GetContract($contractID);
1735 Looks up the contract that has PRIMKEY (contractnumber) value $contractID
1743 my ( $contractno ) = @_;
1744 my $dbh = C4::Context->dbh;
1748 WHERE contractnumber=?
1751 my $sth = $dbh->prepare($query);
1752 $sth->execute( $contractno );
1753 my $result = $sth->fetchrow_hashref;
1762 Koha Developement team <info@koha.org>