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 line entrydate isbn author title publishercode collectiontitle notes quantity rrp);
238 $csv->combine(@headers);
239 $output = $csv->string() . "\n";
242 foreach my $order (@orders) {
244 my $bd = GetBiblioData($order->{'biblionumber'});
246 $contract->{'contractname'},
247 $order->{'ordernumber'},
248 $order->{'entrydate'},
252 $bd->{'publishercode'},
253 $bd->{'collectiontitle'},
255 $order->{'quantity'},
258 push (@rows, \@cols);
261 # Sort by publishercode
262 # TODO: Sort by publishercode then by title
263 @rows = sort { @$a[7] cmp @$b[7] } @rows;
265 foreach my $row (@rows) {
266 $csv->combine(@$row);
267 $output .= $csv->string() . "\n";
276 =head3 CloseBasketgroup
278 &CloseBasketgroup($basketgroupno);
284 sub CloseBasketgroup {
285 my ($basketgroupno) = @_;
286 my $dbh = C4::Context->dbh;
287 my $sth = $dbh->prepare("
288 UPDATE aqbasketgroups
292 $sth->execute($basketgroupno);
295 #------------------------------------------------------------#
297 =head3 ReOpenBaskergroup($basketgroupno)
299 &ReOpenBaskergroup($basketgroupno);
305 sub ReOpenBasketgroup {
306 my ($basketgroupno) = @_;
307 my $dbh = C4::Context->dbh;
308 my $sth = $dbh->prepare("
309 UPDATE aqbasketgroups
313 $sth->execute($basketgroupno);
316 #------------------------------------------------------------#
321 &DelBasket($basketno);
323 Deletes the basket that has basketno field $basketno in the aqbasket table.
327 =item C<$basketno> is the primary key of the basket in the aqbasket table.
334 my ( $basketno ) = @_;
335 my $query = "DELETE FROM aqbasket WHERE basketno=?";
336 my $dbh = C4::Context->dbh;
337 my $sth = $dbh->prepare($query);
338 $sth->execute($basketno);
342 #------------------------------------------------------------#
346 &ModBasket($basketinfo);
348 Modifies a basket, using a hashref $basketinfo for the relevant information, only $basketinfo->{'basketno'} is required.
352 =item C<$basketno> is the primary key of the basket in the aqbasket table.
359 my $basketinfo = shift;
360 my $query = "UPDATE aqbasket SET ";
362 foreach my $key (keys %$basketinfo){
363 if ($key ne 'basketno'){
364 $query .= "$key=?, ";
365 push(@params, $basketinfo->{$key} || undef );
368 # get rid of the "," at the end of $query
369 if (substr($query, length($query)-2) eq ', '){
374 $query .= "WHERE basketno=?";
375 push(@params, $basketinfo->{'basketno'});
376 my $dbh = C4::Context->dbh;
377 my $sth = $dbh->prepare($query);
378 $sth->execute(@params);
382 #------------------------------------------------------------#
384 =head3 ModBasketHeader
386 &ModBasketHeader($basketno, $basketname, $note, $booksellernote, $contractnumber);
388 Modifies a basket's header.
392 =item C<$basketno> is the "basketno" field in the "aqbasket" table;
394 =item C<$basketname> is the "basketname" field in the "aqbasket" table;
396 =item C<$note> is the "note" field in the "aqbasket" table;
398 =item C<$booksellernote> is the "booksellernote" field in the "aqbasket" table;
400 =item C<$contractnumber> is the "contractnumber" (foreign) key in the "aqbasket" table.
406 sub ModBasketHeader {
407 my ($basketno, $basketname, $note, $booksellernote, $contractnumber) = @_;
408 my $query = "UPDATE aqbasket SET basketname=?, note=?, booksellernote=? WHERE basketno=?";
409 my $dbh = C4::Context->dbh;
410 my $sth = $dbh->prepare($query);
411 $sth->execute($basketname,$note,$booksellernote,$basketno);
412 if ( $contractnumber ) {
413 my $query2 ="UPDATE aqbasket SET contractnumber=? WHERE basketno=?";
414 my $sth2 = $dbh->prepare($query2);
415 $sth2->execute($contractnumber,$basketno);
421 #------------------------------------------------------------#
423 =head3 GetBasketsByBookseller
425 @results = &GetBasketsByBookseller($booksellerid, $extra);
427 Returns a list of hashes of all the baskets that belong to bookseller 'booksellerid'.
431 =item C<$booksellerid> is the 'id' field of the bookseller in the aqbooksellers table
433 =item C<$extra> is the extra sql parameters, can be
435 $extra->{groupby}: group baskets by column
436 ex. $extra->{groupby} = aqbasket.basketgroupid
437 $extra->{orderby}: order baskets by column
438 $extra->{limit}: limit number of results (can be helpful for pagination)
444 sub GetBasketsByBookseller {
445 my ($booksellerid, $extra) = @_;
446 my $query = "SELECT * FROM aqbasket WHERE booksellerid=?";
448 if ($extra->{groupby}) {
449 $query .= " GROUP by $extra->{groupby}";
451 if ($extra->{orderby}){
452 $query .= " ORDER by $extra->{orderby}";
454 if ($extra->{limit}){
455 $query .= " LIMIT $extra->{limit}";
458 my $dbh = C4::Context->dbh;
459 my $sth = $dbh->prepare($query);
460 $sth->execute($booksellerid);
461 my $results = $sth->fetchall_arrayref({});
466 #------------------------------------------------------------#
468 =head3 GetBasketsByBasketgroup
470 $baskets = &GetBasketsByBasketgroup($basketgroupid);
472 Returns a reference to all baskets that belong to basketgroup $basketgroupid.
476 sub GetBasketsByBasketgroup {
477 my $basketgroupid = shift;
478 my $query = "SELECT * FROM aqbasket
479 LEFT JOIN aqcontract USING(contractnumber) WHERE basketgroupid=?";
480 my $dbh = C4::Context->dbh;
481 my $sth = $dbh->prepare($query);
482 $sth->execute($basketgroupid);
483 my $results = $sth->fetchall_arrayref({});
488 #------------------------------------------------------------#
490 =head3 NewBasketgroup
492 $basketgroupid = NewBasketgroup(\%hashref);
494 Adds a basketgroup to the aqbasketgroups table, and add the initial baskets to it.
496 $hashref->{'booksellerid'} is the 'id' field of the bookseller in the aqbooksellers table,
498 $hashref->{'name'} is the 'name' field of the basketgroup in the aqbasketgroups table,
500 $hashref->{'basketlist'} is a list reference of the 'id's of the baskets that belong to this group,
502 $hashref->{'deliveryplace'} is the 'deliveryplace' field of the basketgroup in the aqbasketgroups table,
504 $hashref->{'deliverycomment'} is the 'deliverycomment' field of the basketgroup in the aqbasketgroups table,
506 $hashref->{'closed'} is the 'closed' field of the aqbasketgroups table, it is false if 0, true otherwise.
511 my $basketgroupinfo = shift;
512 die "booksellerid is required to create a basketgroup" unless $basketgroupinfo->{'booksellerid'};
513 my $query = "INSERT INTO aqbasketgroups (";
515 foreach my $field ('name', 'deliveryplace', 'deliverycomment', 'closed') {
516 if ( $basketgroupinfo->{$field} ) {
517 $query .= "$field, ";
518 push(@params, $basketgroupinfo->{$field});
521 $query .= "booksellerid) VALUES (";
526 push(@params, $basketgroupinfo->{'booksellerid'});
527 my $dbh = C4::Context->dbh;
528 my $sth = $dbh->prepare($query);
529 $sth->execute(@params);
530 my $basketgroupid = $dbh->{'mysql_insertid'};
531 if( $basketgroupinfo->{'basketlist'} ) {
532 foreach my $basketno (@{$basketgroupinfo->{'basketlist'}}) {
533 my $query2 = "UPDATE aqbasket SET basketgroupid=? WHERE basketno=?";
534 my $sth2 = $dbh->prepare($query2);
535 $sth2->execute($basketgroupid, $basketno);
538 return $basketgroupid;
541 #------------------------------------------------------------#
543 =head3 ModBasketgroup
545 ModBasketgroup(\%hashref);
547 Modifies a basketgroup in the aqbasketgroups table, and add the baskets to it.
549 $hashref->{'id'} is the 'id' field of the basketgroup in the aqbasketgroup table, this parameter is mandatory,
551 $hashref->{'name'} is the 'name' field of the basketgroup in the aqbasketgroups table,
553 $hashref->{'basketlist'} is a list reference of the 'id's of the baskets that belong to this group,
555 $hashref->{'billingplace'} is the 'billingplace' field of the basketgroup in the aqbasketgroups table,
557 $hashref->{'deliveryplace'} is the 'deliveryplace' field of the basketgroup in the aqbasketgroups table,
559 $hashref->{'deliverycomment'} is the 'deliverycomment' field of the basketgroup in the aqbasketgroups table,
561 $hashref->{'closed'} is the 'closed' field of the aqbasketgroups table, it is false if 0, true otherwise.
566 my $basketgroupinfo = shift;
567 die "basketgroup id is required to edit a basketgroup" unless $basketgroupinfo->{'id'};
568 my $dbh = C4::Context->dbh;
569 my $query = "UPDATE aqbasketgroups SET ";
571 foreach my $field (qw(name billingplace deliveryplace freedeliveryplace deliverycomment closed)) {
572 if ( defined $basketgroupinfo->{$field} ) {
573 $query .= "$field=?, ";
574 push(@params, $basketgroupinfo->{$field});
579 $query .= " WHERE id=?";
580 push(@params, $basketgroupinfo->{'id'});
581 my $sth = $dbh->prepare($query);
582 $sth->execute(@params);
584 $sth = $dbh->prepare('UPDATE aqbasket SET basketgroupid = NULL WHERE basketgroupid = ?');
585 $sth->execute($basketgroupinfo->{'id'});
587 if($basketgroupinfo->{'basketlist'} && @{$basketgroupinfo->{'basketlist'}}){
588 $sth = $dbh->prepare("UPDATE aqbasket SET basketgroupid=? WHERE basketno=?");
589 foreach my $basketno (@{$basketgroupinfo->{'basketlist'}}) {
590 $sth->execute($basketgroupinfo->{'id'}, $basketno);
597 #------------------------------------------------------------#
599 =head3 DelBasketgroup
601 DelBasketgroup($basketgroupid);
603 Deletes a basketgroup in the aqbasketgroups table, and removes the reference to it from the baskets,
607 =item C<$basketgroupid> is the 'id' field of the basket in the aqbasketgroup table
614 my $basketgroupid = shift;
615 die "basketgroup id is required to edit a basketgroup" unless $basketgroupid;
616 my $query = "DELETE FROM aqbasketgroups WHERE id=?";
617 my $dbh = C4::Context->dbh;
618 my $sth = $dbh->prepare($query);
619 $sth->execute($basketgroupid);
623 #------------------------------------------------------------#
626 =head2 FUNCTIONS ABOUT ORDERS
628 =head3 GetBasketgroup
630 $basketgroup = &GetBasketgroup($basketgroupid);
632 Returns a reference to the hash containing all infermation about the basketgroup.
637 my $basketgroupid = shift;
638 die "basketgroup id is required to edit a basketgroup" unless $basketgroupid;
639 my $query = "SELECT * FROM aqbasketgroups WHERE id=?";
640 my $dbh = C4::Context->dbh;
641 my $sth = $dbh->prepare($query);
642 $sth->execute($basketgroupid);
643 my $result = $sth->fetchrow_hashref;
648 #------------------------------------------------------------#
650 =head3 GetBasketgroups
652 $basketgroups = &GetBasketgroups($booksellerid);
654 Returns a reference to the array of all the basketgroups of bookseller $booksellerid.
658 sub GetBasketgroups {
659 my $booksellerid = shift;
660 die "bookseller id is required to edit a basketgroup" unless $booksellerid;
661 my $query = "SELECT * FROM aqbasketgroups WHERE booksellerid=? ORDER BY `id` DESC";
662 my $dbh = C4::Context->dbh;
663 my $sth = $dbh->prepare($query);
664 $sth->execute($booksellerid);
665 my $results = $sth->fetchall_arrayref({});
670 #------------------------------------------------------------#
672 =head2 FUNCTIONS ABOUT ORDERS
676 #------------------------------------------------------------#
678 =head3 GetPendingOrders
680 $orders = &GetPendingOrders($booksellerid, $grouped, $owner);
682 Finds pending orders from the bookseller with the given ID. Ignores
683 completed and cancelled orders.
685 C<$booksellerid> contains the bookseller identifier
686 C<$grouped> contains 0 or 1. 0 means returns the list, 1 means return the total
687 C<$owner> contains 0 or 1. 0 means any owner. 1 means only the list of orders entered by the user itself.
689 C<$orders> is a reference-to-array; each element is a
690 reference-to-hash with the following fields:
691 C<$grouped> is a boolean that, if set to 1 will group all order lines of the same basket
692 in a single result line
696 =item C<authorizedby>
704 These give the value of the corresponding field in the aqorders table
705 of the Koha database.
707 Results are ordered from most to least recent.
711 sub GetPendingOrders {
712 my ($supplierid,$grouped,$owner,$basketno) = @_;
713 my $dbh = C4::Context->dbh;
715 SELECT ".($grouped?"count(*),":"")."aqbasket.basketno,
716 surname,firstname,aqorders.*,biblio.*,biblioitems.isbn,
717 aqbasket.closedate, aqbasket.creationdate, aqbasket.basketname
719 LEFT JOIN aqbasket ON aqbasket.basketno=aqorders.basketno
720 LEFT JOIN borrowers ON aqbasket.authorisedby=borrowers.borrowernumber
721 LEFT JOIN biblio ON biblio.biblionumber=aqorders.biblionumber
722 LEFT JOIN biblioitems ON biblioitems.biblionumber=biblio.biblionumber
724 AND (quantity > quantityreceived OR quantityreceived is NULL)
725 AND datecancellationprinted IS NULL
726 AND (to_days(now())-to_days(closedate) < 180 OR closedate IS NULL)
728 ## FIXME Why 180 days ???
729 my @query_params = ( $supplierid );
730 my $userenv = C4::Context->userenv;
731 if ( C4::Context->preference("IndependantBranches") ) {
732 if ( ($userenv) && ( $userenv->{flags} != 1 ) ) {
733 $strsth .= " and (borrowers.branchcode = ?
734 or borrowers.branchcode = '')";
735 push @query_params, $userenv->{branch};
739 $strsth .= " AND aqbasket.authorisedby=? ";
740 push @query_params, $userenv->{'number'};
743 $strsth .= " AND aqbasket.basketno=? ";
744 push @query_params, $basketno;
746 $strsth .= " group by aqbasket.basketno" if $grouped;
747 $strsth .= " order by aqbasket.basketno";
749 my $sth = $dbh->prepare($strsth);
750 $sth->execute( @query_params );
751 my $results = $sth->fetchall_arrayref({});
756 #------------------------------------------------------------#
760 @orders = &GetOrders($basketnumber, $orderby);
762 Looks up the pending (non-cancelled) orders with the given basket
763 number. If C<$booksellerID> is non-empty, only orders from that seller
767 C<&basket> returns a two-element array. C<@orders> is an array of
768 references-to-hash, whose keys are the fields from the aqorders,
769 biblio, and biblioitems tables in the Koha database.
774 my ( $basketno, $orderby ) = @_;
775 my $dbh = C4::Context->dbh;
777 SELECT biblio.*,biblioitems.*,
782 LEFT JOIN aqbudgets ON aqbudgets.budget_id = aqorders.budget_id
783 LEFT JOIN biblio ON biblio.biblionumber = aqorders.biblionumber
784 LEFT JOIN biblioitems ON biblioitems.biblionumber =biblio.biblionumber
786 AND (datecancellationprinted IS NULL OR datecancellationprinted='0000-00-00')
789 $orderby = "biblioitems.publishercode,biblio.title" unless $orderby;
790 $query .= " ORDER BY $orderby";
791 my $sth = $dbh->prepare($query);
792 $sth->execute($basketno);
793 my $results = $sth->fetchall_arrayref({});
798 #------------------------------------------------------------#
800 =head3 GetOrderNumber
802 $ordernumber = &GetOrderNumber($biblioitemnumber, $biblionumber);
804 Looks up the ordernumber with the given biblionumber and biblioitemnumber.
806 Returns the number of this order.
810 =item C<$ordernumber> is the order number.
817 my ( $biblionumber,$biblioitemnumber ) = @_;
818 my $dbh = C4::Context->dbh;
823 AND biblioitemnumber=?
825 my $sth = $dbh->prepare($query);
826 $sth->execute( $biblionumber, $biblioitemnumber );
828 return $sth->fetchrow;
831 #------------------------------------------------------------#
835 $order = &GetOrder($ordernumber);
837 Looks up an order by order number.
839 Returns a reference-to-hash describing the order. The keys of
840 C<$order> are fields from the biblio, biblioitems, aqorders tables of the Koha database.
845 my ($ordernumber) = @_;
846 my $dbh = C4::Context->dbh;
848 SELECT biblioitems.*, biblio.*, aqorders.*
850 LEFT JOIN biblio on biblio.biblionumber=aqorders.biblionumber
851 LEFT JOIN biblioitems on biblioitems.biblionumber=aqorders.biblionumber
852 WHERE aqorders.ordernumber=?
855 my $sth= $dbh->prepare($query);
856 $sth->execute($ordernumber);
857 my $data = $sth->fetchrow_hashref;
862 #------------------------------------------------------------#
866 &NewOrder(\%hashref);
868 Adds a new order to the database. Any argument that isn't described
869 below is the new value of the field with the same name in the aqorders
870 table of the Koha database.
874 =item $hashref->{'basketno'} is the basketno foreign key in aqorders, it is mandatory
876 =item $hashref->{'ordernumber'} is a "minimum order number."
878 =item $hashref->{'budgetdate'} is effectively ignored.
879 If it's undef (anything false) or the string 'now', the current day is used.
880 Else, the upcoming July 1st is used.
882 =item $hashref->{'subscription'} may be either "yes", or anything else for "no".
884 =item $hashref->{'uncertainprice'} may be 0 for "the price is known" or 1 for "the price is uncertain"
886 =item defaults entrydate to Now
888 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".
895 my $orderinfo = shift;
896 #### ------------------------------
897 my $dbh = C4::Context->dbh;
901 # if these parameters are missing, we can't continue
902 for my $key (qw/basketno quantity biblionumber budget_id/) {
903 die "Mandatory parameter $key missing" unless $orderinfo->{$key};
906 if ( defined $orderinfo->{subscription} && $orderinfo->{'subscription'} eq 'yes' ) {
907 $orderinfo->{'subscription'} = 1;
909 $orderinfo->{'subscription'} = 0;
911 $orderinfo->{'entrydate'} ||= C4::Dates->new()->output("iso");
912 if (!$orderinfo->{quantityreceived}) {
913 $orderinfo->{quantityreceived} = 0;
916 my $ordernumber=InsertInTable("aqorders",$orderinfo);
917 return ( $orderinfo->{'basketno'}, $ordernumber );
922 #------------------------------------------------------------#
931 #my ($biblioitemnumber,$ordernumber, $biblionumber) = @_;
932 my ($itemnumber, $ordernumber) = @_;
933 my $dbh = C4::Context->dbh;
935 INSERT INTO aqorders_items
936 (itemnumber, ordernumber)
939 my $sth = $dbh->prepare($query);
940 $sth->execute( $itemnumber, $ordernumber);
943 #------------------------------------------------------------#
947 &ModOrder(\%hashref);
949 Modifies an existing order. Updates the order with order number
950 $hashref->{'ordernumber'} and biblionumber $hashref->{'biblionumber'}. All
951 other keys of the hash update the fields with the same name in the aqorders
952 table of the Koha database.
957 my $orderinfo = shift;
959 die "Ordernumber is required" if $orderinfo->{'ordernumber'} eq '' ;
960 die "Biblionumber is required" if $orderinfo->{'biblionumber'} eq '';
962 my $dbh = C4::Context->dbh;
965 # update uncertainprice to an integer, just in case (under FF, checked boxes have the value "ON" by default)
966 $orderinfo->{uncertainprice}=1 if $orderinfo->{uncertainprice};
968 # delete($orderinfo->{'branchcode'});
969 # the hash contains a lot of entries not in aqorders, so get the columns ...
970 my $sth = $dbh->prepare("SELECT * FROM aqorders LIMIT 1;");
972 my $colnames = $sth->{NAME};
973 my $query = "UPDATE aqorders SET ";
975 foreach my $orderinfokey (grep(!/ordernumber/, keys %$orderinfo)){
976 # ... and skip hash entries that are not in the aqorders table
977 # FIXME : probably not the best way to do it (would be better to have a correct hash)
978 next unless grep(/^$orderinfokey$/, @$colnames);
979 $query .= "$orderinfokey=?, ";
980 push(@params, $orderinfo->{$orderinfokey});
983 $query .= "timestamp=NOW() WHERE ordernumber=?";
984 # push(@params, $specorderinfo{'ordernumber'});
985 push(@params, $orderinfo->{'ordernumber'} );
986 $sth = $dbh->prepare($query);
987 $sth->execute(@params);
991 #------------------------------------------------------------#
995 &ModOrderItem(\%hashref);
997 Modifies the itemnumber in the aqorders_items table. The input hash needs three entities:
1001 =item - itemnumber: the old itemnumber
1002 =item - ordernumber: the order this item is attached to
1003 =item - newitemnumber: the new itemnumber we want to attach the line to
1010 my $orderiteminfo = shift;
1011 if (! $orderiteminfo->{'ordernumber'} || ! $orderiteminfo->{'itemnumber'} || ! $orderiteminfo->{'newitemnumber'}){
1012 die "Ordernumber, itemnumber and newitemnumber is required";
1015 my $dbh = C4::Context->dbh;
1017 my $query = "UPDATE aqorders_items set itemnumber=? where itemnumber=? and ordernumber=?";
1018 my @params = ($orderiteminfo->{'newitemnumber'}, $orderiteminfo->{'itemnumber'}, $orderiteminfo->{'ordernumber'});
1019 my $sth = $dbh->prepare($query);
1020 $sth->execute(@params);
1024 #------------------------------------------------------------#
1027 =head3 ModOrderBibliotemNumber
1029 &ModOrderBiblioitemNumber($biblioitemnumber,$ordernumber, $biblionumber);
1031 Modifies the biblioitemnumber for an existing order.
1032 Updates the order with order number C<$ordernum> and biblionumber C<$biblionumber>.
1036 #FIXME: is this used at all?
1037 sub ModOrderBiblioitemNumber {
1038 my ($biblioitemnumber,$ordernumber, $biblionumber) = @_;
1039 my $dbh = C4::Context->dbh;
1042 SET biblioitemnumber = ?
1043 WHERE ordernumber = ?
1044 AND biblionumber = ?";
1045 my $sth = $dbh->prepare($query);
1046 $sth->execute( $biblioitemnumber, $ordernumber, $biblionumber );
1049 #------------------------------------------------------------#
1051 =head3 ModReceiveOrder
1053 &ModReceiveOrder($biblionumber, $ordernumber, $quantityreceived, $user,
1054 $unitprice, $booksellerinvoicenumber, $biblioitemnumber,
1055 $freight, $bookfund, $rrp);
1057 Updates an order, to reflect the fact that it was received, at least
1058 in part. All arguments not mentioned below update the fields with the
1059 same name in the aqorders table of the Koha database.
1061 If a partial order is received, splits the order into two. The received
1062 portion must have a booksellerinvoicenumber.
1064 Updates the order with bibilionumber C<$biblionumber> and ordernumber
1070 sub ModReceiveOrder {
1072 $biblionumber, $ordernumber, $quantrec, $user, $cost,
1073 $invoiceno, $freight, $rrp, $budget_id, $datereceived
1076 my $dbh = C4::Context->dbh;
1077 # warn "DATE BEFORE : $daterecieved";
1078 # $daterecieved=POSIX::strftime("%Y-%m-%d",CORE::localtime) unless $daterecieved;
1079 # warn "DATE REC : $daterecieved";
1080 $datereceived = C4::Dates->output('iso') unless $datereceived;
1081 my $suggestionid = GetSuggestionFromBiblionumber( $dbh, $biblionumber );
1082 if ($suggestionid) {
1083 ModSuggestion( {suggestionid=>$suggestionid,
1084 STATUS=>'AVAILABLE',
1085 biblionumber=> $biblionumber}
1089 my $sth=$dbh->prepare("
1090 SELECT * FROM aqorders
1091 WHERE biblionumber=? AND aqorders.ordernumber=?");
1093 $sth->execute($biblionumber,$ordernumber);
1094 my $order = $sth->fetchrow_hashref();
1097 if ( $order->{quantity} > $quantrec ) {
1098 $sth=$dbh->prepare("
1100 SET quantityreceived=?
1102 , booksellerinvoicenumber=?
1107 WHERE biblionumber=? AND ordernumber=?");
1109 $sth->execute($quantrec,$datereceived,$invoiceno,$cost,$freight,$rrp,$quantrec,$biblionumber,$ordernumber);
1112 # create a new order for the remaining items, and set its bookfund.
1113 foreach my $orderkey ( "linenumber", "allocation" ) {
1114 delete($order->{'$orderkey'});
1116 $order->{'quantity'} -= $quantrec;
1117 $order->{'quantityreceived'} = 0;
1118 my $newOrder = NewOrder($order);
1120 $sth=$dbh->prepare("update aqorders
1121 set quantityreceived=?,datereceived=?,booksellerinvoicenumber=?,
1122 unitprice=?,freight=?,rrp=?
1123 where biblionumber=? and ordernumber=?");
1124 $sth->execute($quantrec,$datereceived,$invoiceno,$cost,$freight,$rrp,$biblionumber,$ordernumber);
1127 return $datereceived;
1129 #------------------------------------------------------------#
1133 @results = &SearchOrder($search, $biblionumber, $complete);
1135 Searches for orders.
1137 C<$search> may take one of several forms: if it is an ISBN,
1138 C<&ordersearch> returns orders with that ISBN. If C<$search> is an
1139 order number, C<&ordersearch> returns orders with that order number
1140 and biblionumber C<$biblionumber>. Otherwise, C<$search> is considered
1141 to be a space-separated list of search terms; in this case, all of the
1142 terms must appear in the title (matching the beginning of title
1145 If C<$complete> is C<yes>, the results will include only completed
1146 orders. In any case, C<&ordersearch> ignores cancelled orders.
1148 C<&ordersearch> returns an array.
1149 C<@results> is an array of references-to-hash with the following keys:
1155 =item C<seriestitle>
1166 #### -------- SearchOrder-------------------------------
1167 my ($ordernumber, $search, $supplierid, $basket) = @_;
1169 my $dbh = C4::Context->dbh;
1174 LEFT JOIN biblio ON aqorders.biblionumber=biblio.biblionumber
1175 LEFT JOIN biblioitems ON biblioitems.biblionumber=biblio.biblionumber
1176 LEFT JOIN aqbasket ON aqorders.basketno = aqbasket.basketno
1177 WHERE (datecancellationprinted is NULL)";
1180 $query .= " AND (aqorders.ordernumber=?)";
1181 push @args, $ordernumber;
1184 $query .= " AND (biblio.title like ? OR biblio.author LIKE ? OR biblioitems.isbn like ?)";
1185 push @args, ("%$search%","%$search%","%$search%");
1188 $query .= "AND aqbasket.booksellerid = ?";
1189 push @args, $supplierid;
1192 $query .= "AND aqorders.basketno = ?";
1193 push @args, $basket;
1196 my $sth = $dbh->prepare($query);
1197 $sth->execute(@args);
1198 my $results = $sth->fetchall_arrayref({});
1203 #------------------------------------------------------------#
1207 &DelOrder($biblionumber, $ordernumber);
1209 Cancel the order with the given order and biblio numbers. It does not
1210 delete any entries in the aqorders table, it merely marks them as
1216 my ( $bibnum, $ordernumber ) = @_;
1217 my $dbh = C4::Context->dbh;
1220 SET datecancellationprinted=now()
1221 WHERE biblionumber=? AND ordernumber=?
1223 my $sth = $dbh->prepare($query);
1224 $sth->execute( $bibnum, $ordernumber );
1228 =head2 FUNCTIONS ABOUT PARCELS
1232 #------------------------------------------------------------#
1236 @results = &GetParcel($booksellerid, $code, $date);
1238 Looks up all of the received items from the supplier with the given
1239 bookseller ID at the given date, for the given code (bookseller Invoice number). Ignores cancelled and completed orders.
1241 C<@results> is an array of references-to-hash. The keys of each element are fields from
1242 the aqorders, biblio, and biblioitems tables of the Koha database.
1244 C<@results> is sorted alphabetically by book title.
1249 #gets all orders from a certain supplier, orders them alphabetically
1250 my ( $supplierid, $code, $datereceived ) = @_;
1251 my $dbh = C4::Context->dbh;
1254 if $code; # add % if we search on a given code (otherwise, let him empty)
1256 SELECT authorisedby,
1261 aqorders.biblionumber,
1262 aqorders.ordernumber,
1264 aqorders.quantityreceived,
1271 LEFT JOIN aqbasket ON aqbasket.basketno=aqorders.basketno
1272 LEFT JOIN borrowers ON aqbasket.authorisedby=borrowers.borrowernumber
1273 LEFT JOIN biblio ON aqorders.biblionumber=biblio.biblionumber
1275 aqbasket.booksellerid = ?
1276 AND aqorders.booksellerinvoicenumber LIKE ?
1277 AND aqorders.datereceived = ? ";
1279 my @query_params = ( $supplierid, $code, $datereceived );
1280 if ( C4::Context->preference("IndependantBranches") ) {
1281 my $userenv = C4::Context->userenv;
1282 if ( ($userenv) && ( $userenv->{flags} != 1 ) ) {
1283 $strsth .= " and (borrowers.branchcode = ?
1284 or borrowers.branchcode = '')";
1285 push @query_params, $userenv->{branch};
1288 $strsth .= " ORDER BY aqbasket.basketno";
1289 # ## parcelinformation : $strsth
1290 my $sth = $dbh->prepare($strsth);
1291 $sth->execute( @query_params );
1292 while ( my $data = $sth->fetchrow_hashref ) {
1293 push( @results, $data );
1295 # ## countparcelbiblio: scalar(@results)
1301 #------------------------------------------------------------#
1305 $results = &GetParcels($bookseller, $order, $code, $datefrom, $dateto);
1307 get a lists of parcels.
1314 is the bookseller this function has to get parcels.
1317 To know on what criteria the results list has to be ordered.
1320 is the booksellerinvoicenumber.
1322 =item $datefrom & $dateto
1323 to know on what date this function has to filter its search.
1328 a pointer on a hash list containing parcel informations as such :
1334 =item Last operation
1336 =item Number of biblio
1338 =item Number of items
1345 my ($bookseller,$order, $code, $datefrom, $dateto) = @_;
1346 my $dbh = C4::Context->dbh;
1347 my @query_params = ();
1349 SELECT aqorders.booksellerinvoicenumber,
1350 datereceived,purchaseordernumber,
1351 count(DISTINCT biblionumber) AS biblio,
1352 sum(quantity) AS itemsexpected,
1353 sum(quantityreceived) AS itemsreceived
1354 FROM aqorders LEFT JOIN aqbasket ON aqbasket.basketno = aqorders.basketno
1355 WHERE aqbasket.booksellerid = ? and datereceived IS NOT NULL
1357 push @query_params, $bookseller;
1359 if ( defined $code ) {
1360 $strsth .= ' and aqorders.booksellerinvoicenumber like ? ';
1361 # add a % to the end of the code to allow stemming.
1362 push @query_params, "$code%";
1365 if ( defined $datefrom ) {
1366 $strsth .= ' and datereceived >= ? ';
1367 push @query_params, $datefrom;
1370 if ( defined $dateto ) {
1371 $strsth .= 'and datereceived <= ? ';
1372 push @query_params, $dateto;
1375 $strsth .= "group by aqorders.booksellerinvoicenumber,datereceived ";
1377 # can't use a placeholder to place this column name.
1378 # but, we could probably be checking to make sure it is a column that will be fetched.
1379 $strsth .= "order by $order " if ($order);
1381 my $sth = $dbh->prepare($strsth);
1383 $sth->execute( @query_params );
1384 my $results = $sth->fetchall_arrayref({});
1389 #------------------------------------------------------------#
1391 =head3 GetLateOrders
1393 @results = &GetLateOrders;
1395 Searches for bookseller with late orders.
1398 the table of supplier with late issues. This table is full of hashref.
1404 my $supplierid = shift;
1407 my $dbh = C4::Context->dbh;
1409 #BEWARE, order of parenthesis and LEFT JOIN is important for speed
1410 my $dbdriver = C4::Context->config("db_scheme") || "mysql";
1412 my @query_params = ($delay); # delay is the first argument regardless
1414 SELECT aqbasket.basketno,
1415 aqorders.ordernumber,
1416 DATE(aqbasket.closedate) AS orderdate,
1417 aqorders.rrp AS unitpricesupplier,
1418 aqorders.ecost AS unitpricelib,
1419 aqbudgets.budget_name AS budget,
1420 borrowers.branchcode AS branch,
1421 aqbooksellers.name AS supplier,
1422 biblio.author, biblio.title,
1423 biblioitems.publishercode AS publisher,
1424 biblioitems.publicationyear,
1428 aqorders LEFT JOIN biblio ON biblio.biblionumber = aqorders.biblionumber
1429 LEFT JOIN biblioitems ON biblioitems.biblionumber = biblio.biblionumber
1430 LEFT JOIN aqbudgets ON aqorders.budget_id = aqbudgets.budget_id,
1431 aqbasket LEFT JOIN borrowers ON aqbasket.authorisedby = borrowers.borrowernumber
1432 LEFT JOIN aqbooksellers ON aqbasket.booksellerid = aqbooksellers.id
1433 WHERE aqorders.basketno = aqbasket.basketno
1434 AND ( datereceived = ''
1435 OR datereceived IS NULL
1436 OR aqorders.quantityreceived < aqorders.quantity
1438 AND (aqorders.datecancellationprinted IS NULL OR aqorders.datecancellationprinted='0000-00-00')
1441 if ($dbdriver eq "mysql") {
1443 aqorders.quantity - IFNULL(aqorders.quantityreceived,0) AS quantity,
1444 (aqorders.quantity - IFNULL(aqorders.quantityreceived,0)) * aqorders.rrp AS subtotal,
1445 DATEDIFF(CURDATE( ),closedate) AS latesince
1447 $from .= " AND (closedate <= DATE_SUB(CURDATE( ),INTERVAL ? DAY)) ";
1449 HAVING quantity <> 0
1450 AND unitpricesupplier <> 0
1451 AND unitpricelib <> 0
1454 # FIXME: account for IFNULL as above
1456 aqorders.quantity AS quantity,
1457 aqorders.quantity * aqorders.rrp AS subtotal,
1458 (CURDATE - closedate) AS latesince
1460 $from .= " AND (closedate <= (CURDATE -(INTERVAL ? DAY)) ";
1462 if (defined $supplierid) {
1463 $from .= ' AND aqbasket.booksellerid = ? ';
1464 push @query_params, $supplierid;
1466 if (defined $branch) {
1467 $from .= ' AND borrowers.branchcode LIKE ? ';
1468 push @query_params, $branch;
1470 if (C4::Context->preference("IndependantBranches")
1471 && C4::Context->userenv
1472 && C4::Context->userenv->{flags} != 1 ) {
1473 $from .= ' AND borrowers.branchcode LIKE ? ';
1474 push @query_params, C4::Context->userenv->{branch};
1476 my $query = "$select $from $having\nORDER BY latesince, basketno, borrowers.branchcode, supplier";
1477 $debug and print STDERR "GetLateOrders query: $query\nGetLateOrders args: " . join(" ",@query_params);
1478 my $sth = $dbh->prepare($query);
1479 $sth->execute(@query_params);
1481 while (my $data = $sth->fetchrow_hashref) {
1482 $data->{orderdate} = format_date($data->{orderdate});
1483 push @results, $data;
1488 #------------------------------------------------------------#
1492 (\@order_loop, $total_qty, $total_price, $total_qtyreceived) = GetHistory( $title, $author, $name, $from_placed_on, $to_placed_on );
1494 Retreives some acquisition history information
1497 $order_loop is a list of hashrefs that each look like this:
1499 'author' => 'Twain, Mark',
1501 'biblionumber' => '215',
1503 'creationdate' => 'MM/DD/YYYY',
1504 'datereceived' => undef,
1507 'invoicenumber' => undef,
1509 'ordernumber' => '1',
1511 'quantityreceived' => undef,
1512 'title' => 'The Adventures of Huckleberry Finn'
1514 $total_qty is the sum of all of the quantities in $order_loop
1515 $total_price is the cost of each in $order_loop times the quantity
1516 $total_qtyreceived is the sum of all of the quantityreceived entries in $order_loop
1521 my ( $title, $author, $name, $from_placed_on, $to_placed_on ) = @_;
1524 my $total_qtyreceived = 0;
1525 my $total_price = 0;
1527 # don't run the query if there are no parameters (list would be too long for sure !)
1528 if ( $title || $author || $name || $from_placed_on || $to_placed_on ) {
1529 my $dbh = C4::Context->dbh;
1535 aqbasket.basketname,
1536 aqbasket.basketgroupid,
1537 aqbasketgroups.name as groupname,
1539 aqbasket.creationdate,
1540 aqorders.datereceived,
1542 aqorders.quantityreceived,
1544 aqorders.ordernumber,
1545 aqorders.booksellerinvoicenumber as invoicenumber,
1546 aqbooksellers.id as id,
1547 aqorders.biblionumber
1549 LEFT JOIN aqbasket ON aqorders.basketno=aqbasket.basketno
1550 LEFT JOIN aqbasketgroups ON aqbasket.basketgroupid=aqbasketgroups.id
1551 LEFT JOIN aqbooksellers ON aqbasket.booksellerid=aqbooksellers.id
1552 LEFT JOIN biblio ON biblio.biblionumber=aqorders.biblionumber";
1554 $query .= " LEFT JOIN borrowers ON aqbasket.authorisedby=borrowers.borrowernumber"
1555 if ( C4::Context->preference("IndependantBranches") );
1557 $query .= " WHERE (datecancellationprinted is NULL or datecancellationprinted='0000-00-00') ";
1559 my @query_params = ();
1561 if ( defined $title ) {
1562 $query .= " AND biblio.title LIKE ? ";
1563 $title =~ s/\s+/%/g;
1564 push @query_params, "%$title%";
1567 if ( defined $author ) {
1568 $query .= " AND biblio.author LIKE ? ";
1569 push @query_params, "%$author%";
1572 if ( defined $name ) {
1573 $query .= " AND aqbooksellers.name LIKE ? ";
1574 push @query_params, "%$name%";
1577 if ( defined $from_placed_on ) {
1578 $query .= " AND creationdate >= ? ";
1579 push @query_params, $from_placed_on;
1582 if ( defined $to_placed_on ) {
1583 $query .= " AND creationdate <= ? ";
1584 push @query_params, $to_placed_on;
1587 if ( C4::Context->preference("IndependantBranches") ) {
1588 my $userenv = C4::Context->userenv;
1589 if ( ($userenv) && ( $userenv->{flags} != 1 ) ) {
1590 $query .= " AND (borrowers.branchcode = ? OR borrowers.branchcode ='' ) ";
1591 push @query_params, $userenv->{branch};
1594 $query .= " ORDER BY id";
1595 my $sth = $dbh->prepare($query);
1596 $sth->execute( @query_params );
1598 while ( my $line = $sth->fetchrow_hashref ) {
1599 $line->{count} = $cnt++;
1600 $line->{toggle} = 1 if $cnt % 2;
1601 push @order_loop, $line;
1602 $line->{creationdate} = format_date( $line->{creationdate} );
1603 $line->{datereceived} = format_date( $line->{datereceived} );
1604 $total_qty += $line->{'quantity'};
1605 $total_qtyreceived += $line->{'quantityreceived'};
1606 $total_price += $line->{'quantity'} * $line->{'ecost'};
1609 return \@order_loop, $total_qty, $total_price, $total_qtyreceived;
1612 =head2 GetRecentAcqui
1614 $results = GetRecentAcqui($days);
1616 C<$results> is a ref to a table which containts hashref
1620 sub GetRecentAcqui {
1622 my $dbh = C4::Context->dbh;
1626 ORDER BY timestamp DESC
1629 my $sth = $dbh->prepare($query);
1631 my $results = $sth->fetchall_arrayref({});
1637 $contractlist = &GetContracts($booksellerid, $activeonly);
1639 Looks up the contracts that belong to a bookseller
1641 Returns a list of contracts
1645 =item C<$booksellerid> is the "id" field in the "aqbooksellers" table.
1647 =item C<$activeonly> if exists get only contracts that are still active.
1654 my ( $booksellerid, $activeonly ) = @_;
1655 my $dbh = C4::Context->dbh;
1657 if (! $activeonly) {
1661 WHERE booksellerid=?
1666 WHERE booksellerid=?
1667 AND contractenddate >= CURDATE( )";
1669 my $sth = $dbh->prepare($query);
1670 $sth->execute( $booksellerid );
1672 while (my $data = $sth->fetchrow_hashref ) {
1673 push(@results, $data);
1679 #------------------------------------------------------------#
1683 $contract = &GetContract($contractID);
1685 Looks up the contract that has PRIMKEY (contractnumber) value $contractID
1692 my ( $contractno ) = @_;
1693 my $dbh = C4::Context->dbh;
1697 WHERE contractnumber=?
1700 my $sth = $dbh->prepare($query);
1701 $sth->execute( $contractno );
1702 my $result = $sth->fetchrow_hashref;
1711 Koha Development Team <http://koha-community.org/>