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 with
17 # Koha; if not, write to the Free Software Foundation, Inc., 59 Temple Place,
18 # Suite 330, Boston, MA 02111-1307 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
133 $aqbasket = &GetBasket($basketnumber);
135 get all basket informations in aqbasket for a given basket
138 informations for a given basket returned as a hashref.
146 my $dbh = C4::Context->dbh;
149 concat( b.firstname,' ',b.surname) AS authorisedbyname,
150 b.branchcode AS branch
152 LEFT JOIN borrowers b ON aqbasket.authorisedby=b.borrowernumber
155 my $sth=$dbh->prepare($query);
156 $sth->execute($basketno);
157 my $basket = $sth->fetchrow_hashref;
161 #------------------------------------------------------------#
167 $basket = &NewBasket( $booksellerid, $authorizedby, $basketname, $basketnote, $basketbooksellernote, $basketcontractnumber );
171 Create a new basket in aqbasket table
175 =item C<$booksellerid> is a foreign key in the aqbasket table
177 =item C<$authorizedby> is the username of who created the basket
181 The other parameters are optional, see ModBasketHeader for more info on them.
185 # FIXME : this function seems to be unused.
188 my ( $booksellerid, $authorisedby, $basketname, $basketnote, $basketbooksellernote, $basketcontractnumber ) = @_;
189 my $dbh = C4::Context->dbh;
192 (creationdate,booksellerid,authorisedby)
193 VALUES (now(),'$booksellerid','$authorisedby')
197 #find & return basketno MYSQL dependant, but $dbh->last_insert_id always returns null :-(
198 my $basket = $dbh->{'mysql_insertid'};
199 ModBasketHeader($basket, $basketname || '', $basketnote || '', $basketbooksellernote || '', $basketcontractnumber || undef);
203 #------------------------------------------------------------#
209 &CloseBasket($basketno);
211 close a basket (becomes unmodifiable,except for recieves)
219 my $dbh = C4::Context->dbh;
225 my $sth = $dbh->prepare($query);
226 $sth->execute($basketno);
229 #------------------------------------------------------------#
231 =head3 GetBasketAsCSV
235 &GetBasketAsCSV($basketno);
237 Export a basket as CSV
244 my $basket = GetBasket($basketno);
245 my @orders = GetOrders($basketno);
246 my $contract = GetContract($basket->{'contractnumber'});
247 my $csv = Text::CSV->new();
250 # TODO: Translate headers
251 my @headers = qw(contractname ordernumber line entrydate isbn author title publishercode collectiontitle notes quantity rrp);
253 $csv->combine(@headers);
254 $output = $csv->string() . "\n";
257 foreach my $order (@orders) {
259 my $bd = GetBiblioData($order->{'biblionumber'});
261 $contract->{'contractname'},
262 $order->{'ordernumber'},
263 $order->{'entrydate'},
267 $bd->{'publishercode'},
268 $bd->{'collectiontitle'},
270 $order->{'quantity'},
273 push (@rows, \@cols);
276 # Sort by publishercode
277 # TODO: Sort by publishercode then by title
278 @rows = sort { @$a[7] cmp @$b[7] } @rows;
280 foreach my $row (@rows) {
281 $csv->combine(@$row);
282 $output .= $csv->string() . "\n";
291 =head3 CloseBasketgroup
295 &CloseBasketgroup($basketgroupno);
303 sub CloseBasketgroup {
304 my ($basketgroupno) = @_;
305 my $dbh = C4::Context->dbh;
306 my $sth = $dbh->prepare("
307 UPDATE aqbasketgroups
311 $sth->execute($basketgroupno);
314 #------------------------------------------------------------#
316 =head3 ReOpenBaskergroup($basketgroupno)
320 &ReOpenBaskergroup($basketgroupno);
328 sub ReOpenBasketgroup {
329 my ($basketgroupno) = @_;
330 my $dbh = C4::Context->dbh;
331 my $sth = $dbh->prepare("
332 UPDATE aqbasketgroups
336 $sth->execute($basketgroupno);
339 #------------------------------------------------------------#
346 &DelBasket($basketno);
348 Deletes the basket that has basketno field $basketno in the aqbasket table.
352 =item C<$basketno> is the primary key of the basket in the aqbasket table.
360 my ( $basketno ) = @_;
361 my $query = "DELETE FROM aqbasket WHERE basketno=?";
362 my $dbh = C4::Context->dbh;
363 my $sth = $dbh->prepare($query);
364 $sth->execute($basketno);
368 #------------------------------------------------------------#
374 &ModBasket($basketinfo);
376 Modifies a basket, using a hashref $basketinfo for the relevant information, only $basketinfo->{'basketno'} is required.
380 =item C<$basketno> is the primary key of the basket in the aqbasket table.
388 my $basketinfo = shift;
389 my $query = "UPDATE aqbasket SET ";
391 foreach my $key (keys %$basketinfo){
392 if ($key ne 'basketno'){
393 $query .= "$key=?, ";
394 push(@params, $basketinfo->{$key} || undef );
397 # get rid of the "," at the end of $query
398 if (substr($query, length($query)-2) eq ', '){
403 $query .= "WHERE basketno=?";
404 push(@params, $basketinfo->{'basketno'});
405 my $dbh = C4::Context->dbh;
406 my $sth = $dbh->prepare($query);
407 $sth->execute(@params);
411 #------------------------------------------------------------#
413 =head3 ModBasketHeader
417 &ModBasketHeader($basketno, $basketname, $note, $booksellernote, $contractnumber);
419 Modifies a basket's header.
423 =item C<$basketno> is the "basketno" field in the "aqbasket" table;
425 =item C<$basketname> is the "basketname" field in the "aqbasket" table;
427 =item C<$note> is the "note" field in the "aqbasket" table;
429 =item C<$booksellernote> is the "booksellernote" field in the "aqbasket" table;
431 =item C<$contractnumber> is the "contractnumber" (foreign) key in the "aqbasket" table.
438 sub ModBasketHeader {
439 my ($basketno, $basketname, $note, $booksellernote, $contractnumber) = @_;
440 my $query = "UPDATE aqbasket SET basketname=?, note=?, booksellernote=? WHERE basketno=?";
441 my $dbh = C4::Context->dbh;
442 my $sth = $dbh->prepare($query);
443 $sth->execute($basketname,$note,$booksellernote,$basketno);
444 if ( $contractnumber ) {
445 my $query2 ="UPDATE aqbasket SET contractnumber=? WHERE basketno=?";
446 my $sth2 = $dbh->prepare($query2);
447 $sth2->execute($contractnumber,$basketno);
453 #------------------------------------------------------------#
455 =head3 GetBasketsByBookseller
459 @results = &GetBasketsByBookseller($booksellerid, $extra);
461 Returns a list of hashes of all the baskets that belong to bookseller 'booksellerid'.
465 =item C<$booksellerid> is the 'id' field of the bookseller in the aqbooksellers table
467 =item C<$extra> is the extra sql parameters, can be
469 - $extra->{groupby}: group baskets by column
470 ex. $extra->{groupby} = aqbasket.basketgroupid
471 - $extra->{orderby}: order baskets by column
472 - $extra->{limit}: limit number of results (can be helpful for pagination)
480 sub GetBasketsByBookseller {
481 my ($booksellerid, $extra) = @_;
482 my $query = "SELECT * FROM aqbasket WHERE booksellerid=?";
484 if ($extra->{groupby}) {
485 $query .= " GROUP by $extra->{groupby}";
487 if ($extra->{orderby}){
488 $query .= " ORDER by $extra->{orderby}";
490 if ($extra->{limit}){
491 $query .= " LIMIT $extra->{limit}";
494 my $dbh = C4::Context->dbh;
495 my $sth = $dbh->prepare($query);
496 $sth->execute($booksellerid);
497 my $results = $sth->fetchall_arrayref({});
502 #------------------------------------------------------------#
504 =head3 GetBasketsByBasketgroup
508 $baskets = &GetBasketsByBasketgroup($basketgroupid);
512 Returns a reference to all baskets that belong to basketgroup $basketgroupid.
520 sub GetBasketsByBasketgroup {
521 my $basketgroupid = shift;
522 my $query = "SELECT * FROM aqbasket
523 LEFT JOIN aqcontract USING(contractnumber) WHERE basketgroupid=?";
524 my $dbh = C4::Context->dbh;
525 my $sth = $dbh->prepare($query);
526 $sth->execute($basketgroupid);
527 my $results = $sth->fetchall_arrayref({});
532 #------------------------------------------------------------#
534 =head3 NewBasketgroup
538 $basketgroupid = NewBasketgroup(\%hashref);
542 Adds a basketgroup to the aqbasketgroups table, and add the initial baskets to it.
544 $hashref->{'booksellerid'} is the 'id' field of the bookseller in the aqbooksellers table,
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->{'deliveryplace'} is the 'deliveryplace' field of the basketgroup in the aqbasketgroups table,
552 $hashref->{'deliverycomment'} is the 'deliverycomment' field of the basketgroup in the aqbasketgroups table,
554 $hashref->{'closed'} is the 'closed' field of the aqbasketgroups table, it is false if 0, true otherwise.
563 my $basketgroupinfo = shift;
564 die "booksellerid is required to create a basketgroup" unless $basketgroupinfo->{'booksellerid'};
565 my $query = "INSERT INTO aqbasketgroups (";
567 foreach my $field ('name', 'deliveryplace', 'deliverycomment', 'closed') {
568 if ( $basketgroupinfo->{$field} ) {
569 $query .= "$field, ";
570 push(@params, $basketgroupinfo->{$field});
573 $query .= "booksellerid) VALUES (";
578 push(@params, $basketgroupinfo->{'booksellerid'});
579 my $dbh = C4::Context->dbh;
580 my $sth = $dbh->prepare($query);
581 $sth->execute(@params);
582 my $basketgroupid = $dbh->{'mysql_insertid'};
583 if( $basketgroupinfo->{'basketlist'} ) {
584 foreach my $basketno (@{$basketgroupinfo->{'basketlist'}}) {
585 my $query2 = "UPDATE aqbasket SET basketgroupid=? WHERE basketno=?";
586 my $sth2 = $dbh->prepare($query2);
587 $sth2->execute($basketgroupid, $basketno);
590 return $basketgroupid;
593 #------------------------------------------------------------#
595 =head3 ModBasketgroup
599 ModBasketgroup(\%hashref);
603 Modifies a basketgroup in the aqbasketgroups table, and add the baskets to it.
605 $hashref->{'id'} is the 'id' field of the basketgroup in the aqbasketgroup table, this parameter is mandatory,
607 $hashref->{'name'} is the 'name' field of the basketgroup in the aqbasketgroups table,
609 $hashref->{'basketlist'} is a list reference of the 'id's of the baskets that belong to this group,
611 $hashref->{'billingplace'} is the 'billingplace' field of the basketgroup in the aqbasketgroups table,
613 $hashref->{'deliveryplace'} is the 'deliveryplace' field of the basketgroup in the aqbasketgroups table,
615 $hashref->{'deliverycomment'} is the 'deliverycomment' field of the basketgroup in the aqbasketgroups table,
617 $hashref->{'closed'} is the 'closed' field of the aqbasketgroups table, it is false if 0, true otherwise.
626 my $basketgroupinfo = shift;
627 die "basketgroup id is required to edit a basketgroup" unless $basketgroupinfo->{'id'};
628 my $dbh = C4::Context->dbh;
629 my $query = "UPDATE aqbasketgroups SET ";
631 foreach my $field (qw(name billingplace deliveryplace deliverycomment closed)) {
632 if ( defined $basketgroupinfo->{$field} ) {
633 $query .= "$field=?, ";
634 push(@params, $basketgroupinfo->{$field});
639 $query .= " WHERE id=?";
640 push(@params, $basketgroupinfo->{'id'});
641 my $sth = $dbh->prepare($query);
642 $sth->execute(@params);
644 $sth = $dbh->prepare('UPDATE aqbasket SET basketgroupid = NULL WHERE basketgroupid = ?');
645 $sth->execute($basketgroupinfo->{'id'});
647 if($basketgroupinfo->{'basketlist'} && @{$basketgroupinfo->{'basketlist'}}){
648 $sth = $dbh->prepare("UPDATE aqbasket SET basketgroupid=? WHERE basketno=?");
649 foreach my $basketno (@{$basketgroupinfo->{'basketlist'}}) {
650 $sth->execute($basketgroupinfo->{'id'}, $basketno);
657 #------------------------------------------------------------#
659 =head3 DelBasketgroup
663 DelBasketgroup($basketgroupid);
667 Deletes a basketgroup in the aqbasketgroups table, and removes the reference to it from the baskets,
671 =item C<$basketgroupid> is the 'id' field of the basket in the aqbasketgroup table
678 my $basketgroupid = shift;
679 die "basketgroup id is required to edit a basketgroup" unless $basketgroupid;
680 my $query = "DELETE FROM aqbasketgroups WHERE id=?";
681 my $dbh = C4::Context->dbh;
682 my $sth = $dbh->prepare($query);
683 $sth->execute($basketgroupid);
687 #------------------------------------------------------------#
690 =head2 FUNCTIONS ABOUT ORDERS
698 =head3 GetBasketgroup
702 $basketgroup = &GetBasketgroup($basketgroupid);
706 Returns a reference to the hash containing all infermation about the basketgroup.
715 my $basketgroupid = shift;
716 die "basketgroup id is required to edit a basketgroup" unless $basketgroupid;
717 my $query = "SELECT * FROM aqbasketgroups WHERE id=?";
718 my $dbh = C4::Context->dbh;
719 my $sth = $dbh->prepare($query);
720 $sth->execute($basketgroupid);
721 my $result = $sth->fetchrow_hashref;
726 #------------------------------------------------------------#
728 =head3 GetBasketgroups
732 $basketgroups = &GetBasketgroups($booksellerid);
736 Returns a reference to the array of all the basketgroups of bookseller $booksellerid.
744 sub GetBasketgroups {
745 my $booksellerid = shift;
746 die "bookseller id is required to edit a basketgroup" unless $booksellerid;
747 my $query = "SELECT * FROM aqbasketgroups WHERE booksellerid=?";
748 my $dbh = C4::Context->dbh;
749 my $sth = $dbh->prepare($query);
750 $sth->execute($booksellerid);
751 my $results = $sth->fetchall_arrayref({});
756 #------------------------------------------------------------#
758 =head2 FUNCTIONS ABOUT ORDERS
762 #------------------------------------------------------------#
764 =head3 GetPendingOrders
768 $orders = &GetPendingOrders($booksellerid, $grouped, $owner);
770 Finds pending orders from the bookseller with the given ID. Ignores
771 completed and cancelled orders.
773 C<$booksellerid> contains the bookseller identifier
774 C<$grouped> contains 0 or 1. 0 means returns the list, 1 means return the total
775 C<$owner> contains 0 or 1. 0 means any owner. 1 means only the list of orders entered by the user itself.
777 C<$orders> is a reference-to-array; each element is a
778 reference-to-hash with the following fields:
779 C<$grouped> is a boolean that, if set to 1 will group all order lines of the same basket
780 in a single result line
784 =item C<authorizedby>
790 These give the value of the corresponding field in the aqorders table
791 of the Koha database.
797 Results are ordered from most to least recent.
801 sub GetPendingOrders {
802 my ($supplierid,$grouped,$owner,$basketno) = @_;
803 my $dbh = C4::Context->dbh;
805 SELECT ".($grouped?"count(*),":"")."aqbasket.basketno,
806 surname,firstname,aqorders.*,biblio.*,biblioitems.isbn,
807 aqbasket.closedate, aqbasket.creationdate, aqbasket.basketname
809 LEFT JOIN aqbasket ON aqbasket.basketno=aqorders.basketno
810 LEFT JOIN borrowers ON aqbasket.authorisedby=borrowers.borrowernumber
811 LEFT JOIN biblio ON biblio.biblionumber=aqorders.biblionumber
812 LEFT JOIN biblioitems ON biblioitems.biblionumber=biblio.biblionumber
814 AND (quantity > quantityreceived OR quantityreceived is NULL)
815 AND datecancellationprinted IS NULL
816 AND (to_days(now())-to_days(closedate) < 180 OR closedate IS NULL)
818 ## FIXME Why 180 days ???
819 my @query_params = ( $supplierid );
820 my $userenv = C4::Context->userenv;
821 if ( C4::Context->preference("IndependantBranches") ) {
822 if ( ($userenv) && ( $userenv->{flags} != 1 ) ) {
823 $strsth .= " and (borrowers.branchcode = ?
824 or borrowers.branchcode = '')";
825 push @query_params, $userenv->{branch};
829 $strsth .= " AND aqbasket.authorisedby=? ";
830 push @query_params, $userenv->{'number'};
833 $strsth .= " AND aqbasket.basketno=? ";
834 push @query_params, $basketno;
836 $strsth .= " group by aqbasket.basketno" if $grouped;
837 $strsth .= " order by aqbasket.basketno";
839 my $sth = $dbh->prepare($strsth);
840 $sth->execute( @query_params );
841 my $results = $sth->fetchall_arrayref({});
846 #------------------------------------------------------------#
852 @orders = &GetOrders($basketnumber, $orderby);
854 Looks up the pending (non-cancelled) orders with the given basket
855 number. If C<$booksellerID> is non-empty, only orders from that seller
859 C<&basket> returns a two-element array. C<@orders> is an array of
860 references-to-hash, whose keys are the fields from the aqorders,
861 biblio, and biblioitems tables in the Koha database.
868 my ( $basketno, $orderby ) = @_;
869 my $dbh = C4::Context->dbh;
871 SELECT biblio.*,biblioitems.*,
876 LEFT JOIN aqbudgets ON aqbudgets.budget_id = aqorders.budget_id
877 LEFT JOIN biblio ON biblio.biblionumber = aqorders.biblionumber
878 LEFT JOIN biblioitems ON biblioitems.biblionumber =biblio.biblionumber
880 AND (datecancellationprinted IS NULL OR datecancellationprinted='0000-00-00')
883 $orderby = "biblioitems.publishercode,biblio.title" unless $orderby;
884 $query .= " ORDER BY $orderby";
885 my $sth = $dbh->prepare($query);
886 $sth->execute($basketno);
887 my $results = $sth->fetchall_arrayref({});
892 #------------------------------------------------------------#
894 =head3 GetOrderNumber
898 $ordernumber = &GetOrderNumber($biblioitemnumber, $biblionumber);
902 Looks up the ordernumber with the given biblionumber and biblioitemnumber.
904 Returns the number of this order.
908 =item C<$ordernumber> is the order number.
914 my ( $biblionumber,$biblioitemnumber ) = @_;
915 my $dbh = C4::Context->dbh;
920 AND biblioitemnumber=?
922 my $sth = $dbh->prepare($query);
923 $sth->execute( $biblionumber, $biblioitemnumber );
925 return $sth->fetchrow;
928 #------------------------------------------------------------#
934 $order = &GetOrder($ordernumber);
936 Looks up an order by order number.
938 Returns a reference-to-hash describing the order. The keys of
939 C<$order> are fields from the biblio, biblioitems, aqorders tables of the Koha database.
946 my ($ordernumber) = @_;
947 my $dbh = C4::Context->dbh;
949 SELECT biblioitems.*, biblio.*, aqorders.*
951 LEFT JOIN biblio on biblio.biblionumber=aqorders.biblionumber
952 LEFT JOIN biblioitems on biblioitems.biblionumber=aqorders.biblionumber
953 WHERE aqorders.ordernumber=?
956 my $sth= $dbh->prepare($query);
957 $sth->execute($ordernumber);
958 my $data = $sth->fetchrow_hashref;
963 #------------------------------------------------------------#
969 &NewOrder(\%hashref);
971 Adds a new order to the database. Any argument that isn't described
972 below is the new value of the field with the same name in the aqorders
973 table of the Koha database.
977 =item $hashref->{'basketno'} is the basketno foreign key in aqorders, it is mandatory
980 =item $hashref->{'ordernumber'} is a "minimum order number."
982 =item $hashref->{'budgetdate'} is effectively ignored.
983 If it's undef (anything false) or the string 'now', the current day is used.
984 Else, the upcoming July 1st is used.
986 =item $hashref->{'subscription'} may be either "yes", or anything else for "no".
988 =item $hashref->{'uncertainprice'} may be 0 for "the price is known" or 1 for "the price is uncertain"
990 =item defaults entrydate to Now
992 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".
1001 my $orderinfo = shift;
1002 #### ------------------------------
1003 my $dbh = C4::Context->dbh;
1007 # if these parameters are missing, we can't continue
1008 for my $key (qw/basketno quantity biblionumber budget_id/) {
1009 die "Mandatory parameter $key missing" unless $orderinfo->{$key};
1012 if ( $orderinfo->{'subscription'} eq 'yes' ) {
1013 $orderinfo->{'subscription'} = 1;
1015 $orderinfo->{'subscription'} = 0;
1017 $orderinfo->{'entrydate'} ||= C4::Dates->new()->output("iso");
1019 my $ordernumber=InsertInTable("aqorders",$orderinfo);
1020 return ( $orderinfo->{'basketno'}, $ordernumber );
1025 #------------------------------------------------------------#
1039 #my ($biblioitemnumber,$ordernumber, $biblionumber) = @_;
1040 my ($itemnumber, $ordernumber) = @_;
1041 my $dbh = C4::Context->dbh;
1043 INSERT INTO aqorders_items
1044 (itemnumber, ordernumber)
1047 my $sth = $dbh->prepare($query);
1048 $sth->execute( $itemnumber, $ordernumber);
1051 #------------------------------------------------------------#
1057 &ModOrder(\%hashref);
1061 Modifies an existing order. Updates the order with order number
1062 $hashref->{'ordernumber'} and biblionumber $hashref->{'biblionumber'}. All other keys of the hash
1063 update the fields with the same name in the aqorders table of the Koha database.
1072 my $orderinfo = shift;
1074 die "Ordernumber is required" if $orderinfo->{'ordernumber'} eq '' ;
1075 die "Biblionumber is required" if $orderinfo->{'biblionumber'} eq '';
1077 my $dbh = C4::Context->dbh;
1079 # delete($orderinfo->{'branchcode'});
1080 # the hash contains a lot of entries not in aqorders, so get the columns ...
1081 my $sth = $dbh->prepare("SELECT * FROM aqorders LIMIT 1;");
1083 my $colnames = $sth->{NAME};
1084 my $query = "UPDATE aqorders SET ";
1086 foreach my $orderinfokey (grep(!/ordernumber/, keys %$orderinfo)){
1087 # ... and skip hash entries that are not in the aqorders table
1088 # FIXME : probably not the best way to do it (would be better to have a correct hash)
1089 next unless grep(/^$orderinfokey$/, @$colnames);
1090 $query .= "$orderinfokey=?, ";
1091 push(@params, $orderinfo->{$orderinfokey});
1094 $query .= "timestamp=NOW() WHERE ordernumber=?";
1095 # push(@params, $specorderinfo{'ordernumber'});
1096 push(@params, $orderinfo->{'ordernumber'} );
1097 $sth = $dbh->prepare($query);
1098 $sth->execute(@params);
1102 #------------------------------------------------------------#
1108 &ModOrderItem(\%hashref);
1112 Modifies the itemnumber in the aqorders_items table. The input hash needs three entities:
1113 - itemnumber: the old itemnumber
1114 - ordernumber: the order this item is attached to
1115 - newitemnumber: the new itemnumber we want to attach the line to
1124 my $orderiteminfo = shift;
1125 if (! $orderiteminfo->{'ordernumber'} || ! $orderiteminfo->{'itemnumber'} || ! $orderiteminfo->{'newitemnumber'}){
1126 die "Ordernumber, itemnumber and newitemnumber is required";
1129 my $dbh = C4::Context->dbh;
1131 my $query = "UPDATE aqorders_items set itemnumber=? where itemnumber=? and ordernumber=?";
1132 my @params = ($orderiteminfo->{'newitemnumber'}, $orderiteminfo->{'itemnumber'}, $orderiteminfo->{'ordernumber'});
1134 warn Data::Dumper::Dumper(@params);
1135 my $sth = $dbh->prepare($query);
1136 $sth->execute(@params);
1140 #------------------------------------------------------------#
1143 =head3 ModOrderBibliotemNumber
1147 &ModOrderBiblioitemNumber($biblioitemnumber,$ordernumber, $biblionumber);
1149 Modifies the biblioitemnumber for an existing order.
1150 Updates the order with order number C<$ordernum> and biblionumber C<$biblionumber>.
1156 #FIXME: is this used at all?
1157 sub ModOrderBiblioitemNumber {
1158 my ($biblioitemnumber,$ordernumber, $biblionumber) = @_;
1159 my $dbh = C4::Context->dbh;
1162 SET biblioitemnumber = ?
1163 WHERE ordernumber = ?
1164 AND biblionumber = ?";
1165 my $sth = $dbh->prepare($query);
1166 $sth->execute( $biblioitemnumber, $ordernumber, $biblionumber );
1169 #------------------------------------------------------------#
1171 =head3 ModReceiveOrder
1175 &ModReceiveOrder($biblionumber, $ordernumber, $quantityreceived, $user,
1176 $unitprice, $booksellerinvoicenumber, $biblioitemnumber,
1177 $freight, $bookfund, $rrp);
1179 Updates an order, to reflect the fact that it was received, at least
1180 in part. All arguments not mentioned below update the fields with the
1181 same name in the aqorders table of the Koha database.
1183 If a partial order is received, splits the order into two. The received
1184 portion must have a booksellerinvoicenumber.
1186 Updates the order with bibilionumber C<$biblionumber> and ordernumber
1194 sub ModReceiveOrder {
1196 $biblionumber, $ordernumber, $quantrec, $user, $cost,
1197 $invoiceno, $freight, $rrp, $budget_id, $datereceived
1200 my $dbh = C4::Context->dbh;
1201 # warn "DATE BEFORE : $daterecieved";
1202 # $daterecieved=POSIX::strftime("%Y-%m-%d",CORE::localtime) unless $daterecieved;
1203 # warn "DATE REC : $daterecieved";
1204 $datereceived = C4::Dates->output('iso') unless $datereceived;
1205 my $suggestionid = GetSuggestionFromBiblionumber( $dbh, $biblionumber );
1206 if ($suggestionid) {
1207 ModSuggestion( {suggestionid=>$suggestionid,
1208 STATUS=>'AVAILABLE',
1209 biblionumber=> $biblionumber}
1213 my $sth=$dbh->prepare("
1214 SELECT * FROM aqorders
1215 WHERE biblionumber=? AND aqorders.ordernumber=?");
1217 $sth->execute($biblionumber,$ordernumber);
1218 my $order = $sth->fetchrow_hashref();
1221 if ( $order->{quantity} > $quantrec ) {
1222 $sth=$dbh->prepare("
1224 SET quantityreceived=?
1226 , booksellerinvoicenumber=?
1231 WHERE biblionumber=? AND ordernumber=?");
1233 $sth->execute($quantrec,$datereceived,$invoiceno,$cost,$freight,$rrp,$quantrec,$biblionumber,$ordernumber);
1236 # create a new order for the remaining items, and set its bookfund.
1237 foreach my $orderkey ( "linenumber", "allocation" ) {
1238 delete($order->{'$orderkey'});
1240 $order->{'quantity'} -= $quantrec;
1241 $order->{'quantityreceived'} = 0;
1242 my $newOrder = NewOrder($order);
1244 $sth=$dbh->prepare("update aqorders
1245 set quantityreceived=?,datereceived=?,booksellerinvoicenumber=?,
1246 unitprice=?,freight=?,rrp=?
1247 where biblionumber=? and ordernumber=?");
1248 $sth->execute($quantrec,$datereceived,$invoiceno,$cost,$freight,$rrp,$biblionumber,$ordernumber);
1251 return $datereceived;
1253 #------------------------------------------------------------#
1257 @results = &SearchOrder($search, $biblionumber, $complete);
1259 Searches for orders.
1261 C<$search> may take one of several forms: if it is an ISBN,
1262 C<&ordersearch> returns orders with that ISBN. If C<$search> is an
1263 order number, C<&ordersearch> returns orders with that order number
1264 and biblionumber C<$biblionumber>. Otherwise, C<$search> is considered
1265 to be a space-separated list of search terms; in this case, all of the
1266 terms must appear in the title (matching the beginning of title
1269 If C<$complete> is C<yes>, the results will include only completed
1270 orders. In any case, C<&ordersearch> ignores cancelled orders.
1272 C<&ordersearch> returns an array.
1273 C<@results> is an array of references-to-hash with the following keys:
1279 =item C<seriestitle>
1290 #### -------- SearchOrder-------------------------------
1291 my ($ordernumber, $search, $supplierid, $basket) = @_;
1293 my $dbh = C4::Context->dbh;
1298 LEFT JOIN biblio ON aqorders.biblionumber=biblio.biblionumber
1299 LEFT JOIN biblioitems ON biblioitems.biblionumber=biblio.biblionumber
1300 LEFT JOIN aqbasket ON aqorders.basketno = aqbasket.basketno
1301 WHERE (datecancellationprinted is NULL)";
1304 $query .= " AND (aqorders.ordernumber=?)";
1305 push @args, $ordernumber;
1308 $query .= " AND (biblio.title like ? OR biblio.author LIKE ? OR biblioitems.isbn like ?)";
1309 push @args, ("%$search%","%$search%","%$search%");
1312 $query .= "AND aqbasket.booksellerid = ?";
1313 push @args, $supplierid;
1316 $query .= "AND aqorders.basketno = ?";
1317 push @args, $basket;
1320 my $sth = $dbh->prepare($query);
1321 $sth->execute(@args);
1322 my $results = $sth->fetchall_arrayref({});
1327 #------------------------------------------------------------#
1333 &DelOrder($biblionumber, $ordernumber);
1335 Cancel the order with the given order and biblio numbers. It does not
1336 delete any entries in the aqorders table, it merely marks them as
1344 my ( $bibnum, $ordernumber ) = @_;
1345 my $dbh = C4::Context->dbh;
1348 SET datecancellationprinted=now()
1349 WHERE biblionumber=? AND ordernumber=?
1351 my $sth = $dbh->prepare($query);
1352 $sth->execute( $bibnum, $ordernumber );
1356 =head2 FUNCTIONS ABOUT PARCELS
1360 #------------------------------------------------------------#
1366 @results = &GetParcel($booksellerid, $code, $date);
1368 Looks up all of the received items from the supplier with the given
1369 bookseller ID at the given date, for the given code (bookseller Invoice number). Ignores cancelled and completed orders.
1371 C<@results> is an array of references-to-hash. The keys of each element are fields from
1372 the aqorders, biblio, and biblioitems tables of the Koha database.
1374 C<@results> is sorted alphabetically by book title.
1381 #gets all orders from a certain supplier, orders them alphabetically
1382 my ( $supplierid, $code, $datereceived ) = @_;
1383 my $dbh = C4::Context->dbh;
1386 if $code; # add % if we search on a given code (otherwise, let him empty)
1388 SELECT authorisedby,
1393 aqorders.biblionumber,
1394 aqorders.ordernumber,
1396 aqorders.quantityreceived,
1403 LEFT JOIN aqbasket ON aqbasket.basketno=aqorders.basketno
1404 LEFT JOIN borrowers ON aqbasket.authorisedby=borrowers.borrowernumber
1405 LEFT JOIN biblio ON aqorders.biblionumber=biblio.biblionumber
1407 aqbasket.booksellerid = ?
1408 AND aqorders.booksellerinvoicenumber LIKE ?
1409 AND aqorders.datereceived = ? ";
1411 my @query_params = ( $supplierid, $code, $datereceived );
1412 if ( C4::Context->preference("IndependantBranches") ) {
1413 my $userenv = C4::Context->userenv;
1414 if ( ($userenv) && ( $userenv->{flags} != 1 ) ) {
1415 $strsth .= " and (borrowers.branchcode = ?
1416 or borrowers.branchcode = '')";
1417 push @query_params, $userenv->{branch};
1420 $strsth .= " ORDER BY aqbasket.basketno";
1421 # ## parcelinformation : $strsth
1422 my $sth = $dbh->prepare($strsth);
1423 $sth->execute( @query_params );
1424 while ( my $data = $sth->fetchrow_hashref ) {
1425 push( @results, $data );
1427 # ## countparcelbiblio: scalar(@results)
1433 #------------------------------------------------------------#
1439 $results = &GetParcels($bookseller, $order, $code, $datefrom, $dateto);
1440 get a lists of parcels.
1449 is the bookseller this function has to get parcels.
1452 To know on what criteria the results list has to be ordered.
1455 is the booksellerinvoicenumber.
1457 =item $datefrom & $dateto
1458 to know on what date this function has to filter its search.
1461 a pointer on a hash list containing parcel informations as such :
1465 =item Last operation
1467 =item Number of biblio
1469 =item Number of items
1476 my ($bookseller,$order, $code, $datefrom, $dateto) = @_;
1477 my $dbh = C4::Context->dbh;
1478 my @query_params = ();
1480 SELECT aqorders.booksellerinvoicenumber,
1481 datereceived,purchaseordernumber,
1482 count(DISTINCT biblionumber) AS biblio,
1483 sum(quantity) AS itemsexpected,
1484 sum(quantityreceived) AS itemsreceived
1485 FROM aqorders LEFT JOIN aqbasket ON aqbasket.basketno = aqorders.basketno
1486 WHERE aqbasket.booksellerid = $bookseller and datereceived IS NOT NULL
1489 if ( defined $code ) {
1490 $strsth .= ' and aqorders.booksellerinvoicenumber like ? ';
1491 # add a % to the end of the code to allow stemming.
1492 push @query_params, "$code%";
1495 if ( defined $datefrom ) {
1496 $strsth .= ' and datereceived >= ? ';
1497 push @query_params, $datefrom;
1500 if ( defined $dateto ) {
1501 $strsth .= 'and datereceived <= ? ';
1502 push @query_params, $dateto;
1505 $strsth .= "group by aqorders.booksellerinvoicenumber,datereceived ";
1507 # can't use a placeholder to place this column name.
1508 # but, we could probably be checking to make sure it is a column that will be fetched.
1509 $strsth .= "order by $order " if ($order);
1511 my $sth = $dbh->prepare($strsth);
1513 $sth->execute( @query_params );
1514 my $results = $sth->fetchall_arrayref({});
1519 #------------------------------------------------------------#
1521 =head3 GetLateOrders
1525 @results = &GetLateOrders;
1527 Searches for bookseller with late orders.
1530 the table of supplier with late issues. This table is full of hashref.
1538 my $supplierid = shift;
1541 my $dbh = C4::Context->dbh;
1543 #BEWARE, order of parenthesis and LEFT JOIN is important for speed
1544 my $dbdriver = C4::Context->config("db_scheme") || "mysql";
1546 my @query_params = ($delay); # delay is the first argument regardless
1548 SELECT aqbasket.basketno,
1549 aqorders.ordernumber,
1550 DATE(aqbasket.closedate) AS orderdate,
1551 aqorders.rrp AS unitpricesupplier,
1552 aqorders.ecost AS unitpricelib,
1553 aqbudgets.budget_name AS budget,
1554 borrowers.branchcode AS branch,
1555 aqbooksellers.name AS supplier,
1557 biblioitems.publishercode AS publisher,
1558 biblioitems.publicationyear,
1562 aqorders LEFT JOIN biblio ON biblio.biblionumber = aqorders.biblionumber
1563 LEFT JOIN biblioitems ON biblioitems.biblionumber = biblio.biblionumber
1564 LEFT JOIN aqbudgets ON aqorders.budget_id = aqbudgets.budget_id,
1565 aqbasket LEFT JOIN borrowers ON aqbasket.authorisedby = borrowers.borrowernumber
1566 LEFT JOIN aqbooksellers ON aqbasket.booksellerid = aqbooksellers.id
1567 WHERE aqorders.basketno = aqbasket.basketno
1568 AND ( datereceived = ''
1569 OR datereceived IS NULL
1570 OR aqorders.quantityreceived < aqorders.quantity
1574 if ($dbdriver eq "mysql") {
1576 aqorders.quantity - IFNULL(aqorders.quantityreceived,0) AS quantity,
1577 (aqorders.quantity - IFNULL(aqorders.quantityreceived,0)) * aqorders.rrp AS subtotal,
1578 DATEDIFF(CURDATE( ),closedate) AS latesince
1580 $from .= " AND (closedate <= DATE_SUB(CURDATE( ),INTERVAL ? DAY)) ";
1582 HAVING quantity <> 0
1583 AND unitpricesupplier <> 0
1584 AND unitpricelib <> 0
1587 # FIXME: account for IFNULL as above
1589 aqorders.quantity AS quantity,
1590 aqorders.quantity * aqorders.rrp AS subtotal,
1591 (CURDATE - closedate) AS latesince
1593 $from .= " AND (closedate <= (CURDATE -(INTERVAL ? DAY)) ";
1595 if (defined $supplierid) {
1596 $from .= ' AND aqbasket.booksellerid = ? ';
1597 push @query_params, $supplierid;
1599 if (defined $branch) {
1600 $from .= ' AND borrowers.branchcode LIKE ? ';
1601 push @query_params, $branch;
1603 if (C4::Context->preference("IndependantBranches")
1604 && C4::Context->userenv
1605 && C4::Context->userenv->{flags} != 1 ) {
1606 $from .= ' AND borrowers.branchcode LIKE ? ';
1607 push @query_params, C4::Context->userenv->{branch};
1609 my $query = "$select $from $having\nORDER BY latesince, basketno, borrowers.branchcode, supplier";
1610 $debug and print STDERR "GetLateOrders query: $query\nGetLateOrders args: " . join(" ",@query_params);
1611 my $sth = $dbh->prepare($query);
1612 $sth->execute(@query_params);
1614 while (my $data = $sth->fetchrow_hashref) {
1615 $data->{orderdate} = format_date($data->{orderdate});
1616 push @results, $data;
1621 #------------------------------------------------------------#
1627 (\@order_loop, $total_qty, $total_price, $total_qtyreceived) = GetHistory( $title, $author, $name, $from_placed_on, $to_placed_on );
1629 Retreives some acquisition history information
1632 $order_loop is a list of hashrefs that each look like this:
1634 'author' => 'Twain, Mark',
1636 'biblionumber' => '215',
1638 'creationdate' => 'MM/DD/YYYY',
1639 'datereceived' => undef,
1642 'invoicenumber' => undef,
1644 'ordernumber' => '1',
1646 'quantityreceived' => undef,
1647 'title' => 'The Adventures of Huckleberry Finn'
1649 $total_qty is the sum of all of the quantities in $order_loop
1650 $total_price is the cost of each in $order_loop times the quantity
1651 $total_qtyreceived is the sum of all of the quantityreceived entries in $order_loop
1658 my ( $title, $author, $name, $from_placed_on, $to_placed_on ) = @_;
1661 my $total_qtyreceived = 0;
1662 my $total_price = 0;
1664 # don't run the query if there are no parameters (list would be too long for sure !)
1665 if ( $title || $author || $name || $from_placed_on || $to_placed_on ) {
1666 my $dbh = C4::Context->dbh;
1672 name,aqbasket.creationdate,
1673 aqorders.datereceived,
1675 aqorders.quantityreceived,
1677 aqorders.ordernumber,
1678 aqorders.booksellerinvoicenumber as invoicenumber,
1679 aqbooksellers.id as id,
1680 aqorders.biblionumber
1682 LEFT JOIN aqbasket ON aqorders.basketno=aqbasket.basketno
1683 LEFT JOIN aqbooksellers ON aqbasket.booksellerid=aqbooksellers.id
1684 LEFT JOIN biblio ON biblio.biblionumber=aqorders.biblionumber";
1686 $query .= " LEFT JOIN borrowers ON aqbasket.authorisedby=borrowers.borrowernumber"
1687 if ( C4::Context->preference("IndependantBranches") );
1689 $query .= " WHERE (datecancellationprinted is NULL or datecancellationprinted='0000-00-00') ";
1691 my @query_params = ();
1693 if ( defined $title ) {
1694 $query .= " AND biblio.title LIKE ? ";
1695 push @query_params, "%$title%";
1698 if ( defined $author ) {
1699 $query .= " AND biblio.author LIKE ? ";
1700 push @query_params, "%$author%";
1703 if ( defined $name ) {
1704 $query .= " AND name LIKE ? ";
1705 push @query_params, "%$name%";
1708 if ( defined $from_placed_on ) {
1709 $query .= " AND creationdate >= ? ";
1710 push @query_params, $from_placed_on;
1713 if ( defined $to_placed_on ) {
1714 $query .= " AND creationdate <= ? ";
1715 push @query_params, $to_placed_on;
1718 if ( C4::Context->preference("IndependantBranches") ) {
1719 my $userenv = C4::Context->userenv;
1720 if ( ($userenv) && ( $userenv->{flags} != 1 ) ) {
1721 $query .= " AND (borrowers.branchcode = ? OR borrowers.branchcode ='' ) ";
1722 push @query_params, $userenv->{branch};
1725 $query .= " ORDER BY booksellerid";
1726 my $sth = $dbh->prepare($query);
1727 $sth->execute( @query_params );
1729 while ( my $line = $sth->fetchrow_hashref ) {
1730 $line->{count} = $cnt++;
1731 $line->{toggle} = 1 if $cnt % 2;
1732 push @order_loop, $line;
1733 $line->{creationdate} = format_date( $line->{creationdate} );
1734 $line->{datereceived} = format_date( $line->{datereceived} );
1735 $total_qty += $line->{'quantity'};
1736 $total_qtyreceived += $line->{'quantityreceived'};
1737 $total_price += $line->{'quantity'} * $line->{'ecost'};
1740 return \@order_loop, $total_qty, $total_price, $total_qtyreceived;
1743 =head2 GetRecentAcqui
1745 $results = GetRecentAcqui($days);
1747 C<$results> is a ref to a table which containts hashref
1751 sub GetRecentAcqui {
1753 my $dbh = C4::Context->dbh;
1757 ORDER BY timestamp DESC
1760 my $sth = $dbh->prepare($query);
1762 my $results = $sth->fetchall_arrayref({});
1770 $contractlist = &GetContracts($booksellerid, $activeonly);
1774 Looks up the contracts that belong to a bookseller
1776 Returns a list of contracts
1780 =item C<$booksellerid> is the "id" field in the "aqbooksellers" table.
1782 =item C<$activeonly> if exists get only contracts that are still active.
1788 my ( $booksellerid, $activeonly ) = @_;
1789 my $dbh = C4::Context->dbh;
1791 if (! $activeonly) {
1795 WHERE booksellerid=?
1800 WHERE booksellerid=?
1801 AND contractenddate >= CURDATE( )";
1803 my $sth = $dbh->prepare($query);
1804 $sth->execute( $booksellerid );
1806 while (my $data = $sth->fetchrow_hashref ) {
1807 push(@results, $data);
1813 #------------------------------------------------------------#
1819 $contract = &GetContract($contractID);
1821 Looks up the contract that has PRIMKEY (contractnumber) value $contractID
1829 my ( $contractno ) = @_;
1830 my $dbh = C4::Context->dbh;
1834 WHERE contractnumber=?
1837 my $sth = $dbh->prepare($query);
1838 $sth->execute( $contractno );
1839 my $result = $sth->fetchrow_hashref;
1848 Koha Developement team <info@koha.org>