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.
25 use C4::Dates qw(format_date format_date_in_iso);
30 use C4::SQLHelper qw(InsertInTable);
35 use vars qw($VERSION @ISA @EXPORT);
38 # set the version for version checking
43 &GetBasket &NewBasket &CloseBasket &DelBasket &ModBasket
45 &GetBasketsByBookseller &GetBasketsByBasketgroup
49 &ModBasketgroup &NewBasketgroup &DelBasketgroup &GetBasketgroup &CloseBasketgroup
50 &GetBasketgroups &ReOpenBasketgroup
52 &NewOrder &DelOrder &ModOrder &GetPendingOrders &GetOrder &GetOrders
53 &GetOrderNumber &GetLateOrders &GetOrderFromItemnumber
54 &SearchOrder &GetHistory &GetRecentAcqui
55 &ModReceiveOrder &ModOrderBiblioitemNumber
57 &NewOrderItem &ModOrderItem
59 &GetParcels &GetParcel
60 &GetContracts &GetContract
62 &GetItemnumbersFromOrder
70 sub GetOrderFromItemnumber {
71 my ($itemnumber) = @_;
72 my $dbh = C4::Context->dbh;
75 SELECT * from aqorders LEFT JOIN aqorders_items
76 ON ( aqorders.ordernumber = aqorders_items.ordernumber )
77 WHERE itemnumber = ? |;
79 my $sth = $dbh->prepare($query);
83 $sth->execute($itemnumber);
85 my $order = $sth->fetchrow_hashref;
90 # Returns the itemnumber(s) associated with the ordernumber given in parameter
91 sub GetItemnumbersFromOrder {
92 my ($ordernumber) = @_;
93 my $dbh = C4::Context->dbh;
94 my $query = "SELECT itemnumber FROM aqorders_items WHERE ordernumber=?";
95 my $sth = $dbh->prepare($query);
96 $sth->execute($ordernumber);
99 while (my $order = $sth->fetchrow_hashref) {
100 push @tab, $order->{'itemnumber'};
114 C4::Acquisition - Koha functions for dealing with orders and acquisitions
122 The functions in this module deal with acquisitions, managing book
123 orders, basket and parcels.
127 =head2 FUNCTIONS ABOUT BASKETS
131 $aqbasket = &GetBasket($basketnumber);
133 get all basket informations in aqbasket for a given basket
135 B<returns:> 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 #------------------------------------------------------------#
160 $basket = &NewBasket( $booksellerid, $authorizedby, $basketname,
161 $basketnote, $basketbooksellernote, $basketcontractnumber );
163 Create a new basket in aqbasket table
167 =item C<$booksellerid> is a foreign key in the aqbasket table
169 =item C<$authorizedby> is the username of who created the basket
173 The other parameters are optional, see ModBasketHeader for more info on them.
177 # FIXME : this function seems to be unused.
180 my ( $booksellerid, $authorisedby, $basketname, $basketnote, $basketbooksellernote, $basketcontractnumber ) = @_;
181 my $dbh = C4::Context->dbh;
184 (creationdate,booksellerid,authorisedby)
185 VALUES (now(),'$booksellerid','$authorisedby')
189 #find & return basketno MYSQL dependant, but $dbh->last_insert_id always returns null :-(
190 my $basket = $dbh->{'mysql_insertid'};
191 ModBasketHeader($basket, $basketname || '', $basketnote || '', $basketbooksellernote || '', $basketcontractnumber || undef);
195 #------------------------------------------------------------#
199 &CloseBasket($basketno);
201 close a basket (becomes unmodifiable,except for recieves)
207 my $dbh = C4::Context->dbh;
213 my $sth = $dbh->prepare($query);
214 $sth->execute($basketno);
217 #------------------------------------------------------------#
219 =head3 GetBasketAsCSV
221 &GetBasketAsCSV($basketno);
223 Export a basket as CSV
229 my $basket = GetBasket($basketno);
230 my @orders = GetOrders($basketno);
231 my $contract = GetContract($basket->{'contractnumber'});
232 my $csv = Text::CSV->new();
235 # TODO: Translate headers
236 my @headers = qw(contractname ordernumber entrydate isbn author title publishercode collectiontitle notes quantity rrp);
238 $csv->combine(@headers);
239 $output = $csv->string() . "\n";
242 foreach my $order (@orders) {
244 # newlines are not valid characters for Text::CSV combine()
245 $order->{'notes'} =~ s/[\r\n]+//g;
247 $contract->{'contractname'},
248 $order->{'ordernumber'},
249 $order->{'entrydate'},
253 $order->{'publishercode'},
254 $order->{'collectiontitle'},
256 $order->{'quantity'},
259 push (@rows, \@cols);
262 foreach my $row (@rows) {
263 $csv->combine(@$row);
264 $output .= $csv->string() . "\n";
273 =head3 CloseBasketgroup
275 &CloseBasketgroup($basketgroupno);
281 sub CloseBasketgroup {
282 my ($basketgroupno) = @_;
283 my $dbh = C4::Context->dbh;
284 my $sth = $dbh->prepare("
285 UPDATE aqbasketgroups
289 $sth->execute($basketgroupno);
292 #------------------------------------------------------------#
294 =head3 ReOpenBaskergroup($basketgroupno)
296 &ReOpenBaskergroup($basketgroupno);
302 sub ReOpenBasketgroup {
303 my ($basketgroupno) = @_;
304 my $dbh = C4::Context->dbh;
305 my $sth = $dbh->prepare("
306 UPDATE aqbasketgroups
310 $sth->execute($basketgroupno);
313 #------------------------------------------------------------#
318 &DelBasket($basketno);
320 Deletes the basket that has basketno field $basketno in the aqbasket table.
324 =item C<$basketno> is the primary key of the basket in the aqbasket table.
331 my ( $basketno ) = @_;
332 my $query = "DELETE FROM aqbasket WHERE basketno=?";
333 my $dbh = C4::Context->dbh;
334 my $sth = $dbh->prepare($query);
335 $sth->execute($basketno);
339 #------------------------------------------------------------#
343 &ModBasket($basketinfo);
345 Modifies a basket, using a hashref $basketinfo for the relevant information, only $basketinfo->{'basketno'} is required.
349 =item C<$basketno> is the primary key of the basket in the aqbasket table.
356 my $basketinfo = shift;
357 my $query = "UPDATE aqbasket SET ";
359 foreach my $key (keys %$basketinfo){
360 if ($key ne 'basketno'){
361 $query .= "$key=?, ";
362 push(@params, $basketinfo->{$key} || undef );
365 # get rid of the "," at the end of $query
366 if (substr($query, length($query)-2) eq ', '){
371 $query .= "WHERE basketno=?";
372 push(@params, $basketinfo->{'basketno'});
373 my $dbh = C4::Context->dbh;
374 my $sth = $dbh->prepare($query);
375 $sth->execute(@params);
379 #------------------------------------------------------------#
381 =head3 ModBasketHeader
383 &ModBasketHeader($basketno, $basketname, $note, $booksellernote, $contractnumber);
385 Modifies a basket's header.
389 =item C<$basketno> is the "basketno" field in the "aqbasket" table;
391 =item C<$basketname> is the "basketname" field in the "aqbasket" table;
393 =item C<$note> is the "note" field in the "aqbasket" table;
395 =item C<$booksellernote> is the "booksellernote" field in the "aqbasket" table;
397 =item C<$contractnumber> is the "contractnumber" (foreign) key in the "aqbasket" table.
403 sub ModBasketHeader {
404 my ($basketno, $basketname, $note, $booksellernote, $contractnumber) = @_;
405 my $query = "UPDATE aqbasket SET basketname=?, note=?, booksellernote=? WHERE basketno=?";
406 my $dbh = C4::Context->dbh;
407 my $sth = $dbh->prepare($query);
408 $sth->execute($basketname,$note,$booksellernote,$basketno);
409 if ( $contractnumber ) {
410 my $query2 ="UPDATE aqbasket SET contractnumber=? WHERE basketno=?";
411 my $sth2 = $dbh->prepare($query2);
412 $sth2->execute($contractnumber,$basketno);
418 #------------------------------------------------------------#
420 =head3 GetBasketsByBookseller
422 @results = &GetBasketsByBookseller($booksellerid, $extra);
424 Returns a list of hashes of all the baskets that belong to bookseller 'booksellerid'.
428 =item C<$booksellerid> is the 'id' field of the bookseller in the aqbooksellers table
430 =item C<$extra> is the extra sql parameters, can be
432 $extra->{groupby}: group baskets by column
433 ex. $extra->{groupby} = aqbasket.basketgroupid
434 $extra->{orderby}: order baskets by column
435 $extra->{limit}: limit number of results (can be helpful for pagination)
441 sub GetBasketsByBookseller {
442 my ($booksellerid, $extra) = @_;
443 my $query = "SELECT * FROM aqbasket WHERE booksellerid=?";
445 if ($extra->{groupby}) {
446 $query .= " GROUP by $extra->{groupby}";
448 if ($extra->{orderby}){
449 $query .= " ORDER by $extra->{orderby}";
451 if ($extra->{limit}){
452 $query .= " LIMIT $extra->{limit}";
455 my $dbh = C4::Context->dbh;
456 my $sth = $dbh->prepare($query);
457 $sth->execute($booksellerid);
458 my $results = $sth->fetchall_arrayref({});
463 #------------------------------------------------------------#
465 =head3 GetBasketsByBasketgroup
467 $baskets = &GetBasketsByBasketgroup($basketgroupid);
469 Returns a reference to all baskets that belong to basketgroup $basketgroupid.
473 sub GetBasketsByBasketgroup {
474 my $basketgroupid = shift;
475 my $query = "SELECT * FROM aqbasket
476 LEFT JOIN aqcontract USING(contractnumber) WHERE basketgroupid=?";
477 my $dbh = C4::Context->dbh;
478 my $sth = $dbh->prepare($query);
479 $sth->execute($basketgroupid);
480 my $results = $sth->fetchall_arrayref({});
485 #------------------------------------------------------------#
487 =head3 NewBasketgroup
489 $basketgroupid = NewBasketgroup(\%hashref);
491 Adds a basketgroup to the aqbasketgroups table, and add the initial baskets to it.
493 $hashref->{'booksellerid'} is the 'id' field of the bookseller in the aqbooksellers table,
495 $hashref->{'name'} is the 'name' field of the basketgroup in the aqbasketgroups table,
497 $hashref->{'basketlist'} is a list reference of the 'id's of the baskets that belong to this group,
499 $hashref->{'deliveryplace'} is the 'deliveryplace' field of the basketgroup in the aqbasketgroups table,
501 $hashref->{'deliverycomment'} is the 'deliverycomment' field of the basketgroup in the aqbasketgroups table,
503 $hashref->{'closed'} is the 'closed' field of the aqbasketgroups table, it is false if 0, true otherwise.
508 my $basketgroupinfo = shift;
509 die "booksellerid is required to create a basketgroup" unless $basketgroupinfo->{'booksellerid'};
510 my $query = "INSERT INTO aqbasketgroups (";
512 foreach my $field ('name', 'deliveryplace', 'deliverycomment', 'closed') {
513 if ( $basketgroupinfo->{$field} ) {
514 $query .= "$field, ";
515 push(@params, $basketgroupinfo->{$field});
518 $query .= "booksellerid) VALUES (";
523 push(@params, $basketgroupinfo->{'booksellerid'});
524 my $dbh = C4::Context->dbh;
525 my $sth = $dbh->prepare($query);
526 $sth->execute(@params);
527 my $basketgroupid = $dbh->{'mysql_insertid'};
528 if( $basketgroupinfo->{'basketlist'} ) {
529 foreach my $basketno (@{$basketgroupinfo->{'basketlist'}}) {
530 my $query2 = "UPDATE aqbasket SET basketgroupid=? WHERE basketno=?";
531 my $sth2 = $dbh->prepare($query2);
532 $sth2->execute($basketgroupid, $basketno);
535 return $basketgroupid;
538 #------------------------------------------------------------#
540 =head3 ModBasketgroup
542 ModBasketgroup(\%hashref);
544 Modifies a basketgroup in the aqbasketgroups table, and add the baskets to it.
546 $hashref->{'id'} is the 'id' field of the basketgroup in the aqbasketgroup table, this parameter is mandatory,
548 $hashref->{'name'} is the 'name' field of the basketgroup in the aqbasketgroups table,
550 $hashref->{'basketlist'} is a list reference of the 'id's of the baskets that belong to this group,
552 $hashref->{'billingplace'} is the 'billingplace' field of the basketgroup in the aqbasketgroups table,
554 $hashref->{'deliveryplace'} is the 'deliveryplace' field of the basketgroup in the aqbasketgroups table,
556 $hashref->{'deliverycomment'} is the 'deliverycomment' field of the basketgroup in the aqbasketgroups table,
558 $hashref->{'closed'} is the 'closed' field of the aqbasketgroups table, it is false if 0, true otherwise.
563 my $basketgroupinfo = shift;
564 die "basketgroup id is required to edit a basketgroup" unless $basketgroupinfo->{'id'};
565 my $dbh = C4::Context->dbh;
566 my $query = "UPDATE aqbasketgroups SET ";
568 foreach my $field (qw(name billingplace deliveryplace freedeliveryplace deliverycomment closed)) {
569 if ( defined $basketgroupinfo->{$field} ) {
570 $query .= "$field=?, ";
571 push(@params, $basketgroupinfo->{$field});
576 $query .= " WHERE id=?";
577 push(@params, $basketgroupinfo->{'id'});
578 my $sth = $dbh->prepare($query);
579 $sth->execute(@params);
581 $sth = $dbh->prepare('UPDATE aqbasket SET basketgroupid = NULL WHERE basketgroupid = ?');
582 $sth->execute($basketgroupinfo->{'id'});
584 if($basketgroupinfo->{'basketlist'} && @{$basketgroupinfo->{'basketlist'}}){
585 $sth = $dbh->prepare("UPDATE aqbasket SET basketgroupid=? WHERE basketno=?");
586 foreach my $basketno (@{$basketgroupinfo->{'basketlist'}}) {
587 $sth->execute($basketgroupinfo->{'id'}, $basketno);
594 #------------------------------------------------------------#
596 =head3 DelBasketgroup
598 DelBasketgroup($basketgroupid);
600 Deletes a basketgroup in the aqbasketgroups table, and removes the reference to it from the baskets,
604 =item C<$basketgroupid> is the 'id' field of the basket in the aqbasketgroup table
611 my $basketgroupid = shift;
612 die "basketgroup id is required to edit a basketgroup" unless $basketgroupid;
613 my $query = "DELETE FROM aqbasketgroups WHERE id=?";
614 my $dbh = C4::Context->dbh;
615 my $sth = $dbh->prepare($query);
616 $sth->execute($basketgroupid);
620 #------------------------------------------------------------#
623 =head2 FUNCTIONS ABOUT ORDERS
625 =head3 GetBasketgroup
627 $basketgroup = &GetBasketgroup($basketgroupid);
629 Returns a reference to the hash containing all infermation about the basketgroup.
634 my $basketgroupid = shift;
635 die "basketgroup id is required to edit a basketgroup" unless $basketgroupid;
636 my $query = "SELECT * FROM aqbasketgroups WHERE id=?";
637 my $dbh = C4::Context->dbh;
638 my $sth = $dbh->prepare($query);
639 $sth->execute($basketgroupid);
640 my $result = $sth->fetchrow_hashref;
645 #------------------------------------------------------------#
647 =head3 GetBasketgroups
649 $basketgroups = &GetBasketgroups($booksellerid);
651 Returns a reference to the array of all the basketgroups of bookseller $booksellerid.
655 sub GetBasketgroups {
656 my $booksellerid = shift;
657 die "bookseller id is required to edit a basketgroup" unless $booksellerid;
658 my $query = "SELECT * FROM aqbasketgroups WHERE booksellerid=? ORDER BY `id` DESC";
659 my $dbh = C4::Context->dbh;
660 my $sth = $dbh->prepare($query);
661 $sth->execute($booksellerid);
662 my $results = $sth->fetchall_arrayref({});
667 #------------------------------------------------------------#
669 =head2 FUNCTIONS ABOUT ORDERS
673 #------------------------------------------------------------#
675 =head3 GetPendingOrders
677 $orders = &GetPendingOrders($booksellerid, $grouped, $owner);
679 Finds pending orders from the bookseller with the given ID. Ignores
680 completed and cancelled orders.
682 C<$booksellerid> contains the bookseller identifier
683 C<$grouped> contains 0 or 1. 0 means returns the list, 1 means return the total
684 C<$owner> contains 0 or 1. 0 means any owner. 1 means only the list of orders entered by the user itself.
686 C<$orders> is a reference-to-array; each element is a
687 reference-to-hash with the following fields:
688 C<$grouped> is a boolean that, if set to 1 will group all order lines of the same basket
689 in a single result line
693 =item C<authorizedby>
701 These give the value of the corresponding field in the aqorders table
702 of the Koha database.
704 Results are ordered from most to least recent.
708 sub GetPendingOrders {
709 my ($supplierid,$grouped,$owner,$basketno) = @_;
710 my $dbh = C4::Context->dbh;
712 SELECT ".($grouped?"count(*),":"")."aqbasket.basketno,
713 surname,firstname,aqorders.*,biblio.*,biblioitems.isbn,
714 aqbasket.closedate, aqbasket.creationdate, aqbasket.basketname
716 LEFT JOIN aqbasket ON aqbasket.basketno=aqorders.basketno
717 LEFT JOIN borrowers ON aqbasket.authorisedby=borrowers.borrowernumber
718 LEFT JOIN biblio ON biblio.biblionumber=aqorders.biblionumber
719 LEFT JOIN biblioitems ON biblioitems.biblionumber=biblio.biblionumber
721 AND (quantity > quantityreceived OR quantityreceived is NULL)
722 AND datecancellationprinted IS NULL
723 AND (to_days(now())-to_days(closedate) < 180 OR closedate IS NULL)
725 ## FIXME Why 180 days ???
726 my @query_params = ( $supplierid );
727 my $userenv = C4::Context->userenv;
728 if ( C4::Context->preference("IndependantBranches") ) {
729 if ( ($userenv) && ( $userenv->{flags} != 1 ) ) {
730 $strsth .= " and (borrowers.branchcode = ?
731 or borrowers.branchcode = '')";
732 push @query_params, $userenv->{branch};
736 $strsth .= " AND aqbasket.authorisedby=? ";
737 push @query_params, $userenv->{'number'};
740 $strsth .= " AND aqbasket.basketno=? ";
741 push @query_params, $basketno;
743 $strsth .= " group by aqbasket.basketno" if $grouped;
744 $strsth .= " order by aqbasket.basketno";
746 my $sth = $dbh->prepare($strsth);
747 $sth->execute( @query_params );
748 my $results = $sth->fetchall_arrayref({});
753 #------------------------------------------------------------#
757 @orders = &GetOrders($basketnumber, $orderby);
759 Looks up the pending (non-cancelled) orders with the given basket
760 number. If C<$booksellerID> is non-empty, only orders from that seller
764 C<&basket> returns a two-element array. C<@orders> is an array of
765 references-to-hash, whose keys are the fields from the aqorders,
766 biblio, and biblioitems tables in the Koha database.
771 my ( $basketno, $orderby ) = @_;
772 my $dbh = C4::Context->dbh;
774 SELECT biblio.*,biblioitems.*,
779 LEFT JOIN aqbudgets ON aqbudgets.budget_id = aqorders.budget_id
780 LEFT JOIN biblio ON biblio.biblionumber = aqorders.biblionumber
781 LEFT JOIN biblioitems ON biblioitems.biblionumber =biblio.biblionumber
783 AND (datecancellationprinted IS NULL OR datecancellationprinted='0000-00-00')
786 $orderby = "biblioitems.publishercode,biblio.title" unless $orderby;
787 $query .= " ORDER BY $orderby";
788 my $sth = $dbh->prepare($query);
789 $sth->execute($basketno);
790 my $results = $sth->fetchall_arrayref({});
795 #------------------------------------------------------------#
797 =head3 GetOrderNumber
799 $ordernumber = &GetOrderNumber($biblioitemnumber, $biblionumber);
801 Looks up the ordernumber with the given biblionumber and biblioitemnumber.
803 Returns the number of this order.
807 =item C<$ordernumber> is the order number.
814 my ( $biblionumber,$biblioitemnumber ) = @_;
815 my $dbh = C4::Context->dbh;
820 AND biblioitemnumber=?
822 my $sth = $dbh->prepare($query);
823 $sth->execute( $biblionumber, $biblioitemnumber );
825 return $sth->fetchrow;
828 #------------------------------------------------------------#
832 $order = &GetOrder($ordernumber);
834 Looks up an order by order number.
836 Returns a reference-to-hash describing the order. The keys of
837 C<$order> are fields from the biblio, biblioitems, aqorders tables of the Koha database.
842 my ($ordernumber) = @_;
843 my $dbh = C4::Context->dbh;
845 SELECT biblioitems.*, biblio.*, aqorders.*
847 LEFT JOIN biblio on biblio.biblionumber=aqorders.biblionumber
848 LEFT JOIN biblioitems on biblioitems.biblionumber=aqorders.biblionumber
849 WHERE aqorders.ordernumber=?
852 my $sth= $dbh->prepare($query);
853 $sth->execute($ordernumber);
854 my $data = $sth->fetchrow_hashref;
859 #------------------------------------------------------------#
863 &NewOrder(\%hashref);
865 Adds a new order to the database. Any argument that isn't described
866 below is the new value of the field with the same name in the aqorders
867 table of the Koha database.
871 =item $hashref->{'basketno'} is the basketno foreign key in aqorders, it is mandatory
873 =item $hashref->{'ordernumber'} is a "minimum order number."
875 =item $hashref->{'budgetdate'} is effectively ignored.
876 If it's undef (anything false) or the string 'now', the current day is used.
877 Else, the upcoming July 1st is used.
879 =item $hashref->{'subscription'} may be either "yes", or anything else for "no".
881 =item $hashref->{'uncertainprice'} may be 0 for "the price is known" or 1 for "the price is uncertain"
883 =item defaults entrydate to Now
885 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".
892 my $orderinfo = shift;
893 #### ------------------------------
894 my $dbh = C4::Context->dbh;
898 # if these parameters are missing, we can't continue
899 for my $key (qw/basketno quantity biblionumber budget_id/) {
900 die "Mandatory parameter $key missing" unless $orderinfo->{$key};
903 if ( defined $orderinfo->{subscription} && $orderinfo->{'subscription'} eq 'yes' ) {
904 $orderinfo->{'subscription'} = 1;
906 $orderinfo->{'subscription'} = 0;
908 $orderinfo->{'entrydate'} ||= C4::Dates->new()->output("iso");
909 if (!$orderinfo->{quantityreceived}) {
910 $orderinfo->{quantityreceived} = 0;
913 my $ordernumber=InsertInTable("aqorders",$orderinfo);
914 return ( $orderinfo->{'basketno'}, $ordernumber );
919 #------------------------------------------------------------#
928 #my ($biblioitemnumber,$ordernumber, $biblionumber) = @_;
929 my ($itemnumber, $ordernumber) = @_;
930 my $dbh = C4::Context->dbh;
932 INSERT INTO aqorders_items
933 (itemnumber, ordernumber)
936 my $sth = $dbh->prepare($query);
937 $sth->execute( $itemnumber, $ordernumber);
940 #------------------------------------------------------------#
944 &ModOrder(\%hashref);
946 Modifies an existing order. Updates the order with order number
947 $hashref->{'ordernumber'} and biblionumber $hashref->{'biblionumber'}. All
948 other keys of the hash update the fields with the same name in the aqorders
949 table of the Koha database.
954 my $orderinfo = shift;
956 die "Ordernumber is required" if $orderinfo->{'ordernumber'} eq '' ;
957 die "Biblionumber is required" if $orderinfo->{'biblionumber'} eq '';
959 my $dbh = C4::Context->dbh;
962 # update uncertainprice to an integer, just in case (under FF, checked boxes have the value "ON" by default)
963 $orderinfo->{uncertainprice}=1 if $orderinfo->{uncertainprice};
965 # delete($orderinfo->{'branchcode'});
966 # the hash contains a lot of entries not in aqorders, so get the columns ...
967 my $sth = $dbh->prepare("SELECT * FROM aqorders LIMIT 1;");
969 my $colnames = $sth->{NAME};
970 my $query = "UPDATE aqorders SET ";
972 foreach my $orderinfokey (grep(!/ordernumber/, keys %$orderinfo)){
973 # ... and skip hash entries that are not in the aqorders table
974 # FIXME : probably not the best way to do it (would be better to have a correct hash)
975 next unless grep(/^$orderinfokey$/, @$colnames);
976 $query .= "$orderinfokey=?, ";
977 push(@params, $orderinfo->{$orderinfokey});
980 $query .= "timestamp=NOW() WHERE ordernumber=?";
981 # push(@params, $specorderinfo{'ordernumber'});
982 push(@params, $orderinfo->{'ordernumber'} );
983 $sth = $dbh->prepare($query);
984 $sth->execute(@params);
988 #------------------------------------------------------------#
992 &ModOrderItem(\%hashref);
994 Modifies the itemnumber in the aqorders_items table. The input hash needs three entities:
998 =item - itemnumber: the old itemnumber
999 =item - ordernumber: the order this item is attached to
1000 =item - newitemnumber: the new itemnumber we want to attach the line to
1007 my $orderiteminfo = shift;
1008 if (! $orderiteminfo->{'ordernumber'} || ! $orderiteminfo->{'itemnumber'} || ! $orderiteminfo->{'newitemnumber'}){
1009 die "Ordernumber, itemnumber and newitemnumber is required";
1012 my $dbh = C4::Context->dbh;
1014 my $query = "UPDATE aqorders_items set itemnumber=? where itemnumber=? and ordernumber=?";
1015 my @params = ($orderiteminfo->{'newitemnumber'}, $orderiteminfo->{'itemnumber'}, $orderiteminfo->{'ordernumber'});
1016 my $sth = $dbh->prepare($query);
1017 $sth->execute(@params);
1021 #------------------------------------------------------------#
1024 =head3 ModOrderBibliotemNumber
1026 &ModOrderBiblioitemNumber($biblioitemnumber,$ordernumber, $biblionumber);
1028 Modifies the biblioitemnumber for an existing order.
1029 Updates the order with order number C<$ordernum> and biblionumber C<$biblionumber>.
1033 #FIXME: is this used at all?
1034 sub ModOrderBiblioitemNumber {
1035 my ($biblioitemnumber,$ordernumber, $biblionumber) = @_;
1036 my $dbh = C4::Context->dbh;
1039 SET biblioitemnumber = ?
1040 WHERE ordernumber = ?
1041 AND biblionumber = ?";
1042 my $sth = $dbh->prepare($query);
1043 $sth->execute( $biblioitemnumber, $ordernumber, $biblionumber );
1046 #------------------------------------------------------------#
1048 =head3 ModReceiveOrder
1050 &ModReceiveOrder($biblionumber, $ordernumber, $quantityreceived, $user,
1051 $unitprice, $booksellerinvoicenumber, $biblioitemnumber,
1052 $freight, $bookfund, $rrp);
1054 Updates an order, to reflect the fact that it was received, at least
1055 in part. All arguments not mentioned below update the fields with the
1056 same name in the aqorders table of the Koha database.
1058 If a partial order is received, splits the order into two. The received
1059 portion must have a booksellerinvoicenumber.
1061 Updates the order with bibilionumber C<$biblionumber> and ordernumber
1067 sub ModReceiveOrder {
1069 $biblionumber, $ordernumber, $quantrec, $user, $cost,
1070 $invoiceno, $freight, $rrp, $budget_id, $datereceived
1073 my $dbh = C4::Context->dbh;
1074 # warn "DATE BEFORE : $daterecieved";
1075 # $daterecieved=POSIX::strftime("%Y-%m-%d",CORE::localtime) unless $daterecieved;
1076 # warn "DATE REC : $daterecieved";
1077 $datereceived = C4::Dates->output('iso') unless $datereceived;
1078 my $suggestionid = GetSuggestionFromBiblionumber( $dbh, $biblionumber );
1079 if ($suggestionid) {
1080 ModSuggestion( {suggestionid=>$suggestionid,
1081 STATUS=>'AVAILABLE',
1082 biblionumber=> $biblionumber}
1086 my $sth=$dbh->prepare("
1087 SELECT * FROM aqorders
1088 WHERE biblionumber=? AND aqorders.ordernumber=?");
1090 $sth->execute($biblionumber,$ordernumber);
1091 my $order = $sth->fetchrow_hashref();
1094 if ( $order->{quantity} > $quantrec ) {
1095 $sth=$dbh->prepare("
1097 SET quantityreceived=?
1099 , booksellerinvoicenumber=?
1104 WHERE biblionumber=? AND ordernumber=?");
1106 $sth->execute($quantrec,$datereceived,$invoiceno,$cost,$freight,$rrp,$quantrec,$biblionumber,$ordernumber);
1109 # create a new order for the remaining items, and set its bookfund.
1110 foreach my $orderkey ( "linenumber", "allocation" ) {
1111 delete($order->{'$orderkey'});
1113 $order->{'quantity'} -= $quantrec;
1114 $order->{'quantityreceived'} = 0;
1115 my $newOrder = NewOrder($order);
1117 $sth=$dbh->prepare("update aqorders
1118 set quantityreceived=?,datereceived=?,booksellerinvoicenumber=?,
1119 unitprice=?,freight=?,rrp=?
1120 where biblionumber=? and ordernumber=?");
1121 $sth->execute($quantrec,$datereceived,$invoiceno,$cost,$freight,$rrp,$biblionumber,$ordernumber);
1124 return $datereceived;
1126 #------------------------------------------------------------#
1130 @results = &SearchOrder($search, $biblionumber, $complete);
1132 Searches for orders.
1134 C<$search> may take one of several forms: if it is an ISBN,
1135 C<&ordersearch> returns orders with that ISBN. If C<$search> is an
1136 order number, C<&ordersearch> returns orders with that order number
1137 and biblionumber C<$biblionumber>. Otherwise, C<$search> is considered
1138 to be a space-separated list of search terms; in this case, all of the
1139 terms must appear in the title (matching the beginning of title
1142 If C<$complete> is C<yes>, the results will include only completed
1143 orders. In any case, C<&ordersearch> ignores cancelled orders.
1145 C<&ordersearch> returns an array.
1146 C<@results> is an array of references-to-hash with the following keys:
1152 =item C<seriestitle>
1163 #### -------- SearchOrder-------------------------------
1164 my ($ordernumber, $search, $supplierid, $basket) = @_;
1166 my $dbh = C4::Context->dbh;
1171 LEFT JOIN biblio ON aqorders.biblionumber=biblio.biblionumber
1172 LEFT JOIN biblioitems ON biblioitems.biblionumber=biblio.biblionumber
1173 LEFT JOIN aqbasket ON aqorders.basketno = aqbasket.basketno
1174 WHERE (datecancellationprinted is NULL)";
1177 $query .= " AND (aqorders.ordernumber=?)";
1178 push @args, $ordernumber;
1181 $query .= " AND (biblio.title like ? OR biblio.author LIKE ? OR biblioitems.isbn like ?)";
1182 push @args, ("%$search%","%$search%","%$search%");
1185 $query .= "AND aqbasket.booksellerid = ?";
1186 push @args, $supplierid;
1189 $query .= "AND aqorders.basketno = ?";
1190 push @args, $basket;
1193 my $sth = $dbh->prepare($query);
1194 $sth->execute(@args);
1195 my $results = $sth->fetchall_arrayref({});
1200 #------------------------------------------------------------#
1204 &DelOrder($biblionumber, $ordernumber);
1206 Cancel the order with the given order and biblio numbers. It does not
1207 delete any entries in the aqorders table, it merely marks them as
1213 my ( $bibnum, $ordernumber ) = @_;
1214 my $dbh = C4::Context->dbh;
1217 SET datecancellationprinted=now()
1218 WHERE biblionumber=? AND ordernumber=?
1220 my $sth = $dbh->prepare($query);
1221 $sth->execute( $bibnum, $ordernumber );
1225 =head2 FUNCTIONS ABOUT PARCELS
1229 #------------------------------------------------------------#
1233 @results = &GetParcel($booksellerid, $code, $date);
1235 Looks up all of the received items from the supplier with the given
1236 bookseller ID at the given date, for the given code (bookseller Invoice number). Ignores cancelled and completed orders.
1238 C<@results> is an array of references-to-hash. The keys of each element are fields from
1239 the aqorders, biblio, and biblioitems tables of the Koha database.
1241 C<@results> is sorted alphabetically by book title.
1246 #gets all orders from a certain supplier, orders them alphabetically
1247 my ( $supplierid, $code, $datereceived ) = @_;
1248 my $dbh = C4::Context->dbh;
1251 if $code; # add % if we search on a given code (otherwise, let him empty)
1253 SELECT authorisedby,
1258 aqorders.biblionumber,
1259 aqorders.ordernumber,
1261 aqorders.quantityreceived,
1268 LEFT JOIN aqbasket ON aqbasket.basketno=aqorders.basketno
1269 LEFT JOIN borrowers ON aqbasket.authorisedby=borrowers.borrowernumber
1270 LEFT JOIN biblio ON aqorders.biblionumber=biblio.biblionumber
1272 aqbasket.booksellerid = ?
1273 AND aqorders.booksellerinvoicenumber LIKE ?
1274 AND aqorders.datereceived = ? ";
1276 my @query_params = ( $supplierid, $code, $datereceived );
1277 if ( C4::Context->preference("IndependantBranches") ) {
1278 my $userenv = C4::Context->userenv;
1279 if ( ($userenv) && ( $userenv->{flags} != 1 ) ) {
1280 $strsth .= " and (borrowers.branchcode = ?
1281 or borrowers.branchcode = '')";
1282 push @query_params, $userenv->{branch};
1285 $strsth .= " ORDER BY aqbasket.basketno";
1286 # ## parcelinformation : $strsth
1287 my $sth = $dbh->prepare($strsth);
1288 $sth->execute( @query_params );
1289 while ( my $data = $sth->fetchrow_hashref ) {
1290 push( @results, $data );
1292 # ## countparcelbiblio: scalar(@results)
1298 #------------------------------------------------------------#
1302 $results = &GetParcels($bookseller, $order, $code, $datefrom, $dateto);
1304 get a lists of parcels.
1311 is the bookseller this function has to get parcels.
1314 To know on what criteria the results list has to be ordered.
1317 is the booksellerinvoicenumber.
1319 =item $datefrom & $dateto
1320 to know on what date this function has to filter its search.
1325 a pointer on a hash list containing parcel informations as such :
1331 =item Last operation
1333 =item Number of biblio
1335 =item Number of items
1342 my ($bookseller,$order, $code, $datefrom, $dateto) = @_;
1343 my $dbh = C4::Context->dbh;
1344 my @query_params = ();
1346 SELECT aqorders.booksellerinvoicenumber,
1347 datereceived,purchaseordernumber,
1348 count(DISTINCT biblionumber) AS biblio,
1349 sum(quantity) AS itemsexpected,
1350 sum(quantityreceived) AS itemsreceived
1351 FROM aqorders LEFT JOIN aqbasket ON aqbasket.basketno = aqorders.basketno
1352 WHERE aqbasket.booksellerid = ? and datereceived IS NOT NULL
1354 push @query_params, $bookseller;
1356 if ( defined $code ) {
1357 $strsth .= ' and aqorders.booksellerinvoicenumber like ? ';
1358 # add a % to the end of the code to allow stemming.
1359 push @query_params, "$code%";
1362 if ( defined $datefrom ) {
1363 $strsth .= ' and datereceived >= ? ';
1364 push @query_params, $datefrom;
1367 if ( defined $dateto ) {
1368 $strsth .= 'and datereceived <= ? ';
1369 push @query_params, $dateto;
1372 $strsth .= "group by aqorders.booksellerinvoicenumber,datereceived ";
1374 # can't use a placeholder to place this column name.
1375 # but, we could probably be checking to make sure it is a column that will be fetched.
1376 $strsth .= "order by $order " if ($order);
1378 my $sth = $dbh->prepare($strsth);
1380 $sth->execute( @query_params );
1381 my $results = $sth->fetchall_arrayref({});
1386 #------------------------------------------------------------#
1388 =head3 GetLateOrders
1390 @results = &GetLateOrders;
1392 Searches for bookseller with late orders.
1395 the table of supplier with late issues. This table is full of hashref.
1401 my $supplierid = shift;
1404 my $dbh = C4::Context->dbh;
1406 #BEWARE, order of parenthesis and LEFT JOIN is important for speed
1407 my $dbdriver = C4::Context->config("db_scheme") || "mysql";
1409 my @query_params = ($delay); # delay is the first argument regardless
1411 SELECT aqbasket.basketno,
1412 aqorders.ordernumber,
1413 DATE(aqbasket.closedate) AS orderdate,
1414 aqorders.rrp AS unitpricesupplier,
1415 aqorders.ecost AS unitpricelib,
1416 aqbudgets.budget_name AS budget,
1417 borrowers.branchcode AS branch,
1418 aqbooksellers.name AS supplier,
1419 biblio.author, biblio.title,
1420 biblioitems.publishercode AS publisher,
1421 biblioitems.publicationyear,
1425 aqorders LEFT JOIN biblio ON biblio.biblionumber = aqorders.biblionumber
1426 LEFT JOIN biblioitems ON biblioitems.biblionumber = biblio.biblionumber
1427 LEFT JOIN aqbudgets ON aqorders.budget_id = aqbudgets.budget_id,
1428 aqbasket LEFT JOIN borrowers ON aqbasket.authorisedby = borrowers.borrowernumber
1429 LEFT JOIN aqbooksellers ON aqbasket.booksellerid = aqbooksellers.id
1430 WHERE aqorders.basketno = aqbasket.basketno
1431 AND ( datereceived = ''
1432 OR datereceived IS NULL
1433 OR aqorders.quantityreceived < aqorders.quantity
1435 AND (aqorders.datecancellationprinted IS NULL OR aqorders.datecancellationprinted='0000-00-00')
1438 if ($dbdriver eq "mysql") {
1440 aqorders.quantity - IFNULL(aqorders.quantityreceived,0) AS quantity,
1441 (aqorders.quantity - IFNULL(aqorders.quantityreceived,0)) * aqorders.rrp AS subtotal,
1442 DATEDIFF(CURDATE( ),closedate) AS latesince
1444 $from .= " AND (closedate <= DATE_SUB(CURDATE( ),INTERVAL ? DAY)) ";
1446 HAVING quantity <> 0
1447 AND unitpricesupplier <> 0
1448 AND unitpricelib <> 0
1451 # FIXME: account for IFNULL as above
1453 aqorders.quantity AS quantity,
1454 aqorders.quantity * aqorders.rrp AS subtotal,
1455 (CURDATE - closedate) AS latesince
1457 $from .= " AND (closedate <= (CURDATE -(INTERVAL ? DAY)) ";
1459 if (defined $supplierid) {
1460 $from .= ' AND aqbasket.booksellerid = ? ';
1461 push @query_params, $supplierid;
1463 if (defined $branch) {
1464 $from .= ' AND borrowers.branchcode LIKE ? ';
1465 push @query_params, $branch;
1467 if (C4::Context->preference("IndependantBranches")
1468 && C4::Context->userenv
1469 && C4::Context->userenv->{flags} != 1 ) {
1470 $from .= ' AND borrowers.branchcode LIKE ? ';
1471 push @query_params, C4::Context->userenv->{branch};
1473 my $query = "$select $from $having\nORDER BY latesince, basketno, borrowers.branchcode, supplier";
1474 $debug and print STDERR "GetLateOrders query: $query\nGetLateOrders args: " . join(" ",@query_params);
1475 my $sth = $dbh->prepare($query);
1476 $sth->execute(@query_params);
1478 while (my $data = $sth->fetchrow_hashref) {
1479 $data->{orderdate} = format_date($data->{orderdate});
1480 push @results, $data;
1485 #------------------------------------------------------------#
1489 (\@order_loop, $total_qty, $total_price, $total_qtyreceived) = GetHistory( $title, $author, $name, $from_placed_on, $to_placed_on );
1491 Retreives some acquisition history information
1494 $order_loop is a list of hashrefs that each look like this:
1496 'author' => 'Twain, Mark',
1498 'biblionumber' => '215',
1500 'creationdate' => 'MM/DD/YYYY',
1501 'datereceived' => undef,
1504 'invoicenumber' => undef,
1506 'ordernumber' => '1',
1508 'quantityreceived' => undef,
1509 'title' => 'The Adventures of Huckleberry Finn'
1511 $total_qty is the sum of all of the quantities in $order_loop
1512 $total_price is the cost of each in $order_loop times the quantity
1513 $total_qtyreceived is the sum of all of the quantityreceived entries in $order_loop
1518 my ( $title, $author, $name, $from_placed_on, $to_placed_on ) = @_;
1521 my $total_qtyreceived = 0;
1522 my $total_price = 0;
1524 # don't run the query if there are no parameters (list would be too long for sure !)
1525 if ( $title || $author || $name || $from_placed_on || $to_placed_on ) {
1526 my $dbh = C4::Context->dbh;
1532 aqbasket.basketname,
1533 aqbasket.basketgroupid,
1534 aqbasketgroups.name as groupname,
1536 aqbasket.creationdate,
1537 aqorders.datereceived,
1539 aqorders.quantityreceived,
1541 aqorders.ordernumber,
1542 aqorders.booksellerinvoicenumber as invoicenumber,
1543 aqbooksellers.id as id,
1544 aqorders.biblionumber
1546 LEFT JOIN aqbasket ON aqorders.basketno=aqbasket.basketno
1547 LEFT JOIN aqbasketgroups ON aqbasket.basketgroupid=aqbasketgroups.id
1548 LEFT JOIN aqbooksellers ON aqbasket.booksellerid=aqbooksellers.id
1549 LEFT JOIN biblio ON biblio.biblionumber=aqorders.biblionumber";
1551 $query .= " LEFT JOIN borrowers ON aqbasket.authorisedby=borrowers.borrowernumber"
1552 if ( C4::Context->preference("IndependantBranches") );
1554 $query .= " WHERE (datecancellationprinted is NULL or datecancellationprinted='0000-00-00') ";
1556 my @query_params = ();
1558 if ( defined $title ) {
1559 $query .= " AND biblio.title LIKE ? ";
1560 $title =~ s/\s+/%/g;
1561 push @query_params, "%$title%";
1564 if ( defined $author ) {
1565 $query .= " AND biblio.author LIKE ? ";
1566 push @query_params, "%$author%";
1569 if ( defined $name ) {
1570 $query .= " AND aqbooksellers.name LIKE ? ";
1571 push @query_params, "%$name%";
1574 if ( defined $from_placed_on ) {
1575 $query .= " AND creationdate >= ? ";
1576 push @query_params, $from_placed_on;
1579 if ( defined $to_placed_on ) {
1580 $query .= " AND creationdate <= ? ";
1581 push @query_params, $to_placed_on;
1584 if ( C4::Context->preference("IndependantBranches") ) {
1585 my $userenv = C4::Context->userenv;
1586 if ( ($userenv) && ( $userenv->{flags} != 1 ) ) {
1587 $query .= " AND (borrowers.branchcode = ? OR borrowers.branchcode ='' ) ";
1588 push @query_params, $userenv->{branch};
1591 $query .= " ORDER BY id";
1592 my $sth = $dbh->prepare($query);
1593 $sth->execute( @query_params );
1595 while ( my $line = $sth->fetchrow_hashref ) {
1596 $line->{count} = $cnt++;
1597 $line->{toggle} = 1 if $cnt % 2;
1598 push @order_loop, $line;
1599 $line->{creationdate} = format_date( $line->{creationdate} );
1600 $line->{datereceived} = format_date( $line->{datereceived} );
1601 $total_qty += $line->{'quantity'};
1602 $total_qtyreceived += $line->{'quantityreceived'};
1603 $total_price += $line->{'quantity'} * $line->{'ecost'};
1606 return \@order_loop, $total_qty, $total_price, $total_qtyreceived;
1609 =head2 GetRecentAcqui
1611 $results = GetRecentAcqui($days);
1613 C<$results> is a ref to a table which containts hashref
1617 sub GetRecentAcqui {
1619 my $dbh = C4::Context->dbh;
1623 ORDER BY timestamp DESC
1626 my $sth = $dbh->prepare($query);
1628 my $results = $sth->fetchall_arrayref({});
1634 $contractlist = &GetContracts($booksellerid, $activeonly);
1636 Looks up the contracts that belong to a bookseller
1638 Returns a list of contracts
1642 =item C<$booksellerid> is the "id" field in the "aqbooksellers" table.
1644 =item C<$activeonly> if exists get only contracts that are still active.
1651 my ( $booksellerid, $activeonly ) = @_;
1652 my $dbh = C4::Context->dbh;
1654 if (! $activeonly) {
1658 WHERE booksellerid=?
1663 WHERE booksellerid=?
1664 AND contractenddate >= CURDATE( )";
1666 my $sth = $dbh->prepare($query);
1667 $sth->execute( $booksellerid );
1669 while (my $data = $sth->fetchrow_hashref ) {
1670 push(@results, $data);
1676 #------------------------------------------------------------#
1680 $contract = &GetContract($contractID);
1682 Looks up the contract that has PRIMKEY (contractnumber) value $contractID
1689 my ( $contractno ) = @_;
1690 my $dbh = C4::Context->dbh;
1694 WHERE contractnumber=?
1697 my $sth = $dbh->prepare($query);
1698 $sth->execute( $contractno );
1699 my $result = $sth->fetchrow_hashref;
1708 Koha Development Team <http://koha-community.org/>