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
59 &NewOrderItem &ModOrderItem
61 &GetParcels &GetParcel
62 &GetContracts &GetContract
64 &GetItemnumbersFromOrder
72 sub GetOrderFromItemnumber {
73 my ($itemnumber) = @_;
74 my $dbh = C4::Context->dbh;
77 SELECT * from aqorders LEFT JOIN aqorders_items
78 ON ( aqorders.ordernumber = aqorders_items.ordernumber )
79 WHERE itemnumber = ? |;
81 my $sth = $dbh->prepare($query);
85 $sth->execute($itemnumber);
87 my $order = $sth->fetchrow_hashref;
92 # Returns the itemnumber(s) associated with the ordernumber given in parameter
93 sub GetItemnumbersFromOrder {
94 my ($ordernumber) = @_;
95 my $dbh = C4::Context->dbh;
96 my $query = "SELECT itemnumber FROM aqorders_items WHERE ordernumber=?";
97 my $sth = $dbh->prepare($query);
98 $sth->execute($ordernumber);
101 while (my $order = $sth->fetchrow_hashref) {
102 push @tab, $order->{'itemnumber'};
116 C4::Acquisition - Koha functions for dealing with orders and acquisitions
124 The functions in this module deal with acquisitions, managing book
125 orders, basket and parcels.
129 =head2 FUNCTIONS ABOUT BASKETS
133 $aqbasket = &GetBasket($basketnumber);
135 get all basket informations in aqbasket for a given basket
137 B<returns:> informations for a given basket returned as a hashref.
143 my $dbh = C4::Context->dbh;
146 concat( b.firstname,' ',b.surname) AS authorisedbyname,
147 b.branchcode AS branch
149 LEFT JOIN borrowers b ON aqbasket.authorisedby=b.borrowernumber
152 my $sth=$dbh->prepare($query);
153 $sth->execute($basketno);
154 my $basket = $sth->fetchrow_hashref;
158 #------------------------------------------------------------#
162 $basket = &NewBasket( $booksellerid, $authorizedby, $basketname,
163 $basketnote, $basketbooksellernote, $basketcontractnumber );
165 Create a new basket in aqbasket table
169 =item C<$booksellerid> is a foreign key in the aqbasket table
171 =item C<$authorizedby> is the username of who created the basket
175 The other parameters are optional, see ModBasketHeader for more info on them.
179 # FIXME : this function seems to be unused.
182 my ( $booksellerid, $authorisedby, $basketname, $basketnote, $basketbooksellernote, $basketcontractnumber ) = @_;
183 my $dbh = C4::Context->dbh;
186 (creationdate,booksellerid,authorisedby)
187 VALUES (now(),'$booksellerid','$authorisedby')
191 #find & return basketno MYSQL dependant, but $dbh->last_insert_id always returns null :-(
192 my $basket = $dbh->{'mysql_insertid'};
193 ModBasketHeader($basket, $basketname || '', $basketnote || '', $basketbooksellernote || '', $basketcontractnumber || undef);
197 #------------------------------------------------------------#
201 &CloseBasket($basketno);
203 close a basket (becomes unmodifiable,except for recieves)
209 my $dbh = C4::Context->dbh;
215 my $sth = $dbh->prepare($query);
216 $sth->execute($basketno);
219 #------------------------------------------------------------#
221 =head3 GetBasketAsCSV
223 &GetBasketAsCSV($basketno);
225 Export a basket as CSV
231 my $basket = GetBasket($basketno);
232 my @orders = GetOrders($basketno);
233 my $contract = GetContract($basket->{'contractnumber'});
234 my $csv = Text::CSV->new();
237 # TODO: Translate headers
238 my @headers = qw(contractname ordernumber entrydate isbn author title publishercode collectiontitle notes quantity rrp);
240 $csv->combine(@headers);
241 $output = $csv->string() . "\n";
244 foreach my $order (@orders) {
246 # newlines are not valid characters for Text::CSV combine()
247 $order->{'notes'} =~ s/[\r\n]+//g;
249 $contract->{'contractname'},
250 $order->{'ordernumber'},
251 $order->{'entrydate'},
255 $order->{'publishercode'},
256 $order->{'collectiontitle'},
258 $order->{'quantity'},
261 push (@rows, \@cols);
264 foreach my $row (@rows) {
265 $csv->combine(@$row);
266 $output .= $csv->string() . "\n";
275 =head3 CloseBasketgroup
277 &CloseBasketgroup($basketgroupno);
283 sub CloseBasketgroup {
284 my ($basketgroupno) = @_;
285 my $dbh = C4::Context->dbh;
286 my $sth = $dbh->prepare("
287 UPDATE aqbasketgroups
291 $sth->execute($basketgroupno);
294 #------------------------------------------------------------#
296 =head3 ReOpenBaskergroup($basketgroupno)
298 &ReOpenBaskergroup($basketgroupno);
304 sub ReOpenBasketgroup {
305 my ($basketgroupno) = @_;
306 my $dbh = C4::Context->dbh;
307 my $sth = $dbh->prepare("
308 UPDATE aqbasketgroups
312 $sth->execute($basketgroupno);
315 #------------------------------------------------------------#
320 &DelBasket($basketno);
322 Deletes the basket that has basketno field $basketno in the aqbasket table.
326 =item C<$basketno> is the primary key of the basket in the aqbasket table.
333 my ( $basketno ) = @_;
334 my $query = "DELETE FROM aqbasket WHERE basketno=?";
335 my $dbh = C4::Context->dbh;
336 my $sth = $dbh->prepare($query);
337 $sth->execute($basketno);
341 #------------------------------------------------------------#
345 &ModBasket($basketinfo);
347 Modifies a basket, using a hashref $basketinfo for the relevant information, only $basketinfo->{'basketno'} is required.
351 =item C<$basketno> is the primary key of the basket in the aqbasket table.
358 my $basketinfo = shift;
359 my $query = "UPDATE aqbasket SET ";
361 foreach my $key (keys %$basketinfo){
362 if ($key ne 'basketno'){
363 $query .= "$key=?, ";
364 push(@params, $basketinfo->{$key} || undef );
367 # get rid of the "," at the end of $query
368 if (substr($query, length($query)-2) eq ', '){
373 $query .= "WHERE basketno=?";
374 push(@params, $basketinfo->{'basketno'});
375 my $dbh = C4::Context->dbh;
376 my $sth = $dbh->prepare($query);
377 $sth->execute(@params);
381 #------------------------------------------------------------#
383 =head3 ModBasketHeader
385 &ModBasketHeader($basketno, $basketname, $note, $booksellernote, $contractnumber);
387 Modifies a basket's header.
391 =item C<$basketno> is the "basketno" field in the "aqbasket" table;
393 =item C<$basketname> is the "basketname" field in the "aqbasket" table;
395 =item C<$note> is the "note" field in the "aqbasket" table;
397 =item C<$booksellernote> is the "booksellernote" field in the "aqbasket" table;
399 =item C<$contractnumber> is the "contractnumber" (foreign) key in the "aqbasket" table.
405 sub ModBasketHeader {
406 my ($basketno, $basketname, $note, $booksellernote, $contractnumber) = @_;
407 my $query = "UPDATE aqbasket SET basketname=?, note=?, booksellernote=? WHERE basketno=?";
408 my $dbh = C4::Context->dbh;
409 my $sth = $dbh->prepare($query);
410 $sth->execute($basketname,$note,$booksellernote,$basketno);
411 if ( $contractnumber ) {
412 my $query2 ="UPDATE aqbasket SET contractnumber=? WHERE basketno=?";
413 my $sth2 = $dbh->prepare($query2);
414 $sth2->execute($contractnumber,$basketno);
420 #------------------------------------------------------------#
422 =head3 GetBasketsByBookseller
424 @results = &GetBasketsByBookseller($booksellerid, $extra);
426 Returns a list of hashes of all the baskets that belong to bookseller 'booksellerid'.
430 =item C<$booksellerid> is the 'id' field of the bookseller in the aqbooksellers table
432 =item C<$extra> is the extra sql parameters, can be
434 $extra->{groupby}: group baskets by column
435 ex. $extra->{groupby} = aqbasket.basketgroupid
436 $extra->{orderby}: order baskets by column
437 $extra->{limit}: limit number of results (can be helpful for pagination)
443 sub GetBasketsByBookseller {
444 my ($booksellerid, $extra) = @_;
445 my $query = "SELECT * FROM aqbasket WHERE booksellerid=?";
447 if ($extra->{groupby}) {
448 $query .= " GROUP by $extra->{groupby}";
450 if ($extra->{orderby}){
451 $query .= " ORDER by $extra->{orderby}";
453 if ($extra->{limit}){
454 $query .= " LIMIT $extra->{limit}";
457 my $dbh = C4::Context->dbh;
458 my $sth = $dbh->prepare($query);
459 $sth->execute($booksellerid);
460 my $results = $sth->fetchall_arrayref({});
465 #------------------------------------------------------------#
467 =head3 GetBasketsByBasketgroup
469 $baskets = &GetBasketsByBasketgroup($basketgroupid);
471 Returns a reference to all baskets that belong to basketgroup $basketgroupid.
475 sub GetBasketsByBasketgroup {
476 my $basketgroupid = shift;
477 my $query = "SELECT * FROM aqbasket
478 LEFT JOIN aqcontract USING(contractnumber) WHERE basketgroupid=?";
479 my $dbh = C4::Context->dbh;
480 my $sth = $dbh->prepare($query);
481 $sth->execute($basketgroupid);
482 my $results = $sth->fetchall_arrayref({});
487 #------------------------------------------------------------#
489 =head3 NewBasketgroup
491 $basketgroupid = NewBasketgroup(\%hashref);
493 Adds a basketgroup to the aqbasketgroups table, and add the initial baskets to it.
495 $hashref->{'booksellerid'} is the 'id' field of the bookseller in the aqbooksellers table,
497 $hashref->{'name'} is the 'name' field of the basketgroup in the aqbasketgroups table,
499 $hashref->{'basketlist'} is a list reference of the 'id's of the baskets that belong to this group,
501 $hashref->{'deliveryplace'} is the 'deliveryplace' field of the basketgroup in the aqbasketgroups table,
503 $hashref->{'deliverycomment'} is the 'deliverycomment' field of the basketgroup in the aqbasketgroups table,
505 $hashref->{'closed'} is the 'closed' field of the aqbasketgroups table, it is false if 0, true otherwise.
510 my $basketgroupinfo = shift;
511 die "booksellerid is required to create a basketgroup" unless $basketgroupinfo->{'booksellerid'};
512 my $query = "INSERT INTO aqbasketgroups (";
514 foreach my $field ('name', 'deliveryplace', 'deliverycomment', 'closed') {
515 if ( $basketgroupinfo->{$field} ) {
516 $query .= "$field, ";
517 push(@params, $basketgroupinfo->{$field});
520 $query .= "booksellerid) VALUES (";
525 push(@params, $basketgroupinfo->{'booksellerid'});
526 my $dbh = C4::Context->dbh;
527 my $sth = $dbh->prepare($query);
528 $sth->execute(@params);
529 my $basketgroupid = $dbh->{'mysql_insertid'};
530 if( $basketgroupinfo->{'basketlist'} ) {
531 foreach my $basketno (@{$basketgroupinfo->{'basketlist'}}) {
532 my $query2 = "UPDATE aqbasket SET basketgroupid=? WHERE basketno=?";
533 my $sth2 = $dbh->prepare($query2);
534 $sth2->execute($basketgroupid, $basketno);
537 return $basketgroupid;
540 #------------------------------------------------------------#
542 =head3 ModBasketgroup
544 ModBasketgroup(\%hashref);
546 Modifies a basketgroup in the aqbasketgroups table, and add the baskets to it.
548 $hashref->{'id'} is the 'id' field of the basketgroup in the aqbasketgroup table, this parameter is mandatory,
550 $hashref->{'name'} is the 'name' field of the basketgroup in the aqbasketgroups table,
552 $hashref->{'basketlist'} is a list reference of the 'id's of the baskets that belong to this group,
554 $hashref->{'billingplace'} is the 'billingplace' field of the basketgroup in the aqbasketgroups table,
556 $hashref->{'deliveryplace'} is the 'deliveryplace' field of the basketgroup in the aqbasketgroups table,
558 $hashref->{'deliverycomment'} is the 'deliverycomment' field of the basketgroup in the aqbasketgroups table,
560 $hashref->{'closed'} is the 'closed' field of the aqbasketgroups table, it is false if 0, true otherwise.
565 my $basketgroupinfo = shift;
566 die "basketgroup id is required to edit a basketgroup" unless $basketgroupinfo->{'id'};
567 my $dbh = C4::Context->dbh;
568 my $query = "UPDATE aqbasketgroups SET ";
570 foreach my $field (qw(name billingplace deliveryplace freedeliveryplace deliverycomment closed)) {
571 if ( defined $basketgroupinfo->{$field} ) {
572 $query .= "$field=?, ";
573 push(@params, $basketgroupinfo->{$field});
578 $query .= " WHERE id=?";
579 push(@params, $basketgroupinfo->{'id'});
580 my $sth = $dbh->prepare($query);
581 $sth->execute(@params);
583 $sth = $dbh->prepare('UPDATE aqbasket SET basketgroupid = NULL WHERE basketgroupid = ?');
584 $sth->execute($basketgroupinfo->{'id'});
586 if($basketgroupinfo->{'basketlist'} && @{$basketgroupinfo->{'basketlist'}}){
587 $sth = $dbh->prepare("UPDATE aqbasket SET basketgroupid=? WHERE basketno=?");
588 foreach my $basketno (@{$basketgroupinfo->{'basketlist'}}) {
589 $sth->execute($basketgroupinfo->{'id'}, $basketno);
596 #------------------------------------------------------------#
598 =head3 DelBasketgroup
600 DelBasketgroup($basketgroupid);
602 Deletes a basketgroup in the aqbasketgroups table, and removes the reference to it from the baskets,
606 =item C<$basketgroupid> is the 'id' field of the basket in the aqbasketgroup table
613 my $basketgroupid = shift;
614 die "basketgroup id is required to edit a basketgroup" unless $basketgroupid;
615 my $query = "DELETE FROM aqbasketgroups WHERE id=?";
616 my $dbh = C4::Context->dbh;
617 my $sth = $dbh->prepare($query);
618 $sth->execute($basketgroupid);
622 #------------------------------------------------------------#
625 =head2 FUNCTIONS ABOUT ORDERS
627 =head3 GetBasketgroup
629 $basketgroup = &GetBasketgroup($basketgroupid);
631 Returns a reference to the hash containing all infermation about the basketgroup.
636 my $basketgroupid = shift;
637 die "basketgroup id is required to edit a basketgroup" unless $basketgroupid;
638 my $query = "SELECT * FROM aqbasketgroups WHERE id=?";
639 my $dbh = C4::Context->dbh;
640 my $sth = $dbh->prepare($query);
641 $sth->execute($basketgroupid);
642 my $result = $sth->fetchrow_hashref;
647 #------------------------------------------------------------#
649 =head3 GetBasketgroups
651 $basketgroups = &GetBasketgroups($booksellerid);
653 Returns a reference to the array of all the basketgroups of bookseller $booksellerid.
657 sub GetBasketgroups {
658 my $booksellerid = shift;
659 die "bookseller id is required to edit a basketgroup" unless $booksellerid;
660 my $query = "SELECT * FROM aqbasketgroups WHERE booksellerid=? ORDER BY `id` DESC";
661 my $dbh = C4::Context->dbh;
662 my $sth = $dbh->prepare($query);
663 $sth->execute($booksellerid);
664 my $results = $sth->fetchall_arrayref({});
669 #------------------------------------------------------------#
671 =head2 FUNCTIONS ABOUT ORDERS
675 #------------------------------------------------------------#
677 =head3 GetPendingOrders
679 $orders = &GetPendingOrders($booksellerid, $grouped, $owner);
681 Finds pending orders from the bookseller with the given ID. Ignores
682 completed and cancelled orders.
684 C<$booksellerid> contains the bookseller identifier
685 C<$grouped> contains 0 or 1. 0 means returns the list, 1 means return the total
686 C<$owner> contains 0 or 1. 0 means any owner. 1 means only the list of orders entered by the user itself.
688 C<$orders> is a reference-to-array; each element is a
689 reference-to-hash with the following fields:
690 C<$grouped> is a boolean that, if set to 1 will group all order lines of the same basket
691 in a single result line
695 =item C<authorizedby>
703 These give the value of the corresponding field in the aqorders table
704 of the Koha database.
706 Results are ordered from most to least recent.
710 sub GetPendingOrders {
711 my ($supplierid,$grouped,$owner,$basketno) = @_;
712 my $dbh = C4::Context->dbh;
714 SELECT ".($grouped?"count(*),":"")."aqbasket.basketno,
715 surname,firstname,aqorders.*,biblio.*,biblioitems.isbn,
716 aqbasket.closedate, aqbasket.creationdate, aqbasket.basketname
718 LEFT JOIN aqbasket ON aqbasket.basketno=aqorders.basketno
719 LEFT JOIN borrowers ON aqbasket.authorisedby=borrowers.borrowernumber
720 LEFT JOIN biblio ON biblio.biblionumber=aqorders.biblionumber
721 LEFT JOIN biblioitems ON biblioitems.biblionumber=biblio.biblionumber
723 AND (quantity > quantityreceived OR quantityreceived is NULL)
724 AND datecancellationprinted IS NULL";
725 my @query_params = ( $supplierid );
726 my $userenv = C4::Context->userenv;
727 if ( C4::Context->preference("IndependantBranches") ) {
728 if ( ($userenv) && ( $userenv->{flags} != 1 ) ) {
729 $strsth .= " and (borrowers.branchcode = ?
730 or borrowers.branchcode = '')";
731 push @query_params, $userenv->{branch};
735 $strsth .= " AND aqbasket.authorisedby=? ";
736 push @query_params, $userenv->{'number'};
739 $strsth .= " AND aqbasket.basketno=? ";
740 push @query_params, $basketno;
742 $strsth .= " group by aqbasket.basketno" if $grouped;
743 $strsth .= " order by aqbasket.basketno";
745 my $sth = $dbh->prepare($strsth);
746 $sth->execute( @query_params );
747 my $results = $sth->fetchall_arrayref({});
752 #------------------------------------------------------------#
756 @orders = &GetOrders($basketnumber, $orderby);
758 Looks up the pending (non-cancelled) orders with the given basket
759 number. If C<$booksellerID> is non-empty, only orders from that seller
763 C<&basket> returns a two-element array. C<@orders> is an array of
764 references-to-hash, whose keys are the fields from the aqorders,
765 biblio, and biblioitems tables in the Koha database.
770 my ( $basketno, $orderby ) = @_;
771 my $dbh = C4::Context->dbh;
773 SELECT biblio.*,biblioitems.*,
778 LEFT JOIN aqbudgets ON aqbudgets.budget_id = aqorders.budget_id
779 LEFT JOIN biblio ON biblio.biblionumber = aqorders.biblionumber
780 LEFT JOIN biblioitems ON biblioitems.biblionumber =biblio.biblionumber
782 AND (datecancellationprinted IS NULL OR datecancellationprinted='0000-00-00')
785 $orderby = "biblioitems.publishercode,biblio.title" unless $orderby;
786 $query .= " ORDER BY $orderby";
787 my $sth = $dbh->prepare($query);
788 $sth->execute($basketno);
789 my $results = $sth->fetchall_arrayref({});
794 #------------------------------------------------------------#
796 =head3 GetOrderNumber
798 $ordernumber = &GetOrderNumber($biblioitemnumber, $biblionumber);
800 Looks up the ordernumber with the given biblionumber and biblioitemnumber.
802 Returns the number of this order.
806 =item C<$ordernumber> is the order number.
813 my ( $biblionumber,$biblioitemnumber ) = @_;
814 my $dbh = C4::Context->dbh;
819 AND biblioitemnumber=?
821 my $sth = $dbh->prepare($query);
822 $sth->execute( $biblionumber, $biblioitemnumber );
824 return $sth->fetchrow;
827 #------------------------------------------------------------#
831 $order = &GetOrder($ordernumber);
833 Looks up an order by order number.
835 Returns a reference-to-hash describing the order. The keys of
836 C<$order> are fields from the biblio, biblioitems, aqorders tables of the Koha database.
841 my ($ordernumber) = @_;
842 my $dbh = C4::Context->dbh;
844 SELECT biblioitems.*, biblio.*, aqorders.*
846 LEFT JOIN biblio on biblio.biblionumber=aqorders.biblionumber
847 LEFT JOIN biblioitems on biblioitems.biblionumber=aqorders.biblionumber
848 WHERE aqorders.ordernumber=?
851 my $sth= $dbh->prepare($query);
852 $sth->execute($ordernumber);
853 my $data = $sth->fetchrow_hashref;
858 #------------------------------------------------------------#
862 &NewOrder(\%hashref);
864 Adds a new order to the database. Any argument that isn't described
865 below is the new value of the field with the same name in the aqorders
866 table of the Koha database.
870 =item $hashref->{'basketno'} is the basketno foreign key in aqorders, it is mandatory
872 =item $hashref->{'ordernumber'} is a "minimum order number."
874 =item $hashref->{'budgetdate'} is effectively ignored.
875 If it's undef (anything false) or the string 'now', the current day is used.
876 Else, the upcoming July 1st is used.
878 =item $hashref->{'subscription'} may be either "yes", or anything else for "no".
880 =item $hashref->{'uncertainprice'} may be 0 for "the price is known" or 1 for "the price is uncertain"
882 =item defaults entrydate to Now
884 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".
891 my $orderinfo = shift;
892 #### ------------------------------
893 my $dbh = C4::Context->dbh;
897 # if these parameters are missing, we can't continue
898 for my $key (qw/basketno quantity biblionumber budget_id/) {
899 croak "Mandatory parameter $key missing" unless $orderinfo->{$key};
902 if ( defined $orderinfo->{subscription} && $orderinfo->{'subscription'} eq 'yes' ) {
903 $orderinfo->{'subscription'} = 1;
905 $orderinfo->{'subscription'} = 0;
907 $orderinfo->{'entrydate'} ||= C4::Dates->new()->output("iso");
908 if (!$orderinfo->{quantityreceived}) {
909 $orderinfo->{quantityreceived} = 0;
912 my $ordernumber=InsertInTable("aqorders",$orderinfo);
913 return ( $orderinfo->{'basketno'}, $ordernumber );
918 #------------------------------------------------------------#
927 #my ($biblioitemnumber,$ordernumber, $biblionumber) = @_;
928 my ($itemnumber, $ordernumber) = @_;
929 my $dbh = C4::Context->dbh;
931 INSERT INTO aqorders_items
932 (itemnumber, ordernumber)
935 my $sth = $dbh->prepare($query);
936 $sth->execute( $itemnumber, $ordernumber);
939 #------------------------------------------------------------#
943 &ModOrder(\%hashref);
945 Modifies an existing order. Updates the order with order number
946 $hashref->{'ordernumber'} and biblionumber $hashref->{'biblionumber'}. All
947 other keys of the hash update the fields with the same name in the aqorders
948 table of the Koha database.
953 my $orderinfo = shift;
955 die "Ordernumber is required" if $orderinfo->{'ordernumber'} eq '' ;
956 die "Biblionumber is required" if $orderinfo->{'biblionumber'} eq '';
958 my $dbh = C4::Context->dbh;
961 # update uncertainprice to an integer, just in case (under FF, checked boxes have the value "ON" by default)
962 $orderinfo->{uncertainprice}=1 if $orderinfo->{uncertainprice};
964 # delete($orderinfo->{'branchcode'});
965 # the hash contains a lot of entries not in aqorders, so get the columns ...
966 my $sth = $dbh->prepare("SELECT * FROM aqorders LIMIT 1;");
968 my $colnames = $sth->{NAME};
969 my $query = "UPDATE aqorders SET ";
971 foreach my $orderinfokey (grep(!/ordernumber/, keys %$orderinfo)){
972 # ... and skip hash entries that are not in the aqorders table
973 # FIXME : probably not the best way to do it (would be better to have a correct hash)
974 next unless grep(/^$orderinfokey$/, @$colnames);
975 $query .= "$orderinfokey=?, ";
976 push(@params, $orderinfo->{$orderinfokey});
979 $query .= "timestamp=NOW() WHERE ordernumber=?";
980 # push(@params, $specorderinfo{'ordernumber'});
981 push(@params, $orderinfo->{'ordernumber'} );
982 $sth = $dbh->prepare($query);
983 $sth->execute(@params);
987 #------------------------------------------------------------#
991 &ModOrderItem(\%hashref);
993 Modifies the itemnumber in the aqorders_items table. The input hash needs three entities:
997 =item - itemnumber: the old itemnumber
998 =item - ordernumber: the order this item is attached to
999 =item - newitemnumber: the new itemnumber we want to attach the line to
1006 my $orderiteminfo = shift;
1007 if (! $orderiteminfo->{'ordernumber'} || ! $orderiteminfo->{'itemnumber'} || ! $orderiteminfo->{'newitemnumber'}){
1008 die "Ordernumber, itemnumber and newitemnumber is required";
1011 my $dbh = C4::Context->dbh;
1013 my $query = "UPDATE aqorders_items set itemnumber=? where itemnumber=? and ordernumber=?";
1014 my @params = ($orderiteminfo->{'newitemnumber'}, $orderiteminfo->{'itemnumber'}, $orderiteminfo->{'ordernumber'});
1015 my $sth = $dbh->prepare($query);
1016 $sth->execute(@params);
1020 #------------------------------------------------------------#
1023 =head3 ModOrderBibliotemNumber
1025 &ModOrderBiblioitemNumber($biblioitemnumber,$ordernumber, $biblionumber);
1027 Modifies the biblioitemnumber for an existing order.
1028 Updates the order with order number C<$ordernum> and biblionumber C<$biblionumber>.
1032 #FIXME: is this used at all?
1033 sub ModOrderBiblioitemNumber {
1034 my ($biblioitemnumber,$ordernumber, $biblionumber) = @_;
1035 my $dbh = C4::Context->dbh;
1038 SET biblioitemnumber = ?
1039 WHERE ordernumber = ?
1040 AND biblionumber = ?";
1041 my $sth = $dbh->prepare($query);
1042 $sth->execute( $biblioitemnumber, $ordernumber, $biblionumber );
1045 =head3 GetCancelledOrders
1047 my @orders = GetCancelledOrders($basketno, $orderby);
1049 Returns cancelled orders for a basket
1053 sub GetCancelledOrders {
1054 my ( $basketno, $orderby ) = @_;
1056 return () unless $basketno;
1058 my $dbh = C4::Context->dbh;
1060 SELECT biblio.*, biblioitems.*, aqorders.*, aqbudgets.*
1062 LEFT JOIN aqbudgets ON aqbudgets.budget_id = aqorders.budget_id
1063 LEFT JOIN biblio ON biblio.biblionumber = aqorders.biblionumber
1064 LEFT JOIN biblioitems ON biblioitems.biblionumber = biblio.biblionumber
1066 AND (datecancellationprinted IS NOT NULL
1067 AND datecancellationprinted <> '0000-00-00')
1070 $orderby = "aqorders.datecancellationprinted desc, aqorders.timestamp desc"
1072 $query .= " ORDER BY $orderby";
1073 my $sth = $dbh->prepare($query);
1074 $sth->execute($basketno);
1075 my $results = $sth->fetchall_arrayref( {} );
1081 #------------------------------------------------------------#
1083 =head3 ModReceiveOrder
1085 &ModReceiveOrder($biblionumber, $ordernumber, $quantityreceived, $user,
1086 $unitprice, $booksellerinvoicenumber, $biblioitemnumber,
1087 $freight, $bookfund, $rrp);
1089 Updates an order, to reflect the fact that it was received, at least
1090 in part. All arguments not mentioned below update the fields with the
1091 same name in the aqorders table of the Koha database.
1093 If a partial order is received, splits the order into two. The received
1094 portion must have a booksellerinvoicenumber.
1096 Updates the order with bibilionumber C<$biblionumber> and ordernumber
1102 sub ModReceiveOrder {
1104 $biblionumber, $ordernumber, $quantrec, $user, $cost,
1105 $invoiceno, $freight, $rrp, $budget_id, $datereceived
1108 my $dbh = C4::Context->dbh;
1109 # warn "DATE BEFORE : $daterecieved";
1110 # $daterecieved=POSIX::strftime("%Y-%m-%d",CORE::localtime) unless $daterecieved;
1111 # warn "DATE REC : $daterecieved";
1112 $datereceived = C4::Dates->output('iso') unless $datereceived;
1113 my $suggestionid = GetSuggestionFromBiblionumber( $dbh, $biblionumber );
1114 if ($suggestionid) {
1115 ModSuggestion( {suggestionid=>$suggestionid,
1116 STATUS=>'AVAILABLE',
1117 biblionumber=> $biblionumber}
1121 my $sth=$dbh->prepare("
1122 SELECT * FROM aqorders
1123 WHERE biblionumber=? AND aqorders.ordernumber=?");
1125 $sth->execute($biblionumber,$ordernumber);
1126 my $order = $sth->fetchrow_hashref();
1129 if ( $order->{quantity} > $quantrec ) {
1130 $sth=$dbh->prepare("
1132 SET quantityreceived=?
1134 , booksellerinvoicenumber=?
1139 WHERE biblionumber=? AND ordernumber=?");
1141 $sth->execute($quantrec,$datereceived,$invoiceno,$cost,$freight,$rrp,$quantrec,$biblionumber,$ordernumber);
1144 # create a new order for the remaining items, and set its bookfund.
1145 foreach my $orderkey ( "linenumber", "allocation" ) {
1146 delete($order->{'$orderkey'});
1148 $order->{'quantity'} -= $quantrec;
1149 $order->{'quantityreceived'} = 0;
1150 my $newOrder = NewOrder($order);
1152 $sth=$dbh->prepare("update aqorders
1153 set quantityreceived=?,datereceived=?,booksellerinvoicenumber=?,
1154 unitprice=?,freight=?,rrp=?
1155 where biblionumber=? and ordernumber=?");
1156 $sth->execute($quantrec,$datereceived,$invoiceno,$cost,$freight,$rrp,$biblionumber,$ordernumber);
1159 return $datereceived;
1161 #------------------------------------------------------------#
1165 @results = &SearchOrder($search, $biblionumber, $complete);
1167 Searches for orders.
1169 C<$search> may take one of several forms: if it is an ISBN,
1170 C<&ordersearch> returns orders with that ISBN. If C<$search> is an
1171 order number, C<&ordersearch> returns orders with that order number
1172 and biblionumber C<$biblionumber>. Otherwise, C<$search> is considered
1173 to be a space-separated list of search terms; in this case, all of the
1174 terms must appear in the title (matching the beginning of title
1177 If C<$complete> is C<yes>, the results will include only completed
1178 orders. In any case, C<&ordersearch> ignores cancelled orders.
1180 C<&ordersearch> returns an array.
1181 C<@results> is an array of references-to-hash with the following keys:
1187 =item C<seriestitle>
1198 #### -------- SearchOrder-------------------------------
1199 my ($ordernumber, $search, $supplierid, $basket) = @_;
1201 my $dbh = C4::Context->dbh;
1206 LEFT JOIN biblio ON aqorders.biblionumber=biblio.biblionumber
1207 LEFT JOIN biblioitems ON biblioitems.biblionumber=biblio.biblionumber
1208 LEFT JOIN aqbasket ON aqorders.basketno = aqbasket.basketno
1209 WHERE (datecancellationprinted is NULL)";
1212 $query .= " AND (aqorders.ordernumber=?)";
1213 push @args, $ordernumber;
1216 $query .= " AND (biblio.title like ? OR biblio.author LIKE ? OR biblioitems.isbn like ?)";
1217 push @args, ("%$search%","%$search%","%$search%");
1220 $query .= "AND aqbasket.booksellerid = ?";
1221 push @args, $supplierid;
1224 $query .= "AND aqorders.basketno = ?";
1225 push @args, $basket;
1228 my $sth = $dbh->prepare($query);
1229 $sth->execute(@args);
1230 my $results = $sth->fetchall_arrayref({});
1235 #------------------------------------------------------------#
1239 &DelOrder($biblionumber, $ordernumber);
1241 Cancel the order with the given order and biblio numbers. It does not
1242 delete any entries in the aqorders table, it merely marks them as
1248 my ( $bibnum, $ordernumber ) = @_;
1249 my $dbh = C4::Context->dbh;
1252 SET datecancellationprinted=now()
1253 WHERE biblionumber=? AND ordernumber=?
1255 my $sth = $dbh->prepare($query);
1256 $sth->execute( $bibnum, $ordernumber );
1258 my @itemnumbers = GetItemnumbersFromOrder( $ordernumber );
1259 foreach my $itemnumber (@itemnumbers){
1260 C4::Items::DelItem( $dbh, $bibnum, $itemnumber );
1265 =head2 FUNCTIONS ABOUT PARCELS
1269 #------------------------------------------------------------#
1273 @results = &GetParcel($booksellerid, $code, $date);
1275 Looks up all of the received items from the supplier with the given
1276 bookseller ID at the given date, for the given code (bookseller Invoice number). Ignores cancelled and completed orders.
1278 C<@results> is an array of references-to-hash. The keys of each element are fields from
1279 the aqorders, biblio, and biblioitems tables of the Koha database.
1281 C<@results> is sorted alphabetically by book title.
1286 #gets all orders from a certain supplier, orders them alphabetically
1287 my ( $supplierid, $code, $datereceived ) = @_;
1288 my $dbh = C4::Context->dbh;
1291 if $code; # add % if we search on a given code (otherwise, let him empty)
1293 SELECT authorisedby,
1298 aqorders.biblionumber,
1299 aqorders.ordernumber,
1301 aqorders.quantityreceived,
1308 LEFT JOIN aqbasket ON aqbasket.basketno=aqorders.basketno
1309 LEFT JOIN borrowers ON aqbasket.authorisedby=borrowers.borrowernumber
1310 LEFT JOIN biblio ON aqorders.biblionumber=biblio.biblionumber
1312 aqbasket.booksellerid = ?
1313 AND aqorders.booksellerinvoicenumber LIKE ?
1314 AND aqorders.datereceived = ? ";
1316 my @query_params = ( $supplierid, $code, $datereceived );
1317 if ( C4::Context->preference("IndependantBranches") ) {
1318 my $userenv = C4::Context->userenv;
1319 if ( ($userenv) && ( $userenv->{flags} != 1 ) ) {
1320 $strsth .= " and (borrowers.branchcode = ?
1321 or borrowers.branchcode = '')";
1322 push @query_params, $userenv->{branch};
1325 $strsth .= " ORDER BY aqbasket.basketno";
1326 # ## parcelinformation : $strsth
1327 my $sth = $dbh->prepare($strsth);
1328 $sth->execute( @query_params );
1329 while ( my $data = $sth->fetchrow_hashref ) {
1330 push( @results, $data );
1332 # ## countparcelbiblio: scalar(@results)
1338 #------------------------------------------------------------#
1342 $results = &GetParcels($bookseller, $order, $code, $datefrom, $dateto);
1344 get a lists of parcels.
1351 is the bookseller this function has to get parcels.
1354 To know on what criteria the results list has to be ordered.
1357 is the booksellerinvoicenumber.
1359 =item $datefrom & $dateto
1360 to know on what date this function has to filter its search.
1365 a pointer on a hash list containing parcel informations as such :
1371 =item Last operation
1373 =item Number of biblio
1375 =item Number of items
1382 my ($bookseller,$order, $code, $datefrom, $dateto) = @_;
1383 my $dbh = C4::Context->dbh;
1384 my @query_params = ();
1386 SELECT aqorders.booksellerinvoicenumber,
1387 datereceived,purchaseordernumber,
1388 count(DISTINCT biblionumber) AS biblio,
1389 sum(quantity) AS itemsexpected,
1390 sum(quantityreceived) AS itemsreceived
1391 FROM aqorders LEFT JOIN aqbasket ON aqbasket.basketno = aqorders.basketno
1392 WHERE aqbasket.booksellerid = ? and datereceived IS NOT NULL
1394 push @query_params, $bookseller;
1396 if ( defined $code ) {
1397 $strsth .= ' and aqorders.booksellerinvoicenumber like ? ';
1398 # add a % to the end of the code to allow stemming.
1399 push @query_params, "$code%";
1402 if ( defined $datefrom ) {
1403 $strsth .= ' and datereceived >= ? ';
1404 push @query_params, $datefrom;
1407 if ( defined $dateto ) {
1408 $strsth .= 'and datereceived <= ? ';
1409 push @query_params, $dateto;
1412 $strsth .= "group by aqorders.booksellerinvoicenumber,datereceived ";
1414 # can't use a placeholder to place this column name.
1415 # but, we could probably be checking to make sure it is a column that will be fetched.
1416 $strsth .= "order by $order " if ($order);
1418 my $sth = $dbh->prepare($strsth);
1420 $sth->execute( @query_params );
1421 my $results = $sth->fetchall_arrayref({});
1426 #------------------------------------------------------------#
1428 =head3 GetLateOrders
1430 @results = &GetLateOrders;
1432 Searches for bookseller with late orders.
1435 the table of supplier with late issues. This table is full of hashref.
1441 my $supplierid = shift;
1444 my $dbh = C4::Context->dbh;
1446 #BEWARE, order of parenthesis and LEFT JOIN is important for speed
1447 my $dbdriver = C4::Context->config("db_scheme") || "mysql";
1449 my @query_params = ($delay); # delay is the first argument regardless
1451 SELECT aqbasket.basketno,
1452 aqorders.ordernumber,
1453 DATE(aqbasket.closedate) AS orderdate,
1454 aqorders.rrp AS unitpricesupplier,
1455 aqorders.ecost AS unitpricelib,
1456 aqbudgets.budget_name AS budget,
1457 borrowers.branchcode AS branch,
1458 aqbooksellers.name AS supplier,
1459 biblio.author, biblio.title,
1460 biblioitems.publishercode AS publisher,
1461 biblioitems.publicationyear,
1465 aqorders LEFT JOIN biblio ON biblio.biblionumber = aqorders.biblionumber
1466 LEFT JOIN biblioitems ON biblioitems.biblionumber = biblio.biblionumber
1467 LEFT JOIN aqbudgets ON aqorders.budget_id = aqbudgets.budget_id,
1468 aqbasket LEFT JOIN borrowers ON aqbasket.authorisedby = borrowers.borrowernumber
1469 LEFT JOIN aqbooksellers ON aqbasket.booksellerid = aqbooksellers.id
1470 WHERE aqorders.basketno = aqbasket.basketno
1471 AND ( datereceived = ''
1472 OR datereceived IS NULL
1473 OR aqorders.quantityreceived < aqorders.quantity
1475 AND (aqorders.datecancellationprinted IS NULL OR aqorders.datecancellationprinted='0000-00-00')
1478 if ($dbdriver eq "mysql") {
1480 aqorders.quantity - IFNULL(aqorders.quantityreceived,0) AS quantity,
1481 (aqorders.quantity - IFNULL(aqorders.quantityreceived,0)) * aqorders.rrp AS subtotal,
1482 DATEDIFF(CURDATE( ),closedate) AS latesince
1484 $from .= " AND (closedate <= DATE_SUB(CURDATE( ),INTERVAL ? DAY)) ";
1486 HAVING quantity <> 0
1487 AND unitpricesupplier <> 0
1488 AND unitpricelib <> 0
1491 # FIXME: account for IFNULL as above
1493 aqorders.quantity AS quantity,
1494 aqorders.quantity * aqorders.rrp AS subtotal,
1495 (CURDATE - closedate) AS latesince
1497 $from .= " AND (closedate <= (CURDATE -(INTERVAL ? DAY)) ";
1499 if (defined $supplierid) {
1500 $from .= ' AND aqbasket.booksellerid = ? ';
1501 push @query_params, $supplierid;
1503 if (defined $branch) {
1504 $from .= ' AND borrowers.branchcode LIKE ? ';
1505 push @query_params, $branch;
1507 if (C4::Context->preference("IndependantBranches")
1508 && C4::Context->userenv
1509 && C4::Context->userenv->{flags} != 1 ) {
1510 $from .= ' AND borrowers.branchcode LIKE ? ';
1511 push @query_params, C4::Context->userenv->{branch};
1513 my $query = "$select $from $having\nORDER BY latesince, basketno, borrowers.branchcode, supplier";
1514 $debug and print STDERR "GetLateOrders query: $query\nGetLateOrders args: " . join(" ",@query_params);
1515 my $sth = $dbh->prepare($query);
1516 $sth->execute(@query_params);
1518 while (my $data = $sth->fetchrow_hashref) {
1519 $data->{orderdate} = format_date($data->{orderdate});
1520 push @results, $data;
1525 #------------------------------------------------------------#
1529 (\@order_loop, $total_qty, $total_price, $total_qtyreceived) = GetHistory( %params );
1531 Retreives some acquisition history information
1539 basket - search both basket name and number
1540 booksellerinvoicenumber
1543 $order_loop is a list of hashrefs that each look like this:
1545 'author' => 'Twain, Mark',
1547 'biblionumber' => '215',
1549 'creationdate' => 'MM/DD/YYYY',
1550 'datereceived' => undef,
1553 'invoicenumber' => undef,
1555 'ordernumber' => '1',
1557 'quantityreceived' => undef,
1558 'title' => 'The Adventures of Huckleberry Finn'
1560 $total_qty is the sum of all of the quantities in $order_loop
1561 $total_price is the cost of each in $order_loop times the quantity
1562 $total_qtyreceived is the sum of all of the quantityreceived entries in $order_loop
1567 # don't run the query if there are no parameters (list would be too long for sure !)
1568 croak "No search params" unless @_;
1570 my $title = $params{title};
1571 my $author = $params{author};
1572 my $isbn = $params{isbn};
1573 my $name = $params{name};
1574 my $from_placed_on = $params{from_placed_on};
1575 my $to_placed_on = $params{to_placed_on};
1576 my $basket = $params{basket};
1577 my $booksellerinvoicenumber = $params{booksellerinvoicenumber};
1581 my $total_qtyreceived = 0;
1582 my $total_price = 0;
1584 my $dbh = C4::Context->dbh;
1591 aqbasket.basketname,
1592 aqbasket.basketgroupid,
1593 aqbasketgroups.name as groupname,
1595 aqbasket.creationdate,
1596 aqorders.datereceived,
1598 aqorders.quantityreceived,
1600 aqorders.ordernumber,
1601 aqorders.booksellerinvoicenumber as invoicenumber,
1602 aqbooksellers.id as id,
1603 aqorders.biblionumber
1605 LEFT JOIN aqbasket ON aqorders.basketno=aqbasket.basketno
1606 LEFT JOIN aqbasketgroups ON aqbasket.basketgroupid=aqbasketgroups.id
1607 LEFT JOIN aqbooksellers ON aqbasket.booksellerid=aqbooksellers.id
1608 LEFT JOIN biblioitems ON biblioitems.biblionumber=aqorders.biblionumber
1609 LEFT JOIN biblio ON biblio.biblionumber=aqorders.biblionumber";
1611 $query .= " LEFT JOIN borrowers ON aqbasket.authorisedby=borrowers.borrowernumber"
1612 if ( C4::Context->preference("IndependantBranches") );
1614 $query .= " WHERE (datecancellationprinted is NULL or datecancellationprinted='0000-00-00') ";
1616 my @query_params = ();
1619 $query .= " AND biblio.title LIKE ? ";
1620 $title =~ s/\s+/%/g;
1621 push @query_params, "%$title%";
1625 $query .= " AND biblio.author LIKE ? ";
1626 push @query_params, "%$author%";
1630 $query .= " AND biblioitems.isbn LIKE ? ";
1631 push @query_params, "%$isbn%";
1635 $query .= " AND aqbooksellers.name LIKE ? ";
1636 push @query_params, "%$name%";
1639 if ( $from_placed_on ) {
1640 $query .= " AND creationdate >= ? ";
1641 push @query_params, $from_placed_on;
1644 if ( $to_placed_on ) {
1645 $query .= " AND creationdate <= ? ";
1646 push @query_params, $to_placed_on;
1650 if ($basket =~ m/^\d+$/) {
1651 $query .= " AND aqorders.basketno = ? ";
1652 push @query_params, $basket;
1654 $query .= " AND aqbasket.basketname LIKE ? ";
1655 push @query_params, "%$basket%";
1659 if ($booksellerinvoicenumber) {
1660 $query .= " AND (aqorders.booksellerinvoicenumber LIKE ? OR aqbasket.booksellerinvoicenumber LIKE ?)";
1661 push @query_params, "%$booksellerinvoicenumber%", "%$booksellerinvoicenumber%";
1664 if ( C4::Context->preference("IndependantBranches") ) {
1665 my $userenv = C4::Context->userenv;
1666 if ( $userenv && ($userenv->{flags} || 0) != 1 ) {
1667 $query .= " AND (borrowers.branchcode = ? OR borrowers.branchcode ='' ) ";
1668 push @query_params, $userenv->{branch};
1671 $query .= " ORDER BY id";
1672 my $sth = $dbh->prepare($query);
1673 $sth->execute( @query_params );
1675 while ( my $line = $sth->fetchrow_hashref ) {
1676 $line->{count} = $cnt++;
1677 $line->{toggle} = 1 if $cnt % 2;
1678 push @order_loop, $line;
1679 $line->{creationdate} = format_date( $line->{creationdate} );
1680 $line->{datereceived} = format_date( $line->{datereceived} );
1681 $total_qty += $line->{'quantity'};
1682 $total_qtyreceived += $line->{'quantityreceived'};
1683 $total_price += $line->{'quantity'} * $line->{'ecost'};
1685 return \@order_loop, $total_qty, $total_price, $total_qtyreceived;
1688 =head2 GetRecentAcqui
1690 $results = GetRecentAcqui($days);
1692 C<$results> is a ref to a table which containts hashref
1696 sub GetRecentAcqui {
1698 my $dbh = C4::Context->dbh;
1702 ORDER BY timestamp DESC
1705 my $sth = $dbh->prepare($query);
1707 my $results = $sth->fetchall_arrayref({});
1713 $contractlist = &GetContracts($booksellerid, $activeonly);
1715 Looks up the contracts that belong to a bookseller
1717 Returns a list of contracts
1721 =item C<$booksellerid> is the "id" field in the "aqbooksellers" table.
1723 =item C<$activeonly> if exists get only contracts that are still active.
1730 my ( $booksellerid, $activeonly ) = @_;
1731 my $dbh = C4::Context->dbh;
1733 if (! $activeonly) {
1737 WHERE booksellerid=?
1742 WHERE booksellerid=?
1743 AND contractenddate >= CURDATE( )";
1745 my $sth = $dbh->prepare($query);
1746 $sth->execute( $booksellerid );
1748 while (my $data = $sth->fetchrow_hashref ) {
1749 push(@results, $data);
1755 #------------------------------------------------------------#
1759 $contract = &GetContract($contractID);
1761 Looks up the contract that has PRIMKEY (contractnumber) value $contractID
1768 my ( $contractno ) = @_;
1769 my $dbh = C4::Context->dbh;
1773 WHERE contractnumber=?
1776 my $sth = $dbh->prepare($query);
1777 $sth->execute( $contractno );
1778 my $result = $sth->fetchrow_hashref;
1787 Koha Development Team <http://koha-community.org/>