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) {
245 $contract->{'contractname'},
246 $order->{'ordernumber'},
247 $order->{'entrydate'},
251 $order->{'publishercode'},
252 $order->{'collectiontitle'},
254 $order->{'quantity'},
257 push (@rows, \@cols);
260 foreach my $row (@rows) {
261 $csv->combine(@$row);
262 $output .= $csv->string() . "\n";
271 =head3 CloseBasketgroup
273 &CloseBasketgroup($basketgroupno);
279 sub CloseBasketgroup {
280 my ($basketgroupno) = @_;
281 my $dbh = C4::Context->dbh;
282 my $sth = $dbh->prepare("
283 UPDATE aqbasketgroups
287 $sth->execute($basketgroupno);
290 #------------------------------------------------------------#
292 =head3 ReOpenBaskergroup($basketgroupno)
294 &ReOpenBaskergroup($basketgroupno);
300 sub ReOpenBasketgroup {
301 my ($basketgroupno) = @_;
302 my $dbh = C4::Context->dbh;
303 my $sth = $dbh->prepare("
304 UPDATE aqbasketgroups
308 $sth->execute($basketgroupno);
311 #------------------------------------------------------------#
316 &DelBasket($basketno);
318 Deletes the basket that has basketno field $basketno in the aqbasket table.
322 =item C<$basketno> is the primary key of the basket in the aqbasket table.
329 my ( $basketno ) = @_;
330 my $query = "DELETE FROM aqbasket WHERE basketno=?";
331 my $dbh = C4::Context->dbh;
332 my $sth = $dbh->prepare($query);
333 $sth->execute($basketno);
337 #------------------------------------------------------------#
341 &ModBasket($basketinfo);
343 Modifies a basket, using a hashref $basketinfo for the relevant information, only $basketinfo->{'basketno'} is required.
347 =item C<$basketno> is the primary key of the basket in the aqbasket table.
354 my $basketinfo = shift;
355 my $query = "UPDATE aqbasket SET ";
357 foreach my $key (keys %$basketinfo){
358 if ($key ne 'basketno'){
359 $query .= "$key=?, ";
360 push(@params, $basketinfo->{$key} || undef );
363 # get rid of the "," at the end of $query
364 if (substr($query, length($query)-2) eq ', '){
369 $query .= "WHERE basketno=?";
370 push(@params, $basketinfo->{'basketno'});
371 my $dbh = C4::Context->dbh;
372 my $sth = $dbh->prepare($query);
373 $sth->execute(@params);
377 #------------------------------------------------------------#
379 =head3 ModBasketHeader
381 &ModBasketHeader($basketno, $basketname, $note, $booksellernote, $contractnumber);
383 Modifies a basket's header.
387 =item C<$basketno> is the "basketno" field in the "aqbasket" table;
389 =item C<$basketname> is the "basketname" field in the "aqbasket" table;
391 =item C<$note> is the "note" field in the "aqbasket" table;
393 =item C<$booksellernote> is the "booksellernote" field in the "aqbasket" table;
395 =item C<$contractnumber> is the "contractnumber" (foreign) key in the "aqbasket" table.
401 sub ModBasketHeader {
402 my ($basketno, $basketname, $note, $booksellernote, $contractnumber) = @_;
403 my $query = "UPDATE aqbasket SET basketname=?, note=?, booksellernote=? WHERE basketno=?";
404 my $dbh = C4::Context->dbh;
405 my $sth = $dbh->prepare($query);
406 $sth->execute($basketname,$note,$booksellernote,$basketno);
407 if ( $contractnumber ) {
408 my $query2 ="UPDATE aqbasket SET contractnumber=? WHERE basketno=?";
409 my $sth2 = $dbh->prepare($query2);
410 $sth2->execute($contractnumber,$basketno);
416 #------------------------------------------------------------#
418 =head3 GetBasketsByBookseller
420 @results = &GetBasketsByBookseller($booksellerid, $extra);
422 Returns a list of hashes of all the baskets that belong to bookseller 'booksellerid'.
426 =item C<$booksellerid> is the 'id' field of the bookseller in the aqbooksellers table
428 =item C<$extra> is the extra sql parameters, can be
430 $extra->{groupby}: group baskets by column
431 ex. $extra->{groupby} = aqbasket.basketgroupid
432 $extra->{orderby}: order baskets by column
433 $extra->{limit}: limit number of results (can be helpful for pagination)
439 sub GetBasketsByBookseller {
440 my ($booksellerid, $extra) = @_;
441 my $query = "SELECT * FROM aqbasket WHERE booksellerid=?";
443 if ($extra->{groupby}) {
444 $query .= " GROUP by $extra->{groupby}";
446 if ($extra->{orderby}){
447 $query .= " ORDER by $extra->{orderby}";
449 if ($extra->{limit}){
450 $query .= " LIMIT $extra->{limit}";
453 my $dbh = C4::Context->dbh;
454 my $sth = $dbh->prepare($query);
455 $sth->execute($booksellerid);
456 my $results = $sth->fetchall_arrayref({});
461 #------------------------------------------------------------#
463 =head3 GetBasketsByBasketgroup
465 $baskets = &GetBasketsByBasketgroup($basketgroupid);
467 Returns a reference to all baskets that belong to basketgroup $basketgroupid.
471 sub GetBasketsByBasketgroup {
472 my $basketgroupid = shift;
473 my $query = "SELECT * FROM aqbasket
474 LEFT JOIN aqcontract USING(contractnumber) WHERE basketgroupid=?";
475 my $dbh = C4::Context->dbh;
476 my $sth = $dbh->prepare($query);
477 $sth->execute($basketgroupid);
478 my $results = $sth->fetchall_arrayref({});
483 #------------------------------------------------------------#
485 =head3 NewBasketgroup
487 $basketgroupid = NewBasketgroup(\%hashref);
489 Adds a basketgroup to the aqbasketgroups table, and add the initial baskets to it.
491 $hashref->{'booksellerid'} is the 'id' field of the bookseller in the aqbooksellers table,
493 $hashref->{'name'} is the 'name' field of the basketgroup in the aqbasketgroups table,
495 $hashref->{'basketlist'} is a list reference of the 'id's of the baskets that belong to this group,
497 $hashref->{'deliveryplace'} is the 'deliveryplace' field of the basketgroup in the aqbasketgroups table,
499 $hashref->{'deliverycomment'} is the 'deliverycomment' field of the basketgroup in the aqbasketgroups table,
501 $hashref->{'closed'} is the 'closed' field of the aqbasketgroups table, it is false if 0, true otherwise.
506 my $basketgroupinfo = shift;
507 die "booksellerid is required to create a basketgroup" unless $basketgroupinfo->{'booksellerid'};
508 my $query = "INSERT INTO aqbasketgroups (";
510 foreach my $field ('name', 'deliveryplace', 'deliverycomment', 'closed') {
511 if ( $basketgroupinfo->{$field} ) {
512 $query .= "$field, ";
513 push(@params, $basketgroupinfo->{$field});
516 $query .= "booksellerid) VALUES (";
521 push(@params, $basketgroupinfo->{'booksellerid'});
522 my $dbh = C4::Context->dbh;
523 my $sth = $dbh->prepare($query);
524 $sth->execute(@params);
525 my $basketgroupid = $dbh->{'mysql_insertid'};
526 if( $basketgroupinfo->{'basketlist'} ) {
527 foreach my $basketno (@{$basketgroupinfo->{'basketlist'}}) {
528 my $query2 = "UPDATE aqbasket SET basketgroupid=? WHERE basketno=?";
529 my $sth2 = $dbh->prepare($query2);
530 $sth2->execute($basketgroupid, $basketno);
533 return $basketgroupid;
536 #------------------------------------------------------------#
538 =head3 ModBasketgroup
540 ModBasketgroup(\%hashref);
542 Modifies a basketgroup in the aqbasketgroups table, and add the baskets to it.
544 $hashref->{'id'} is the 'id' field of the basketgroup in the aqbasketgroup table, this parameter is mandatory,
546 $hashref->{'name'} is the 'name' field of the basketgroup in the aqbasketgroups table,
548 $hashref->{'basketlist'} is a list reference of the 'id's of the baskets that belong to this group,
550 $hashref->{'billingplace'} is the 'billingplace' field of the basketgroup in the aqbasketgroups table,
552 $hashref->{'deliveryplace'} is the 'deliveryplace' field of the basketgroup in the aqbasketgroups table,
554 $hashref->{'deliverycomment'} is the 'deliverycomment' field of the basketgroup in the aqbasketgroups table,
556 $hashref->{'closed'} is the 'closed' field of the aqbasketgroups table, it is false if 0, true otherwise.
561 my $basketgroupinfo = shift;
562 die "basketgroup id is required to edit a basketgroup" unless $basketgroupinfo->{'id'};
563 my $dbh = C4::Context->dbh;
564 my $query = "UPDATE aqbasketgroups SET ";
566 foreach my $field (qw(name billingplace deliveryplace freedeliveryplace deliverycomment closed)) {
567 if ( defined $basketgroupinfo->{$field} ) {
568 $query .= "$field=?, ";
569 push(@params, $basketgroupinfo->{$field});
574 $query .= " WHERE id=?";
575 push(@params, $basketgroupinfo->{'id'});
576 my $sth = $dbh->prepare($query);
577 $sth->execute(@params);
579 $sth = $dbh->prepare('UPDATE aqbasket SET basketgroupid = NULL WHERE basketgroupid = ?');
580 $sth->execute($basketgroupinfo->{'id'});
582 if($basketgroupinfo->{'basketlist'} && @{$basketgroupinfo->{'basketlist'}}){
583 $sth = $dbh->prepare("UPDATE aqbasket SET basketgroupid=? WHERE basketno=?");
584 foreach my $basketno (@{$basketgroupinfo->{'basketlist'}}) {
585 $sth->execute($basketgroupinfo->{'id'}, $basketno);
592 #------------------------------------------------------------#
594 =head3 DelBasketgroup
596 DelBasketgroup($basketgroupid);
598 Deletes a basketgroup in the aqbasketgroups table, and removes the reference to it from the baskets,
602 =item C<$basketgroupid> is the 'id' field of the basket in the aqbasketgroup table
609 my $basketgroupid = shift;
610 die "basketgroup id is required to edit a basketgroup" unless $basketgroupid;
611 my $query = "DELETE FROM aqbasketgroups WHERE id=?";
612 my $dbh = C4::Context->dbh;
613 my $sth = $dbh->prepare($query);
614 $sth->execute($basketgroupid);
618 #------------------------------------------------------------#
621 =head2 FUNCTIONS ABOUT ORDERS
623 =head3 GetBasketgroup
625 $basketgroup = &GetBasketgroup($basketgroupid);
627 Returns a reference to the hash containing all infermation about the basketgroup.
632 my $basketgroupid = shift;
633 die "basketgroup id is required to edit a basketgroup" unless $basketgroupid;
634 my $query = "SELECT * FROM aqbasketgroups WHERE id=?";
635 my $dbh = C4::Context->dbh;
636 my $sth = $dbh->prepare($query);
637 $sth->execute($basketgroupid);
638 my $result = $sth->fetchrow_hashref;
643 #------------------------------------------------------------#
645 =head3 GetBasketgroups
647 $basketgroups = &GetBasketgroups($booksellerid);
649 Returns a reference to the array of all the basketgroups of bookseller $booksellerid.
653 sub GetBasketgroups {
654 my $booksellerid = shift;
655 die "bookseller id is required to edit a basketgroup" unless $booksellerid;
656 my $query = "SELECT * FROM aqbasketgroups WHERE booksellerid=? ORDER BY `id` DESC";
657 my $dbh = C4::Context->dbh;
658 my $sth = $dbh->prepare($query);
659 $sth->execute($booksellerid);
660 my $results = $sth->fetchall_arrayref({});
665 #------------------------------------------------------------#
667 =head2 FUNCTIONS ABOUT ORDERS
671 #------------------------------------------------------------#
673 =head3 GetPendingOrders
675 $orders = &GetPendingOrders($booksellerid, $grouped, $owner);
677 Finds pending orders from the bookseller with the given ID. Ignores
678 completed and cancelled orders.
680 C<$booksellerid> contains the bookseller identifier
681 C<$grouped> contains 0 or 1. 0 means returns the list, 1 means return the total
682 C<$owner> contains 0 or 1. 0 means any owner. 1 means only the list of orders entered by the user itself.
684 C<$orders> is a reference-to-array; each element is a
685 reference-to-hash with the following fields:
686 C<$grouped> is a boolean that, if set to 1 will group all order lines of the same basket
687 in a single result line
691 =item C<authorizedby>
699 These give the value of the corresponding field in the aqorders table
700 of the Koha database.
702 Results are ordered from most to least recent.
706 sub GetPendingOrders {
707 my ($supplierid,$grouped,$owner,$basketno) = @_;
708 my $dbh = C4::Context->dbh;
710 SELECT ".($grouped?"count(*),":"")."aqbasket.basketno,
711 surname,firstname,aqorders.*,biblio.*,biblioitems.isbn,
712 aqbasket.closedate, aqbasket.creationdate, aqbasket.basketname
714 LEFT JOIN aqbasket ON aqbasket.basketno=aqorders.basketno
715 LEFT JOIN borrowers ON aqbasket.authorisedby=borrowers.borrowernumber
716 LEFT JOIN biblio ON biblio.biblionumber=aqorders.biblionumber
717 LEFT JOIN biblioitems ON biblioitems.biblionumber=biblio.biblionumber
719 AND (quantity > quantityreceived OR quantityreceived is NULL)
720 AND datecancellationprinted IS NULL
721 AND (to_days(now())-to_days(closedate) < 180 OR closedate IS NULL)
723 ## FIXME Why 180 days ???
724 my @query_params = ( $supplierid );
725 my $userenv = C4::Context->userenv;
726 if ( C4::Context->preference("IndependantBranches") ) {
727 if ( ($userenv) && ( $userenv->{flags} != 1 ) ) {
728 $strsth .= " and (borrowers.branchcode = ?
729 or borrowers.branchcode = '')";
730 push @query_params, $userenv->{branch};
734 $strsth .= " AND aqbasket.authorisedby=? ";
735 push @query_params, $userenv->{'number'};
738 $strsth .= " AND aqbasket.basketno=? ";
739 push @query_params, $basketno;
741 $strsth .= " group by aqbasket.basketno" if $grouped;
742 $strsth .= " order by aqbasket.basketno";
744 my $sth = $dbh->prepare($strsth);
745 $sth->execute( @query_params );
746 my $results = $sth->fetchall_arrayref({});
751 #------------------------------------------------------------#
755 @orders = &GetOrders($basketnumber, $orderby);
757 Looks up the pending (non-cancelled) orders with the given basket
758 number. If C<$booksellerID> is non-empty, only orders from that seller
762 C<&basket> returns a two-element array. C<@orders> is an array of
763 references-to-hash, whose keys are the fields from the aqorders,
764 biblio, and biblioitems tables in the Koha database.
769 my ( $basketno, $orderby ) = @_;
770 my $dbh = C4::Context->dbh;
772 SELECT biblio.*,biblioitems.*,
777 LEFT JOIN aqbudgets ON aqbudgets.budget_id = aqorders.budget_id
778 LEFT JOIN biblio ON biblio.biblionumber = aqorders.biblionumber
779 LEFT JOIN biblioitems ON biblioitems.biblionumber =biblio.biblionumber
781 AND (datecancellationprinted IS NULL OR datecancellationprinted='0000-00-00')
784 $orderby = "biblioitems.publishercode,biblio.title" unless $orderby;
785 $query .= " ORDER BY $orderby";
786 my $sth = $dbh->prepare($query);
787 $sth->execute($basketno);
788 my $results = $sth->fetchall_arrayref({});
793 #------------------------------------------------------------#
795 =head3 GetOrderNumber
797 $ordernumber = &GetOrderNumber($biblioitemnumber, $biblionumber);
799 Looks up the ordernumber with the given biblionumber and biblioitemnumber.
801 Returns the number of this order.
805 =item C<$ordernumber> is the order number.
812 my ( $biblionumber,$biblioitemnumber ) = @_;
813 my $dbh = C4::Context->dbh;
818 AND biblioitemnumber=?
820 my $sth = $dbh->prepare($query);
821 $sth->execute( $biblionumber, $biblioitemnumber );
823 return $sth->fetchrow;
826 #------------------------------------------------------------#
830 $order = &GetOrder($ordernumber);
832 Looks up an order by order number.
834 Returns a reference-to-hash describing the order. The keys of
835 C<$order> are fields from the biblio, biblioitems, aqorders tables of the Koha database.
840 my ($ordernumber) = @_;
841 my $dbh = C4::Context->dbh;
843 SELECT biblioitems.*, biblio.*, aqorders.*
845 LEFT JOIN biblio on biblio.biblionumber=aqorders.biblionumber
846 LEFT JOIN biblioitems on biblioitems.biblionumber=aqorders.biblionumber
847 WHERE aqorders.ordernumber=?
850 my $sth= $dbh->prepare($query);
851 $sth->execute($ordernumber);
852 my $data = $sth->fetchrow_hashref;
857 #------------------------------------------------------------#
861 &NewOrder(\%hashref);
863 Adds a new order to the database. Any argument that isn't described
864 below is the new value of the field with the same name in the aqorders
865 table of the Koha database.
869 =item $hashref->{'basketno'} is the basketno foreign key in aqorders, it is mandatory
871 =item $hashref->{'ordernumber'} is a "minimum order number."
873 =item $hashref->{'budgetdate'} is effectively ignored.
874 If it's undef (anything false) or the string 'now', the current day is used.
875 Else, the upcoming July 1st is used.
877 =item $hashref->{'subscription'} may be either "yes", or anything else for "no".
879 =item $hashref->{'uncertainprice'} may be 0 for "the price is known" or 1 for "the price is uncertain"
881 =item defaults entrydate to Now
883 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".
890 my $orderinfo = shift;
891 #### ------------------------------
892 my $dbh = C4::Context->dbh;
896 # if these parameters are missing, we can't continue
897 for my $key (qw/basketno quantity biblionumber budget_id/) {
898 die "Mandatory parameter $key missing" unless $orderinfo->{$key};
901 if ( defined $orderinfo->{subscription} && $orderinfo->{'subscription'} eq 'yes' ) {
902 $orderinfo->{'subscription'} = 1;
904 $orderinfo->{'subscription'} = 0;
906 $orderinfo->{'entrydate'} ||= C4::Dates->new()->output("iso");
907 if (!$orderinfo->{quantityreceived}) {
908 $orderinfo->{quantityreceived} = 0;
911 my $ordernumber=InsertInTable("aqorders",$orderinfo);
912 return ( $orderinfo->{'basketno'}, $ordernumber );
917 #------------------------------------------------------------#
926 #my ($biblioitemnumber,$ordernumber, $biblionumber) = @_;
927 my ($itemnumber, $ordernumber) = @_;
928 my $dbh = C4::Context->dbh;
930 INSERT INTO aqorders_items
931 (itemnumber, ordernumber)
934 my $sth = $dbh->prepare($query);
935 $sth->execute( $itemnumber, $ordernumber);
938 #------------------------------------------------------------#
942 &ModOrder(\%hashref);
944 Modifies an existing order. Updates the order with order number
945 $hashref->{'ordernumber'} and biblionumber $hashref->{'biblionumber'}. All
946 other keys of the hash update the fields with the same name in the aqorders
947 table of the Koha database.
952 my $orderinfo = shift;
954 die "Ordernumber is required" if $orderinfo->{'ordernumber'} eq '' ;
955 die "Biblionumber is required" if $orderinfo->{'biblionumber'} eq '';
957 my $dbh = C4::Context->dbh;
960 # update uncertainprice to an integer, just in case (under FF, checked boxes have the value "ON" by default)
961 $orderinfo->{uncertainprice}=1 if $orderinfo->{uncertainprice};
963 # delete($orderinfo->{'branchcode'});
964 # the hash contains a lot of entries not in aqorders, so get the columns ...
965 my $sth = $dbh->prepare("SELECT * FROM aqorders LIMIT 1;");
967 my $colnames = $sth->{NAME};
968 my $query = "UPDATE aqorders SET ";
970 foreach my $orderinfokey (grep(!/ordernumber/, keys %$orderinfo)){
971 # ... and skip hash entries that are not in the aqorders table
972 # FIXME : probably not the best way to do it (would be better to have a correct hash)
973 next unless grep(/^$orderinfokey$/, @$colnames);
974 $query .= "$orderinfokey=?, ";
975 push(@params, $orderinfo->{$orderinfokey});
978 $query .= "timestamp=NOW() WHERE ordernumber=?";
979 # push(@params, $specorderinfo{'ordernumber'});
980 push(@params, $orderinfo->{'ordernumber'} );
981 $sth = $dbh->prepare($query);
982 $sth->execute(@params);
986 #------------------------------------------------------------#
990 &ModOrderItem(\%hashref);
992 Modifies the itemnumber in the aqorders_items table. The input hash needs three entities:
996 =item - itemnumber: the old itemnumber
997 =item - ordernumber: the order this item is attached to
998 =item - newitemnumber: the new itemnumber we want to attach the line to
1005 my $orderiteminfo = shift;
1006 if (! $orderiteminfo->{'ordernumber'} || ! $orderiteminfo->{'itemnumber'} || ! $orderiteminfo->{'newitemnumber'}){
1007 die "Ordernumber, itemnumber and newitemnumber is required";
1010 my $dbh = C4::Context->dbh;
1012 my $query = "UPDATE aqorders_items set itemnumber=? where itemnumber=? and ordernumber=?";
1013 my @params = ($orderiteminfo->{'newitemnumber'}, $orderiteminfo->{'itemnumber'}, $orderiteminfo->{'ordernumber'});
1014 my $sth = $dbh->prepare($query);
1015 $sth->execute(@params);
1019 #------------------------------------------------------------#
1022 =head3 ModOrderBibliotemNumber
1024 &ModOrderBiblioitemNumber($biblioitemnumber,$ordernumber, $biblionumber);
1026 Modifies the biblioitemnumber for an existing order.
1027 Updates the order with order number C<$ordernum> and biblionumber C<$biblionumber>.
1031 #FIXME: is this used at all?
1032 sub ModOrderBiblioitemNumber {
1033 my ($biblioitemnumber,$ordernumber, $biblionumber) = @_;
1034 my $dbh = C4::Context->dbh;
1037 SET biblioitemnumber = ?
1038 WHERE ordernumber = ?
1039 AND biblionumber = ?";
1040 my $sth = $dbh->prepare($query);
1041 $sth->execute( $biblioitemnumber, $ordernumber, $biblionumber );
1044 #------------------------------------------------------------#
1046 =head3 ModReceiveOrder
1048 &ModReceiveOrder($biblionumber, $ordernumber, $quantityreceived, $user,
1049 $unitprice, $booksellerinvoicenumber, $biblioitemnumber,
1050 $freight, $bookfund, $rrp);
1052 Updates an order, to reflect the fact that it was received, at least
1053 in part. All arguments not mentioned below update the fields with the
1054 same name in the aqorders table of the Koha database.
1056 If a partial order is received, splits the order into two. The received
1057 portion must have a booksellerinvoicenumber.
1059 Updates the order with bibilionumber C<$biblionumber> and ordernumber
1065 sub ModReceiveOrder {
1067 $biblionumber, $ordernumber, $quantrec, $user, $cost,
1068 $invoiceno, $freight, $rrp, $budget_id, $datereceived
1071 my $dbh = C4::Context->dbh;
1072 # warn "DATE BEFORE : $daterecieved";
1073 # $daterecieved=POSIX::strftime("%Y-%m-%d",CORE::localtime) unless $daterecieved;
1074 # warn "DATE REC : $daterecieved";
1075 $datereceived = C4::Dates->output('iso') unless $datereceived;
1076 my $suggestionid = GetSuggestionFromBiblionumber( $dbh, $biblionumber );
1077 if ($suggestionid) {
1078 ModSuggestion( {suggestionid=>$suggestionid,
1079 STATUS=>'AVAILABLE',
1080 biblionumber=> $biblionumber}
1084 my $sth=$dbh->prepare("
1085 SELECT * FROM aqorders
1086 WHERE biblionumber=? AND aqorders.ordernumber=?");
1088 $sth->execute($biblionumber,$ordernumber);
1089 my $order = $sth->fetchrow_hashref();
1092 if ( $order->{quantity} > $quantrec ) {
1093 $sth=$dbh->prepare("
1095 SET quantityreceived=?
1097 , booksellerinvoicenumber=?
1102 WHERE biblionumber=? AND ordernumber=?");
1104 $sth->execute($quantrec,$datereceived,$invoiceno,$cost,$freight,$rrp,$quantrec,$biblionumber,$ordernumber);
1107 # create a new order for the remaining items, and set its bookfund.
1108 foreach my $orderkey ( "linenumber", "allocation" ) {
1109 delete($order->{'$orderkey'});
1111 $order->{'quantity'} -= $quantrec;
1112 $order->{'quantityreceived'} = 0;
1113 my $newOrder = NewOrder($order);
1115 $sth=$dbh->prepare("update aqorders
1116 set quantityreceived=?,datereceived=?,booksellerinvoicenumber=?,
1117 unitprice=?,freight=?,rrp=?
1118 where biblionumber=? and ordernumber=?");
1119 $sth->execute($quantrec,$datereceived,$invoiceno,$cost,$freight,$rrp,$biblionumber,$ordernumber);
1122 return $datereceived;
1124 #------------------------------------------------------------#
1128 @results = &SearchOrder($search, $biblionumber, $complete);
1130 Searches for orders.
1132 C<$search> may take one of several forms: if it is an ISBN,
1133 C<&ordersearch> returns orders with that ISBN. If C<$search> is an
1134 order number, C<&ordersearch> returns orders with that order number
1135 and biblionumber C<$biblionumber>. Otherwise, C<$search> is considered
1136 to be a space-separated list of search terms; in this case, all of the
1137 terms must appear in the title (matching the beginning of title
1140 If C<$complete> is C<yes>, the results will include only completed
1141 orders. In any case, C<&ordersearch> ignores cancelled orders.
1143 C<&ordersearch> returns an array.
1144 C<@results> is an array of references-to-hash with the following keys:
1150 =item C<seriestitle>
1161 #### -------- SearchOrder-------------------------------
1162 my ($ordernumber, $search, $supplierid, $basket) = @_;
1164 my $dbh = C4::Context->dbh;
1169 LEFT JOIN biblio ON aqorders.biblionumber=biblio.biblionumber
1170 LEFT JOIN biblioitems ON biblioitems.biblionumber=biblio.biblionumber
1171 LEFT JOIN aqbasket ON aqorders.basketno = aqbasket.basketno
1172 WHERE (datecancellationprinted is NULL)";
1175 $query .= " AND (aqorders.ordernumber=?)";
1176 push @args, $ordernumber;
1179 $query .= " AND (biblio.title like ? OR biblio.author LIKE ? OR biblioitems.isbn like ?)";
1180 push @args, ("%$search%","%$search%","%$search%");
1183 $query .= "AND aqbasket.booksellerid = ?";
1184 push @args, $supplierid;
1187 $query .= "AND aqorders.basketno = ?";
1188 push @args, $basket;
1191 my $sth = $dbh->prepare($query);
1192 $sth->execute(@args);
1193 my $results = $sth->fetchall_arrayref({});
1198 #------------------------------------------------------------#
1202 &DelOrder($biblionumber, $ordernumber);
1204 Cancel the order with the given order and biblio numbers. It does not
1205 delete any entries in the aqorders table, it merely marks them as
1211 my ( $bibnum, $ordernumber ) = @_;
1212 my $dbh = C4::Context->dbh;
1215 SET datecancellationprinted=now()
1216 WHERE biblionumber=? AND ordernumber=?
1218 my $sth = $dbh->prepare($query);
1219 $sth->execute( $bibnum, $ordernumber );
1223 =head2 FUNCTIONS ABOUT PARCELS
1227 #------------------------------------------------------------#
1231 @results = &GetParcel($booksellerid, $code, $date);
1233 Looks up all of the received items from the supplier with the given
1234 bookseller ID at the given date, for the given code (bookseller Invoice number). Ignores cancelled and completed orders.
1236 C<@results> is an array of references-to-hash. The keys of each element are fields from
1237 the aqorders, biblio, and biblioitems tables of the Koha database.
1239 C<@results> is sorted alphabetically by book title.
1244 #gets all orders from a certain supplier, orders them alphabetically
1245 my ( $supplierid, $code, $datereceived ) = @_;
1246 my $dbh = C4::Context->dbh;
1249 if $code; # add % if we search on a given code (otherwise, let him empty)
1251 SELECT authorisedby,
1256 aqorders.biblionumber,
1257 aqorders.ordernumber,
1259 aqorders.quantityreceived,
1266 LEFT JOIN aqbasket ON aqbasket.basketno=aqorders.basketno
1267 LEFT JOIN borrowers ON aqbasket.authorisedby=borrowers.borrowernumber
1268 LEFT JOIN biblio ON aqorders.biblionumber=biblio.biblionumber
1270 aqbasket.booksellerid = ?
1271 AND aqorders.booksellerinvoicenumber LIKE ?
1272 AND aqorders.datereceived = ? ";
1274 my @query_params = ( $supplierid, $code, $datereceived );
1275 if ( C4::Context->preference("IndependantBranches") ) {
1276 my $userenv = C4::Context->userenv;
1277 if ( ($userenv) && ( $userenv->{flags} != 1 ) ) {
1278 $strsth .= " and (borrowers.branchcode = ?
1279 or borrowers.branchcode = '')";
1280 push @query_params, $userenv->{branch};
1283 $strsth .= " ORDER BY aqbasket.basketno";
1284 # ## parcelinformation : $strsth
1285 my $sth = $dbh->prepare($strsth);
1286 $sth->execute( @query_params );
1287 while ( my $data = $sth->fetchrow_hashref ) {
1288 push( @results, $data );
1290 # ## countparcelbiblio: scalar(@results)
1296 #------------------------------------------------------------#
1300 $results = &GetParcels($bookseller, $order, $code, $datefrom, $dateto);
1302 get a lists of parcels.
1309 is the bookseller this function has to get parcels.
1312 To know on what criteria the results list has to be ordered.
1315 is the booksellerinvoicenumber.
1317 =item $datefrom & $dateto
1318 to know on what date this function has to filter its search.
1323 a pointer on a hash list containing parcel informations as such :
1329 =item Last operation
1331 =item Number of biblio
1333 =item Number of items
1340 my ($bookseller,$order, $code, $datefrom, $dateto) = @_;
1341 my $dbh = C4::Context->dbh;
1342 my @query_params = ();
1344 SELECT aqorders.booksellerinvoicenumber,
1345 datereceived,purchaseordernumber,
1346 count(DISTINCT biblionumber) AS biblio,
1347 sum(quantity) AS itemsexpected,
1348 sum(quantityreceived) AS itemsreceived
1349 FROM aqorders LEFT JOIN aqbasket ON aqbasket.basketno = aqorders.basketno
1350 WHERE aqbasket.booksellerid = ? and datereceived IS NOT NULL
1352 push @query_params, $bookseller;
1354 if ( defined $code ) {
1355 $strsth .= ' and aqorders.booksellerinvoicenumber like ? ';
1356 # add a % to the end of the code to allow stemming.
1357 push @query_params, "$code%";
1360 if ( defined $datefrom ) {
1361 $strsth .= ' and datereceived >= ? ';
1362 push @query_params, $datefrom;
1365 if ( defined $dateto ) {
1366 $strsth .= 'and datereceived <= ? ';
1367 push @query_params, $dateto;
1370 $strsth .= "group by aqorders.booksellerinvoicenumber,datereceived ";
1372 # can't use a placeholder to place this column name.
1373 # but, we could probably be checking to make sure it is a column that will be fetched.
1374 $strsth .= "order by $order " if ($order);
1376 my $sth = $dbh->prepare($strsth);
1378 $sth->execute( @query_params );
1379 my $results = $sth->fetchall_arrayref({});
1384 #------------------------------------------------------------#
1386 =head3 GetLateOrders
1388 @results = &GetLateOrders;
1390 Searches for bookseller with late orders.
1393 the table of supplier with late issues. This table is full of hashref.
1399 my $supplierid = shift;
1402 my $dbh = C4::Context->dbh;
1404 #BEWARE, order of parenthesis and LEFT JOIN is important for speed
1405 my $dbdriver = C4::Context->config("db_scheme") || "mysql";
1407 my @query_params = ($delay); # delay is the first argument regardless
1409 SELECT aqbasket.basketno,
1410 aqorders.ordernumber,
1411 DATE(aqbasket.closedate) AS orderdate,
1412 aqorders.rrp AS unitpricesupplier,
1413 aqorders.ecost AS unitpricelib,
1414 aqbudgets.budget_name AS budget,
1415 borrowers.branchcode AS branch,
1416 aqbooksellers.name AS supplier,
1417 biblio.author, biblio.title,
1418 biblioitems.publishercode AS publisher,
1419 biblioitems.publicationyear,
1423 aqorders LEFT JOIN biblio ON biblio.biblionumber = aqorders.biblionumber
1424 LEFT JOIN biblioitems ON biblioitems.biblionumber = biblio.biblionumber
1425 LEFT JOIN aqbudgets ON aqorders.budget_id = aqbudgets.budget_id,
1426 aqbasket LEFT JOIN borrowers ON aqbasket.authorisedby = borrowers.borrowernumber
1427 LEFT JOIN aqbooksellers ON aqbasket.booksellerid = aqbooksellers.id
1428 WHERE aqorders.basketno = aqbasket.basketno
1429 AND ( datereceived = ''
1430 OR datereceived IS NULL
1431 OR aqorders.quantityreceived < aqorders.quantity
1433 AND (aqorders.datecancellationprinted IS NULL OR aqorders.datecancellationprinted='0000-00-00')
1436 if ($dbdriver eq "mysql") {
1438 aqorders.quantity - IFNULL(aqorders.quantityreceived,0) AS quantity,
1439 (aqorders.quantity - IFNULL(aqorders.quantityreceived,0)) * aqorders.rrp AS subtotal,
1440 DATEDIFF(CURDATE( ),closedate) AS latesince
1442 $from .= " AND (closedate <= DATE_SUB(CURDATE( ),INTERVAL ? DAY)) ";
1444 HAVING quantity <> 0
1445 AND unitpricesupplier <> 0
1446 AND unitpricelib <> 0
1449 # FIXME: account for IFNULL as above
1451 aqorders.quantity AS quantity,
1452 aqorders.quantity * aqorders.rrp AS subtotal,
1453 (CURDATE - closedate) AS latesince
1455 $from .= " AND (closedate <= (CURDATE -(INTERVAL ? DAY)) ";
1457 if (defined $supplierid) {
1458 $from .= ' AND aqbasket.booksellerid = ? ';
1459 push @query_params, $supplierid;
1461 if (defined $branch) {
1462 $from .= ' AND borrowers.branchcode LIKE ? ';
1463 push @query_params, $branch;
1465 if (C4::Context->preference("IndependantBranches")
1466 && C4::Context->userenv
1467 && C4::Context->userenv->{flags} != 1 ) {
1468 $from .= ' AND borrowers.branchcode LIKE ? ';
1469 push @query_params, C4::Context->userenv->{branch};
1471 my $query = "$select $from $having\nORDER BY latesince, basketno, borrowers.branchcode, supplier";
1472 $debug and print STDERR "GetLateOrders query: $query\nGetLateOrders args: " . join(" ",@query_params);
1473 my $sth = $dbh->prepare($query);
1474 $sth->execute(@query_params);
1476 while (my $data = $sth->fetchrow_hashref) {
1477 $data->{orderdate} = format_date($data->{orderdate});
1478 push @results, $data;
1483 #------------------------------------------------------------#
1487 (\@order_loop, $total_qty, $total_price, $total_qtyreceived) = GetHistory( $title, $author, $name, $from_placed_on, $to_placed_on );
1489 Retreives some acquisition history information
1492 $order_loop is a list of hashrefs that each look like this:
1494 'author' => 'Twain, Mark',
1496 'biblionumber' => '215',
1498 'creationdate' => 'MM/DD/YYYY',
1499 'datereceived' => undef,
1502 'invoicenumber' => undef,
1504 'ordernumber' => '1',
1506 'quantityreceived' => undef,
1507 'title' => 'The Adventures of Huckleberry Finn'
1509 $total_qty is the sum of all of the quantities in $order_loop
1510 $total_price is the cost of each in $order_loop times the quantity
1511 $total_qtyreceived is the sum of all of the quantityreceived entries in $order_loop
1516 my ( $title, $author, $name, $from_placed_on, $to_placed_on ) = @_;
1519 my $total_qtyreceived = 0;
1520 my $total_price = 0;
1522 # don't run the query if there are no parameters (list would be too long for sure !)
1523 if ( $title || $author || $name || $from_placed_on || $to_placed_on ) {
1524 my $dbh = C4::Context->dbh;
1530 aqbasket.basketname,
1531 aqbasket.basketgroupid,
1532 aqbasketgroups.name as groupname,
1534 aqbasket.creationdate,
1535 aqorders.datereceived,
1537 aqorders.quantityreceived,
1539 aqorders.ordernumber,
1540 aqorders.booksellerinvoicenumber as invoicenumber,
1541 aqbooksellers.id as id,
1542 aqorders.biblionumber
1544 LEFT JOIN aqbasket ON aqorders.basketno=aqbasket.basketno
1545 LEFT JOIN aqbasketgroups ON aqbasket.basketgroupid=aqbasketgroups.id
1546 LEFT JOIN aqbooksellers ON aqbasket.booksellerid=aqbooksellers.id
1547 LEFT JOIN biblio ON biblio.biblionumber=aqorders.biblionumber";
1549 $query .= " LEFT JOIN borrowers ON aqbasket.authorisedby=borrowers.borrowernumber"
1550 if ( C4::Context->preference("IndependantBranches") );
1552 $query .= " WHERE (datecancellationprinted is NULL or datecancellationprinted='0000-00-00') ";
1554 my @query_params = ();
1556 if ( defined $title ) {
1557 $query .= " AND biblio.title LIKE ? ";
1558 $title =~ s/\s+/%/g;
1559 push @query_params, "%$title%";
1562 if ( defined $author ) {
1563 $query .= " AND biblio.author LIKE ? ";
1564 push @query_params, "%$author%";
1567 if ( defined $name ) {
1568 $query .= " AND aqbooksellers.name LIKE ? ";
1569 push @query_params, "%$name%";
1572 if ( defined $from_placed_on ) {
1573 $query .= " AND creationdate >= ? ";
1574 push @query_params, $from_placed_on;
1577 if ( defined $to_placed_on ) {
1578 $query .= " AND creationdate <= ? ";
1579 push @query_params, $to_placed_on;
1582 if ( C4::Context->preference("IndependantBranches") ) {
1583 my $userenv = C4::Context->userenv;
1584 if ( ($userenv) && ( $userenv->{flags} != 1 ) ) {
1585 $query .= " AND (borrowers.branchcode = ? OR borrowers.branchcode ='' ) ";
1586 push @query_params, $userenv->{branch};
1589 $query .= " ORDER BY id";
1590 my $sth = $dbh->prepare($query);
1591 $sth->execute( @query_params );
1593 while ( my $line = $sth->fetchrow_hashref ) {
1594 $line->{count} = $cnt++;
1595 $line->{toggle} = 1 if $cnt % 2;
1596 push @order_loop, $line;
1597 $line->{creationdate} = format_date( $line->{creationdate} );
1598 $line->{datereceived} = format_date( $line->{datereceived} );
1599 $total_qty += $line->{'quantity'};
1600 $total_qtyreceived += $line->{'quantityreceived'};
1601 $total_price += $line->{'quantity'} * $line->{'ecost'};
1604 return \@order_loop, $total_qty, $total_price, $total_qtyreceived;
1607 =head2 GetRecentAcqui
1609 $results = GetRecentAcqui($days);
1611 C<$results> is a ref to a table which containts hashref
1615 sub GetRecentAcqui {
1617 my $dbh = C4::Context->dbh;
1621 ORDER BY timestamp DESC
1624 my $sth = $dbh->prepare($query);
1626 my $results = $sth->fetchall_arrayref({});
1632 $contractlist = &GetContracts($booksellerid, $activeonly);
1634 Looks up the contracts that belong to a bookseller
1636 Returns a list of contracts
1640 =item C<$booksellerid> is the "id" field in the "aqbooksellers" table.
1642 =item C<$activeonly> if exists get only contracts that are still active.
1649 my ( $booksellerid, $activeonly ) = @_;
1650 my $dbh = C4::Context->dbh;
1652 if (! $activeonly) {
1656 WHERE booksellerid=?
1661 WHERE booksellerid=?
1662 AND contractenddate >= CURDATE( )";
1664 my $sth = $dbh->prepare($query);
1665 $sth->execute( $booksellerid );
1667 while (my $data = $sth->fetchrow_hashref ) {
1668 push(@results, $data);
1674 #------------------------------------------------------------#
1678 $contract = &GetContract($contractID);
1680 Looks up the contract that has PRIMKEY (contractnumber) value $contractID
1687 my ( $contractno ) = @_;
1688 my $dbh = C4::Context->dbh;
1692 WHERE contractnumber=?
1695 my $sth = $dbh->prepare($query);
1696 $sth->execute( $contractno );
1697 my $result = $sth->fetchrow_hashref;
1706 Koha Development Team <http://koha-community.org/>