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);
36 use vars qw($VERSION @ISA @EXPORT);
39 # set the version for version checking
44 &GetBasket &NewBasket &CloseBasket &DelBasket &ModBasket
46 &GetBasketsByBookseller &GetBasketsByBasketgroup
50 &ModBasketgroup &NewBasketgroup &DelBasketgroup &GetBasketgroup &CloseBasketgroup
51 &GetBasketgroups &ReOpenBasketgroup
53 &NewOrder &DelOrder &ModOrder &GetPendingOrders &GetOrder &GetOrders
54 &GetOrderNumber &GetLateOrders &GetOrderFromItemnumber
55 &SearchOrder &GetHistory &GetRecentAcqui
56 &ModReceiveOrder &ModOrderBiblioitemNumber
58 &NewOrderItem &ModOrderItem
60 &GetParcels &GetParcel
61 &GetContracts &GetContract
63 &GetItemnumbersFromOrder
71 sub GetOrderFromItemnumber {
72 my ($itemnumber) = @_;
73 my $dbh = C4::Context->dbh;
76 SELECT * from aqorders LEFT JOIN aqorders_items
77 ON ( aqorders.ordernumber = aqorders_items.ordernumber )
78 WHERE itemnumber = ? |;
80 my $sth = $dbh->prepare($query);
84 $sth->execute($itemnumber);
86 my $order = $sth->fetchrow_hashref;
91 # Returns the itemnumber(s) associated with the ordernumber given in parameter
92 sub GetItemnumbersFromOrder {
93 my ($ordernumber) = @_;
94 my $dbh = C4::Context->dbh;
95 my $query = "SELECT itemnumber FROM aqorders_items WHERE ordernumber=?";
96 my $sth = $dbh->prepare($query);
97 $sth->execute($ordernumber);
100 while (my $order = $sth->fetchrow_hashref) {
101 push @tab, $order->{'itemnumber'};
115 C4::Acquisition - Koha functions for dealing with orders and acquisitions
123 The functions in this module deal with acquisitions, managing book
124 orders, basket and parcels.
128 =head2 FUNCTIONS ABOUT BASKETS
132 $aqbasket = &GetBasket($basketnumber);
134 get all basket informations in aqbasket for a given basket
136 B<returns:> informations for a given basket returned as a hashref.
142 my $dbh = C4::Context->dbh;
145 concat( b.firstname,' ',b.surname) AS authorisedbyname,
146 b.branchcode AS branch
148 LEFT JOIN borrowers b ON aqbasket.authorisedby=b.borrowernumber
151 my $sth=$dbh->prepare($query);
152 $sth->execute($basketno);
153 my $basket = $sth->fetchrow_hashref;
157 #------------------------------------------------------------#
161 $basket = &NewBasket( $booksellerid, $authorizedby, $basketname,
162 $basketnote, $basketbooksellernote, $basketcontractnumber );
164 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
174 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 #------------------------------------------------------------#
200 &CloseBasket($basketno);
202 close a basket (becomes unmodifiable,except for recieves)
208 my $dbh = C4::Context->dbh;
214 my $sth = $dbh->prepare($query);
215 $sth->execute($basketno);
218 #------------------------------------------------------------#
220 =head3 GetBasketAsCSV
222 &GetBasketAsCSV($basketno);
224 Export a basket as CSV
230 my $basket = GetBasket($basketno);
231 my @orders = GetOrders($basketno);
232 my $contract = GetContract($basket->{'contractnumber'});
233 my $csv = Text::CSV->new();
236 # TODO: Translate headers
237 my @headers = qw(contractname ordernumber entrydate isbn author title publishercode collectiontitle notes quantity rrp);
239 $csv->combine(@headers);
240 $output = $csv->string() . "\n";
243 foreach my $order (@orders) {
245 # newlines are not valid characters for Text::CSV combine()
246 $order->{'notes'} =~ s/[\r\n]+//g;
248 $contract->{'contractname'},
249 $order->{'ordernumber'},
250 $order->{'entrydate'},
254 $order->{'publishercode'},
255 $order->{'collectiontitle'},
257 $order->{'quantity'},
260 push (@rows, \@cols);
263 foreach my $row (@rows) {
264 $csv->combine(@$row);
265 $output .= $csv->string() . "\n";
274 =head3 CloseBasketgroup
276 &CloseBasketgroup($basketgroupno);
282 sub CloseBasketgroup {
283 my ($basketgroupno) = @_;
284 my $dbh = C4::Context->dbh;
285 my $sth = $dbh->prepare("
286 UPDATE aqbasketgroups
290 $sth->execute($basketgroupno);
293 #------------------------------------------------------------#
295 =head3 ReOpenBaskergroup($basketgroupno)
297 &ReOpenBaskergroup($basketgroupno);
303 sub ReOpenBasketgroup {
304 my ($basketgroupno) = @_;
305 my $dbh = C4::Context->dbh;
306 my $sth = $dbh->prepare("
307 UPDATE aqbasketgroups
311 $sth->execute($basketgroupno);
314 #------------------------------------------------------------#
319 &DelBasket($basketno);
321 Deletes the basket that has basketno field $basketno in the aqbasket table.
325 =item C<$basketno> is the primary key of the basket in the aqbasket table.
332 my ( $basketno ) = @_;
333 my $query = "DELETE FROM aqbasket WHERE basketno=?";
334 my $dbh = C4::Context->dbh;
335 my $sth = $dbh->prepare($query);
336 $sth->execute($basketno);
340 #------------------------------------------------------------#
344 &ModBasket($basketinfo);
346 Modifies a basket, using a hashref $basketinfo for the relevant information, only $basketinfo->{'basketno'} is required.
350 =item C<$basketno> is the primary key of the basket in the aqbasket table.
357 my $basketinfo = shift;
358 my $query = "UPDATE aqbasket SET ";
360 foreach my $key (keys %$basketinfo){
361 if ($key ne 'basketno'){
362 $query .= "$key=?, ";
363 push(@params, $basketinfo->{$key} || undef );
366 # get rid of the "," at the end of $query
367 if (substr($query, length($query)-2) eq ', '){
372 $query .= "WHERE basketno=?";
373 push(@params, $basketinfo->{'basketno'});
374 my $dbh = C4::Context->dbh;
375 my $sth = $dbh->prepare($query);
376 $sth->execute(@params);
380 #------------------------------------------------------------#
382 =head3 ModBasketHeader
384 &ModBasketHeader($basketno, $basketname, $note, $booksellernote, $contractnumber);
386 Modifies a basket's header.
390 =item C<$basketno> is the "basketno" field in the "aqbasket" table;
392 =item C<$basketname> is the "basketname" field in the "aqbasket" table;
394 =item C<$note> is the "note" field in the "aqbasket" table;
396 =item C<$booksellernote> is the "booksellernote" field in the "aqbasket" table;
398 =item C<$contractnumber> is the "contractnumber" (foreign) key in the "aqbasket" table.
404 sub ModBasketHeader {
405 my ($basketno, $basketname, $note, $booksellernote, $contractnumber) = @_;
406 my $query = "UPDATE aqbasket SET basketname=?, note=?, booksellernote=? WHERE basketno=?";
407 my $dbh = C4::Context->dbh;
408 my $sth = $dbh->prepare($query);
409 $sth->execute($basketname,$note,$booksellernote,$basketno);
410 if ( $contractnumber ) {
411 my $query2 ="UPDATE aqbasket SET contractnumber=? WHERE basketno=?";
412 my $sth2 = $dbh->prepare($query2);
413 $sth2->execute($contractnumber,$basketno);
419 #------------------------------------------------------------#
421 =head3 GetBasketsByBookseller
423 @results = &GetBasketsByBookseller($booksellerid, $extra);
425 Returns a list of hashes of all the baskets that belong to bookseller 'booksellerid'.
429 =item C<$booksellerid> is the 'id' field of the bookseller in the aqbooksellers table
431 =item C<$extra> is the extra sql parameters, can be
433 $extra->{groupby}: group baskets by column
434 ex. $extra->{groupby} = aqbasket.basketgroupid
435 $extra->{orderby}: order baskets by column
436 $extra->{limit}: limit number of results (can be helpful for pagination)
442 sub GetBasketsByBookseller {
443 my ($booksellerid, $extra) = @_;
444 my $query = "SELECT * FROM aqbasket WHERE booksellerid=?";
446 if ($extra->{groupby}) {
447 $query .= " GROUP by $extra->{groupby}";
449 if ($extra->{orderby}){
450 $query .= " ORDER by $extra->{orderby}";
452 if ($extra->{limit}){
453 $query .= " LIMIT $extra->{limit}";
456 my $dbh = C4::Context->dbh;
457 my $sth = $dbh->prepare($query);
458 $sth->execute($booksellerid);
459 my $results = $sth->fetchall_arrayref({});
464 #------------------------------------------------------------#
466 =head3 GetBasketsByBasketgroup
468 $baskets = &GetBasketsByBasketgroup($basketgroupid);
470 Returns a reference to all baskets that belong to basketgroup $basketgroupid.
474 sub GetBasketsByBasketgroup {
475 my $basketgroupid = shift;
476 my $query = "SELECT * FROM aqbasket
477 LEFT JOIN aqcontract USING(contractnumber) WHERE basketgroupid=?";
478 my $dbh = C4::Context->dbh;
479 my $sth = $dbh->prepare($query);
480 $sth->execute($basketgroupid);
481 my $results = $sth->fetchall_arrayref({});
486 #------------------------------------------------------------#
488 =head3 NewBasketgroup
490 $basketgroupid = NewBasketgroup(\%hashref);
492 Adds a basketgroup to the aqbasketgroups table, and add the initial baskets to it.
494 $hashref->{'booksellerid'} is the 'id' field of the bookseller in the aqbooksellers table,
496 $hashref->{'name'} is the 'name' field of the basketgroup in the aqbasketgroups table,
498 $hashref->{'basketlist'} is a list reference of the 'id's of the baskets that belong to this group,
500 $hashref->{'deliveryplace'} is the 'deliveryplace' field of the basketgroup in the aqbasketgroups table,
502 $hashref->{'deliverycomment'} is the 'deliverycomment' field of the basketgroup in the aqbasketgroups table,
504 $hashref->{'closed'} is the 'closed' field of the aqbasketgroups table, it is false if 0, true otherwise.
509 my $basketgroupinfo = shift;
510 die "booksellerid is required to create a basketgroup" unless $basketgroupinfo->{'booksellerid'};
511 my $query = "INSERT INTO aqbasketgroups (";
513 foreach my $field ('name', 'deliveryplace', 'deliverycomment', 'closed') {
514 if ( $basketgroupinfo->{$field} ) {
515 $query .= "$field, ";
516 push(@params, $basketgroupinfo->{$field});
519 $query .= "booksellerid) VALUES (";
524 push(@params, $basketgroupinfo->{'booksellerid'});
525 my $dbh = C4::Context->dbh;
526 my $sth = $dbh->prepare($query);
527 $sth->execute(@params);
528 my $basketgroupid = $dbh->{'mysql_insertid'};
529 if( $basketgroupinfo->{'basketlist'} ) {
530 foreach my $basketno (@{$basketgroupinfo->{'basketlist'}}) {
531 my $query2 = "UPDATE aqbasket SET basketgroupid=? WHERE basketno=?";
532 my $sth2 = $dbh->prepare($query2);
533 $sth2->execute($basketgroupid, $basketno);
536 return $basketgroupid;
539 #------------------------------------------------------------#
541 =head3 ModBasketgroup
543 ModBasketgroup(\%hashref);
545 Modifies a basketgroup in the aqbasketgroups table, and add the baskets to it.
547 $hashref->{'id'} is the 'id' field of the basketgroup in the aqbasketgroup table, this parameter is mandatory,
549 $hashref->{'name'} is the 'name' field of the basketgroup in the aqbasketgroups table,
551 $hashref->{'basketlist'} is a list reference of the 'id's of the baskets that belong to this group,
553 $hashref->{'billingplace'} is the 'billingplace' field of the basketgroup in the aqbasketgroups table,
555 $hashref->{'deliveryplace'} is the 'deliveryplace' field of the basketgroup in the aqbasketgroups table,
557 $hashref->{'deliverycomment'} is the 'deliverycomment' field of the basketgroup in the aqbasketgroups table,
559 $hashref->{'closed'} is the 'closed' field of the aqbasketgroups table, it is false if 0, true otherwise.
564 my $basketgroupinfo = shift;
565 die "basketgroup id is required to edit a basketgroup" unless $basketgroupinfo->{'id'};
566 my $dbh = C4::Context->dbh;
567 my $query = "UPDATE aqbasketgroups SET ";
569 foreach my $field (qw(name billingplace deliveryplace freedeliveryplace deliverycomment closed)) {
570 if ( defined $basketgroupinfo->{$field} ) {
571 $query .= "$field=?, ";
572 push(@params, $basketgroupinfo->{$field});
577 $query .= " WHERE id=?";
578 push(@params, $basketgroupinfo->{'id'});
579 my $sth = $dbh->prepare($query);
580 $sth->execute(@params);
582 $sth = $dbh->prepare('UPDATE aqbasket SET basketgroupid = NULL WHERE basketgroupid = ?');
583 $sth->execute($basketgroupinfo->{'id'});
585 if($basketgroupinfo->{'basketlist'} && @{$basketgroupinfo->{'basketlist'}}){
586 $sth = $dbh->prepare("UPDATE aqbasket SET basketgroupid=? WHERE basketno=?");
587 foreach my $basketno (@{$basketgroupinfo->{'basketlist'}}) {
588 $sth->execute($basketgroupinfo->{'id'}, $basketno);
595 #------------------------------------------------------------#
597 =head3 DelBasketgroup
599 DelBasketgroup($basketgroupid);
601 Deletes a basketgroup in the aqbasketgroups table, and removes the reference to it from the baskets,
605 =item C<$basketgroupid> is the 'id' field of the basket in the aqbasketgroup table
612 my $basketgroupid = shift;
613 die "basketgroup id is required to edit a basketgroup" unless $basketgroupid;
614 my $query = "DELETE FROM aqbasketgroups WHERE id=?";
615 my $dbh = C4::Context->dbh;
616 my $sth = $dbh->prepare($query);
617 $sth->execute($basketgroupid);
621 #------------------------------------------------------------#
624 =head2 FUNCTIONS ABOUT ORDERS
626 =head3 GetBasketgroup
628 $basketgroup = &GetBasketgroup($basketgroupid);
630 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
650 $basketgroups = &GetBasketgroups($booksellerid);
652 Returns a reference to the array of all the basketgroups of bookseller $booksellerid.
656 sub GetBasketgroups {
657 my $booksellerid = shift;
658 die "bookseller id is required to edit a basketgroup" unless $booksellerid;
659 my $query = "SELECT * FROM aqbasketgroups WHERE booksellerid=? ORDER BY `id` DESC";
660 my $dbh = C4::Context->dbh;
661 my $sth = $dbh->prepare($query);
662 $sth->execute($booksellerid);
663 my $results = $sth->fetchall_arrayref({});
668 #------------------------------------------------------------#
670 =head2 FUNCTIONS ABOUT ORDERS
674 #------------------------------------------------------------#
676 =head3 GetPendingOrders
678 $orders = &GetPendingOrders($booksellerid, $grouped, $owner);
680 Finds pending orders from the bookseller with the given ID. Ignores
681 completed and cancelled orders.
683 C<$booksellerid> contains the bookseller identifier
684 C<$grouped> contains 0 or 1. 0 means returns the list, 1 means return the total
685 C<$owner> contains 0 or 1. 0 means any owner. 1 means only the list of orders entered by the user itself.
687 C<$orders> is a reference-to-array; each element is a
688 reference-to-hash with the following fields:
689 C<$grouped> is a boolean that, if set to 1 will group all order lines of the same basket
690 in a single result line
694 =item C<authorizedby>
702 These give the value of the corresponding field in the aqorders table
703 of the Koha database.
705 Results are ordered from most to least recent.
709 sub GetPendingOrders {
710 my ($supplierid,$grouped,$owner,$basketno) = @_;
711 my $dbh = C4::Context->dbh;
713 SELECT ".($grouped?"count(*),":"")."aqbasket.basketno,
714 surname,firstname,aqorders.*,biblio.*,biblioitems.isbn,
715 aqbasket.closedate, aqbasket.creationdate, aqbasket.basketname
717 LEFT JOIN aqbasket ON aqbasket.basketno=aqorders.basketno
718 LEFT JOIN borrowers ON aqbasket.authorisedby=borrowers.borrowernumber
719 LEFT JOIN biblio ON biblio.biblionumber=aqorders.biblionumber
720 LEFT JOIN biblioitems ON biblioitems.biblionumber=biblio.biblionumber
722 AND (quantity > quantityreceived OR quantityreceived is NULL)
723 AND datecancellationprinted IS NULL
724 AND (to_days(now())-to_days(closedate) < 180 OR closedate IS NULL)
726 ## FIXME Why 180 days ???
727 my @query_params = ( $supplierid );
728 my $userenv = C4::Context->userenv;
729 if ( C4::Context->preference("IndependantBranches") ) {
730 if ( ($userenv) && ( $userenv->{flags} != 1 ) ) {
731 $strsth .= " and (borrowers.branchcode = ?
732 or borrowers.branchcode = '')";
733 push @query_params, $userenv->{branch};
737 $strsth .= " AND aqbasket.authorisedby=? ";
738 push @query_params, $userenv->{'number'};
741 $strsth .= " AND aqbasket.basketno=? ";
742 push @query_params, $basketno;
744 $strsth .= " group by aqbasket.basketno" if $grouped;
745 $strsth .= " order by aqbasket.basketno";
747 my $sth = $dbh->prepare($strsth);
748 $sth->execute( @query_params );
749 my $results = $sth->fetchall_arrayref({});
754 #------------------------------------------------------------#
758 @orders = &GetOrders($basketnumber, $orderby);
760 Looks up the pending (non-cancelled) orders with the given basket
761 number. If C<$booksellerID> is non-empty, only orders from that seller
765 C<&basket> returns a two-element array. C<@orders> is an array of
766 references-to-hash, whose keys are the fields from the aqorders,
767 biblio, and biblioitems tables in the Koha database.
772 my ( $basketno, $orderby ) = @_;
773 my $dbh = C4::Context->dbh;
775 SELECT biblio.*,biblioitems.*,
780 LEFT JOIN aqbudgets ON aqbudgets.budget_id = aqorders.budget_id
781 LEFT JOIN biblio ON biblio.biblionumber = aqorders.biblionumber
782 LEFT JOIN biblioitems ON biblioitems.biblionumber =biblio.biblionumber
784 AND (datecancellationprinted IS NULL OR datecancellationprinted='0000-00-00')
787 $orderby = "biblioitems.publishercode,biblio.title" unless $orderby;
788 $query .= " ORDER BY $orderby";
789 my $sth = $dbh->prepare($query);
790 $sth->execute($basketno);
791 my $results = $sth->fetchall_arrayref({});
796 #------------------------------------------------------------#
798 =head3 GetOrderNumber
800 $ordernumber = &GetOrderNumber($biblioitemnumber, $biblionumber);
802 Looks up the ordernumber with the given biblionumber and biblioitemnumber.
804 Returns the number of this order.
808 =item C<$ordernumber> is the order number.
815 my ( $biblionumber,$biblioitemnumber ) = @_;
816 my $dbh = C4::Context->dbh;
821 AND biblioitemnumber=?
823 my $sth = $dbh->prepare($query);
824 $sth->execute( $biblionumber, $biblioitemnumber );
826 return $sth->fetchrow;
829 #------------------------------------------------------------#
833 $order = &GetOrder($ordernumber);
835 Looks up an order by order number.
837 Returns a reference-to-hash describing the order. The keys of
838 C<$order> are fields from the biblio, biblioitems, aqorders tables of the Koha database.
843 my ($ordernumber) = @_;
844 my $dbh = C4::Context->dbh;
846 SELECT biblioitems.*, biblio.*, aqorders.*
848 LEFT JOIN biblio on biblio.biblionumber=aqorders.biblionumber
849 LEFT JOIN biblioitems on biblioitems.biblionumber=aqorders.biblionumber
850 WHERE aqorders.ordernumber=?
853 my $sth= $dbh->prepare($query);
854 $sth->execute($ordernumber);
855 my $data = $sth->fetchrow_hashref;
860 #------------------------------------------------------------#
864 &NewOrder(\%hashref);
866 Adds a new order to the database. Any argument that isn't described
867 below is the new value of the field with the same name in the aqorders
868 table of the Koha database.
872 =item $hashref->{'basketno'} is the basketno foreign key in aqorders, it is mandatory
874 =item $hashref->{'ordernumber'} is a "minimum order number."
876 =item $hashref->{'budgetdate'} is effectively ignored.
877 If it's undef (anything false) or the string 'now', the current day is used.
878 Else, the upcoming July 1st is used.
880 =item $hashref->{'subscription'} may be either "yes", or anything else for "no".
882 =item $hashref->{'uncertainprice'} may be 0 for "the price is known" or 1 for "the price is uncertain"
884 =item defaults entrydate to Now
886 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".
893 my $orderinfo = shift;
894 #### ------------------------------
895 my $dbh = C4::Context->dbh;
899 # if these parameters are missing, we can't continue
900 for my $key (qw/basketno quantity biblionumber budget_id/) {
901 croak "Mandatory parameter $key missing" unless $orderinfo->{$key};
904 if ( defined $orderinfo->{subscription} && $orderinfo->{'subscription'} eq 'yes' ) {
905 $orderinfo->{'subscription'} = 1;
907 $orderinfo->{'subscription'} = 0;
909 $orderinfo->{'entrydate'} ||= C4::Dates->new()->output("iso");
910 if (!$orderinfo->{quantityreceived}) {
911 $orderinfo->{quantityreceived} = 0;
914 my $ordernumber=InsertInTable("aqorders",$orderinfo);
915 return ( $orderinfo->{'basketno'}, $ordernumber );
920 #------------------------------------------------------------#
929 #my ($biblioitemnumber,$ordernumber, $biblionumber) = @_;
930 my ($itemnumber, $ordernumber) = @_;
931 my $dbh = C4::Context->dbh;
933 INSERT INTO aqorders_items
934 (itemnumber, ordernumber)
937 my $sth = $dbh->prepare($query);
938 $sth->execute( $itemnumber, $ordernumber);
941 #------------------------------------------------------------#
945 &ModOrder(\%hashref);
947 Modifies an existing order. Updates the order with order number
948 $hashref->{'ordernumber'} and biblionumber $hashref->{'biblionumber'}. All
949 other keys of the hash update the fields with the same name in the aqorders
950 table of the Koha database.
955 my $orderinfo = shift;
957 die "Ordernumber is required" if $orderinfo->{'ordernumber'} eq '' ;
958 die "Biblionumber is required" if $orderinfo->{'biblionumber'} eq '';
960 my $dbh = C4::Context->dbh;
963 # update uncertainprice to an integer, just in case (under FF, checked boxes have the value "ON" by default)
964 $orderinfo->{uncertainprice}=1 if $orderinfo->{uncertainprice};
966 # delete($orderinfo->{'branchcode'});
967 # the hash contains a lot of entries not in aqorders, so get the columns ...
968 my $sth = $dbh->prepare("SELECT * FROM aqorders LIMIT 1;");
970 my $colnames = $sth->{NAME};
971 my $query = "UPDATE aqorders SET ";
973 foreach my $orderinfokey (grep(!/ordernumber/, keys %$orderinfo)){
974 # ... and skip hash entries that are not in the aqorders table
975 # FIXME : probably not the best way to do it (would be better to have a correct hash)
976 next unless grep(/^$orderinfokey$/, @$colnames);
977 $query .= "$orderinfokey=?, ";
978 push(@params, $orderinfo->{$orderinfokey});
981 $query .= "timestamp=NOW() WHERE ordernumber=?";
982 # push(@params, $specorderinfo{'ordernumber'});
983 push(@params, $orderinfo->{'ordernumber'} );
984 $sth = $dbh->prepare($query);
985 $sth->execute(@params);
989 #------------------------------------------------------------#
993 &ModOrderItem(\%hashref);
995 Modifies the itemnumber in the aqorders_items table. The input hash needs three entities:
999 =item - itemnumber: the old itemnumber
1000 =item - ordernumber: the order this item is attached to
1001 =item - newitemnumber: the new itemnumber we want to attach the line to
1008 my $orderiteminfo = shift;
1009 if (! $orderiteminfo->{'ordernumber'} || ! $orderiteminfo->{'itemnumber'} || ! $orderiteminfo->{'newitemnumber'}){
1010 die "Ordernumber, itemnumber and newitemnumber is required";
1013 my $dbh = C4::Context->dbh;
1015 my $query = "UPDATE aqorders_items set itemnumber=? where itemnumber=? and ordernumber=?";
1016 my @params = ($orderiteminfo->{'newitemnumber'}, $orderiteminfo->{'itemnumber'}, $orderiteminfo->{'ordernumber'});
1017 my $sth = $dbh->prepare($query);
1018 $sth->execute(@params);
1022 #------------------------------------------------------------#
1025 =head3 ModOrderBibliotemNumber
1027 &ModOrderBiblioitemNumber($biblioitemnumber,$ordernumber, $biblionumber);
1029 Modifies the biblioitemnumber for an existing order.
1030 Updates the order with order number C<$ordernum> and biblionumber C<$biblionumber>.
1034 #FIXME: is this used at all?
1035 sub ModOrderBiblioitemNumber {
1036 my ($biblioitemnumber,$ordernumber, $biblionumber) = @_;
1037 my $dbh = C4::Context->dbh;
1040 SET biblioitemnumber = ?
1041 WHERE ordernumber = ?
1042 AND biblionumber = ?";
1043 my $sth = $dbh->prepare($query);
1044 $sth->execute( $biblioitemnumber, $ordernumber, $biblionumber );
1047 #------------------------------------------------------------#
1049 =head3 ModReceiveOrder
1051 &ModReceiveOrder($biblionumber, $ordernumber, $quantityreceived, $user,
1052 $unitprice, $booksellerinvoicenumber, $biblioitemnumber,
1053 $freight, $bookfund, $rrp);
1055 Updates an order, to reflect the fact that it was received, at least
1056 in part. All arguments not mentioned below update the fields with the
1057 same name in the aqorders table of the Koha database.
1059 If a partial order is received, splits the order into two. The received
1060 portion must have a booksellerinvoicenumber.
1062 Updates the order with bibilionumber C<$biblionumber> and ordernumber
1068 sub ModReceiveOrder {
1070 $biblionumber, $ordernumber, $quantrec, $user, $cost,
1071 $invoiceno, $freight, $rrp, $budget_id, $datereceived
1074 my $dbh = C4::Context->dbh;
1075 # warn "DATE BEFORE : $daterecieved";
1076 # $daterecieved=POSIX::strftime("%Y-%m-%d",CORE::localtime) unless $daterecieved;
1077 # warn "DATE REC : $daterecieved";
1078 $datereceived = C4::Dates->output('iso') unless $datereceived;
1079 my $suggestionid = GetSuggestionFromBiblionumber( $dbh, $biblionumber );
1080 if ($suggestionid) {
1081 ModSuggestion( {suggestionid=>$suggestionid,
1082 STATUS=>'AVAILABLE',
1083 biblionumber=> $biblionumber}
1087 my $sth=$dbh->prepare("
1088 SELECT * FROM aqorders
1089 WHERE biblionumber=? AND aqorders.ordernumber=?");
1091 $sth->execute($biblionumber,$ordernumber);
1092 my $order = $sth->fetchrow_hashref();
1095 if ( $order->{quantity} > $quantrec ) {
1096 $sth=$dbh->prepare("
1098 SET quantityreceived=?
1100 , booksellerinvoicenumber=?
1105 WHERE biblionumber=? AND ordernumber=?");
1107 $sth->execute($quantrec,$datereceived,$invoiceno,$cost,$freight,$rrp,$quantrec,$biblionumber,$ordernumber);
1110 # create a new order for the remaining items, and set its bookfund.
1111 foreach my $orderkey ( "linenumber", "allocation" ) {
1112 delete($order->{'$orderkey'});
1114 $order->{'quantity'} -= $quantrec;
1115 $order->{'quantityreceived'} = 0;
1116 my $newOrder = NewOrder($order);
1118 $sth=$dbh->prepare("update aqorders
1119 set quantityreceived=?,datereceived=?,booksellerinvoicenumber=?,
1120 unitprice=?,freight=?,rrp=?
1121 where biblionumber=? and ordernumber=?");
1122 $sth->execute($quantrec,$datereceived,$invoiceno,$cost,$freight,$rrp,$biblionumber,$ordernumber);
1125 return $datereceived;
1127 #------------------------------------------------------------#
1131 @results = &SearchOrder($search, $biblionumber, $complete);
1133 Searches for orders.
1135 C<$search> may take one of several forms: if it is an ISBN,
1136 C<&ordersearch> returns orders with that ISBN. If C<$search> is an
1137 order number, C<&ordersearch> returns orders with that order number
1138 and biblionumber C<$biblionumber>. Otherwise, C<$search> is considered
1139 to be a space-separated list of search terms; in this case, all of the
1140 terms must appear in the title (matching the beginning of title
1143 If C<$complete> is C<yes>, the results will include only completed
1144 orders. In any case, C<&ordersearch> ignores cancelled orders.
1146 C<&ordersearch> returns an array.
1147 C<@results> is an array of references-to-hash with the following keys:
1153 =item C<seriestitle>
1164 #### -------- SearchOrder-------------------------------
1165 my ($ordernumber, $search, $supplierid, $basket) = @_;
1167 my $dbh = C4::Context->dbh;
1172 LEFT JOIN biblio ON aqorders.biblionumber=biblio.biblionumber
1173 LEFT JOIN biblioitems ON biblioitems.biblionumber=biblio.biblionumber
1174 LEFT JOIN aqbasket ON aqorders.basketno = aqbasket.basketno
1175 WHERE (datecancellationprinted is NULL)";
1178 $query .= " AND (aqorders.ordernumber=?)";
1179 push @args, $ordernumber;
1182 $query .= " AND (biblio.title like ? OR biblio.author LIKE ? OR biblioitems.isbn like ?)";
1183 push @args, ("%$search%","%$search%","%$search%");
1186 $query .= "AND aqbasket.booksellerid = ?";
1187 push @args, $supplierid;
1190 $query .= "AND aqorders.basketno = ?";
1191 push @args, $basket;
1194 my $sth = $dbh->prepare($query);
1195 $sth->execute(@args);
1196 my $results = $sth->fetchall_arrayref({});
1201 #------------------------------------------------------------#
1205 &DelOrder($biblionumber, $ordernumber);
1207 Cancel the order with the given order and biblio numbers. It does not
1208 delete any entries in the aqorders table, it merely marks them as
1214 my ( $bibnum, $ordernumber ) = @_;
1215 my $dbh = C4::Context->dbh;
1218 SET datecancellationprinted=now()
1219 WHERE biblionumber=? AND ordernumber=?
1221 my $sth = $dbh->prepare($query);
1222 $sth->execute( $bibnum, $ordernumber );
1224 my @itemnumbers = GetItemnumbersFromOrder( $ordernumber );
1225 foreach my $itemnumber (@itemnumbers){
1226 C4::Items::DelItem( $dbh, $bibnum, $itemnumber );
1231 =head2 FUNCTIONS ABOUT PARCELS
1235 #------------------------------------------------------------#
1239 @results = &GetParcel($booksellerid, $code, $date);
1241 Looks up all of the received items from the supplier with the given
1242 bookseller ID at the given date, for the given code (bookseller Invoice number). Ignores cancelled and completed orders.
1244 C<@results> is an array of references-to-hash. The keys of each element are fields from
1245 the aqorders, biblio, and biblioitems tables of the Koha database.
1247 C<@results> is sorted alphabetically by book title.
1252 #gets all orders from a certain supplier, orders them alphabetically
1253 my ( $supplierid, $code, $datereceived ) = @_;
1254 my $dbh = C4::Context->dbh;
1257 if $code; # add % if we search on a given code (otherwise, let him empty)
1259 SELECT authorisedby,
1264 aqorders.biblionumber,
1265 aqorders.ordernumber,
1267 aqorders.quantityreceived,
1274 LEFT JOIN aqbasket ON aqbasket.basketno=aqorders.basketno
1275 LEFT JOIN borrowers ON aqbasket.authorisedby=borrowers.borrowernumber
1276 LEFT JOIN biblio ON aqorders.biblionumber=biblio.biblionumber
1278 aqbasket.booksellerid = ?
1279 AND aqorders.booksellerinvoicenumber LIKE ?
1280 AND aqorders.datereceived = ? ";
1282 my @query_params = ( $supplierid, $code, $datereceived );
1283 if ( C4::Context->preference("IndependantBranches") ) {
1284 my $userenv = C4::Context->userenv;
1285 if ( ($userenv) && ( $userenv->{flags} != 1 ) ) {
1286 $strsth .= " and (borrowers.branchcode = ?
1287 or borrowers.branchcode = '')";
1288 push @query_params, $userenv->{branch};
1291 $strsth .= " ORDER BY aqbasket.basketno";
1292 # ## parcelinformation : $strsth
1293 my $sth = $dbh->prepare($strsth);
1294 $sth->execute( @query_params );
1295 while ( my $data = $sth->fetchrow_hashref ) {
1296 push( @results, $data );
1298 # ## countparcelbiblio: scalar(@results)
1304 #------------------------------------------------------------#
1308 $results = &GetParcels($bookseller, $order, $code, $datefrom, $dateto);
1310 get a lists of parcels.
1317 is the bookseller this function has to get parcels.
1320 To know on what criteria the results list has to be ordered.
1323 is the booksellerinvoicenumber.
1325 =item $datefrom & $dateto
1326 to know on what date this function has to filter its search.
1331 a pointer on a hash list containing parcel informations as such :
1337 =item Last operation
1339 =item Number of biblio
1341 =item Number of items
1348 my ($bookseller,$order, $code, $datefrom, $dateto) = @_;
1349 my $dbh = C4::Context->dbh;
1350 my @query_params = ();
1352 SELECT aqorders.booksellerinvoicenumber,
1353 datereceived,purchaseordernumber,
1354 count(DISTINCT biblionumber) AS biblio,
1355 sum(quantity) AS itemsexpected,
1356 sum(quantityreceived) AS itemsreceived
1357 FROM aqorders LEFT JOIN aqbasket ON aqbasket.basketno = aqorders.basketno
1358 WHERE aqbasket.booksellerid = ? and datereceived IS NOT NULL
1360 push @query_params, $bookseller;
1362 if ( defined $code ) {
1363 $strsth .= ' and aqorders.booksellerinvoicenumber like ? ';
1364 # add a % to the end of the code to allow stemming.
1365 push @query_params, "$code%";
1368 if ( defined $datefrom ) {
1369 $strsth .= ' and datereceived >= ? ';
1370 push @query_params, $datefrom;
1373 if ( defined $dateto ) {
1374 $strsth .= 'and datereceived <= ? ';
1375 push @query_params, $dateto;
1378 $strsth .= "group by aqorders.booksellerinvoicenumber,datereceived ";
1380 # can't use a placeholder to place this column name.
1381 # but, we could probably be checking to make sure it is a column that will be fetched.
1382 $strsth .= "order by $order " if ($order);
1384 my $sth = $dbh->prepare($strsth);
1386 $sth->execute( @query_params );
1387 my $results = $sth->fetchall_arrayref({});
1392 #------------------------------------------------------------#
1394 =head3 GetLateOrders
1396 @results = &GetLateOrders;
1398 Searches for bookseller with late orders.
1401 the table of supplier with late issues. This table is full of hashref.
1407 my $supplierid = shift;
1410 my $dbh = C4::Context->dbh;
1412 #BEWARE, order of parenthesis and LEFT JOIN is important for speed
1413 my $dbdriver = C4::Context->config("db_scheme") || "mysql";
1415 my @query_params = ($delay); # delay is the first argument regardless
1417 SELECT aqbasket.basketno,
1418 aqorders.ordernumber,
1419 DATE(aqbasket.closedate) AS orderdate,
1420 aqorders.rrp AS unitpricesupplier,
1421 aqorders.ecost AS unitpricelib,
1422 aqbudgets.budget_name AS budget,
1423 borrowers.branchcode AS branch,
1424 aqbooksellers.name AS supplier,
1425 biblio.author, biblio.title,
1426 biblioitems.publishercode AS publisher,
1427 biblioitems.publicationyear,
1431 aqorders LEFT JOIN biblio ON biblio.biblionumber = aqorders.biblionumber
1432 LEFT JOIN biblioitems ON biblioitems.biblionumber = biblio.biblionumber
1433 LEFT JOIN aqbudgets ON aqorders.budget_id = aqbudgets.budget_id,
1434 aqbasket LEFT JOIN borrowers ON aqbasket.authorisedby = borrowers.borrowernumber
1435 LEFT JOIN aqbooksellers ON aqbasket.booksellerid = aqbooksellers.id
1436 WHERE aqorders.basketno = aqbasket.basketno
1437 AND ( datereceived = ''
1438 OR datereceived IS NULL
1439 OR aqorders.quantityreceived < aqorders.quantity
1441 AND (aqorders.datecancellationprinted IS NULL OR aqorders.datecancellationprinted='0000-00-00')
1444 if ($dbdriver eq "mysql") {
1446 aqorders.quantity - IFNULL(aqorders.quantityreceived,0) AS quantity,
1447 (aqorders.quantity - IFNULL(aqorders.quantityreceived,0)) * aqorders.rrp AS subtotal,
1448 DATEDIFF(CURDATE( ),closedate) AS latesince
1450 $from .= " AND (closedate <= DATE_SUB(CURDATE( ),INTERVAL ? DAY)) ";
1452 HAVING quantity <> 0
1453 AND unitpricesupplier <> 0
1454 AND unitpricelib <> 0
1457 # FIXME: account for IFNULL as above
1459 aqorders.quantity AS quantity,
1460 aqorders.quantity * aqorders.rrp AS subtotal,
1461 (CURDATE - closedate) AS latesince
1463 $from .= " AND (closedate <= (CURDATE -(INTERVAL ? DAY)) ";
1465 if (defined $supplierid) {
1466 $from .= ' AND aqbasket.booksellerid = ? ';
1467 push @query_params, $supplierid;
1469 if (defined $branch) {
1470 $from .= ' AND borrowers.branchcode LIKE ? ';
1471 push @query_params, $branch;
1473 if (C4::Context->preference("IndependantBranches")
1474 && C4::Context->userenv
1475 && C4::Context->userenv->{flags} != 1 ) {
1476 $from .= ' AND borrowers.branchcode LIKE ? ';
1477 push @query_params, C4::Context->userenv->{branch};
1479 my $query = "$select $from $having\nORDER BY latesince, basketno, borrowers.branchcode, supplier";
1480 $debug and print STDERR "GetLateOrders query: $query\nGetLateOrders args: " . join(" ",@query_params);
1481 my $sth = $dbh->prepare($query);
1482 $sth->execute(@query_params);
1484 while (my $data = $sth->fetchrow_hashref) {
1485 $data->{orderdate} = format_date($data->{orderdate});
1486 push @results, $data;
1491 #------------------------------------------------------------#
1495 (\@order_loop, $total_qty, $total_price, $total_qtyreceived) = GetHistory( %params );
1497 Retreives some acquisition history information
1505 basket - search both basket name and number
1506 booksellerinvoicenumber
1509 $order_loop is a list of hashrefs that each look like this:
1511 'author' => 'Twain, Mark',
1513 'biblionumber' => '215',
1515 'creationdate' => 'MM/DD/YYYY',
1516 'datereceived' => undef,
1519 'invoicenumber' => undef,
1521 'ordernumber' => '1',
1523 'quantityreceived' => undef,
1524 'title' => 'The Adventures of Huckleberry Finn'
1526 $total_qty is the sum of all of the quantities in $order_loop
1527 $total_price is the cost of each in $order_loop times the quantity
1528 $total_qtyreceived is the sum of all of the quantityreceived entries in $order_loop
1533 # don't run the query if there are no parameters (list would be too long for sure !)
1534 croak "No search params" unless @_;
1536 my $title = $params{title};
1537 my $author = $params{author};
1538 my $isbn = $params{isbn};
1539 my $name = $params{name};
1540 my $from_placed_on = $params{from_placed_on};
1541 my $to_placed_on = $params{to_placed_on};
1542 my $basket = $params{basket};
1543 my $booksellerinvoicenumber = $params{booksellerinvoicenumber};
1547 my $total_qtyreceived = 0;
1548 my $total_price = 0;
1550 my $dbh = C4::Context->dbh;
1557 aqbasket.basketname,
1558 aqbasket.basketgroupid,
1559 aqbasketgroups.name as groupname,
1561 aqbasket.creationdate,
1562 aqorders.datereceived,
1564 aqorders.quantityreceived,
1566 aqorders.ordernumber,
1567 aqorders.booksellerinvoicenumber as invoicenumber,
1568 aqbooksellers.id as id,
1569 aqorders.biblionumber
1571 LEFT JOIN aqbasket ON aqorders.basketno=aqbasket.basketno
1572 LEFT JOIN aqbasketgroups ON aqbasket.basketgroupid=aqbasketgroups.id
1573 LEFT JOIN aqbooksellers ON aqbasket.booksellerid=aqbooksellers.id
1574 LEFT JOIN biblioitems ON biblioitems.biblionumber=aqorders.biblionumber
1575 LEFT JOIN biblio ON biblio.biblionumber=aqorders.biblionumber";
1577 $query .= " LEFT JOIN borrowers ON aqbasket.authorisedby=borrowers.borrowernumber"
1578 if ( C4::Context->preference("IndependantBranches") );
1580 $query .= " WHERE (datecancellationprinted is NULL or datecancellationprinted='0000-00-00') ";
1582 my @query_params = ();
1585 $query .= " AND biblio.title LIKE ? ";
1586 $title =~ s/\s+/%/g;
1587 push @query_params, "%$title%";
1591 $query .= " AND biblio.author LIKE ? ";
1592 push @query_params, "%$author%";
1596 $query .= " AND biblioitems.isbn LIKE ? ";
1597 push @query_params, "%$isbn%";
1601 $query .= " AND aqbooksellers.name LIKE ? ";
1602 push @query_params, "%$name%";
1605 if ( $from_placed_on ) {
1606 $query .= " AND creationdate >= ? ";
1607 push @query_params, $from_placed_on;
1610 if ( $to_placed_on ) {
1611 $query .= " AND creationdate <= ? ";
1612 push @query_params, $to_placed_on;
1616 if ($basket =~ m/^\d+$/) {
1617 $query .= " AND aqorders.basketno = ? ";
1618 push @query_params, $basket;
1620 $query .= " AND aqbasket.basketname LIKE ? ";
1621 push @query_params, "%$basket%";
1625 if ($booksellerinvoicenumber) {
1626 $query .= " AND (aqorders.booksellerinvoicenumber LIKE ? OR aqbasket.booksellerinvoicenumber LIKE ?)";
1627 push @query_params, "%$booksellerinvoicenumber%", "%$booksellerinvoicenumber%";
1630 if ( C4::Context->preference("IndependantBranches") ) {
1631 my $userenv = C4::Context->userenv;
1632 if ( $userenv && ($userenv->{flags} || 0) != 1 ) {
1633 $query .= " AND (borrowers.branchcode = ? OR borrowers.branchcode ='' ) ";
1634 push @query_params, $userenv->{branch};
1637 $query .= " ORDER BY id";
1638 my $sth = $dbh->prepare($query);
1639 $sth->execute( @query_params );
1641 while ( my $line = $sth->fetchrow_hashref ) {
1642 $line->{count} = $cnt++;
1643 $line->{toggle} = 1 if $cnt % 2;
1644 push @order_loop, $line;
1645 $line->{creationdate} = format_date( $line->{creationdate} );
1646 $line->{datereceived} = format_date( $line->{datereceived} );
1647 $total_qty += $line->{'quantity'};
1648 $total_qtyreceived += $line->{'quantityreceived'};
1649 $total_price += $line->{'quantity'} * $line->{'ecost'};
1651 return \@order_loop, $total_qty, $total_price, $total_qtyreceived;
1654 =head2 GetRecentAcqui
1656 $results = GetRecentAcqui($days);
1658 C<$results> is a ref to a table which containts hashref
1662 sub GetRecentAcqui {
1664 my $dbh = C4::Context->dbh;
1668 ORDER BY timestamp DESC
1671 my $sth = $dbh->prepare($query);
1673 my $results = $sth->fetchall_arrayref({});
1679 $contractlist = &GetContracts($booksellerid, $activeonly);
1681 Looks up the contracts that belong to a bookseller
1683 Returns a list of contracts
1687 =item C<$booksellerid> is the "id" field in the "aqbooksellers" table.
1689 =item C<$activeonly> if exists get only contracts that are still active.
1696 my ( $booksellerid, $activeonly ) = @_;
1697 my $dbh = C4::Context->dbh;
1699 if (! $activeonly) {
1703 WHERE booksellerid=?
1708 WHERE booksellerid=?
1709 AND contractenddate >= CURDATE( )";
1711 my $sth = $dbh->prepare($query);
1712 $sth->execute( $booksellerid );
1714 while (my $data = $sth->fetchrow_hashref ) {
1715 push(@results, $data);
1721 #------------------------------------------------------------#
1725 $contract = &GetContract($contractID);
1727 Looks up the contract that has PRIMKEY (contractnumber) value $contractID
1734 my ( $contractno ) = @_;
1735 my $dbh = C4::Context->dbh;
1739 WHERE contractnumber=?
1742 my $sth = $dbh->prepare($query);
1743 $sth->execute( $contractno );
1744 my $result = $sth->fetchrow_hashref;
1753 Koha Development Team <http://koha-community.org/>