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 );
169 Create a new basket in aqbasket table
171 =item C<$booksellerid> is a foreign key in the aqbasket table
173 =item C<$authorizedby> is the username of who created the basket
175 The other parameters are optional, see ModBasketHeader for more info on them.
181 # FIXME : this function seems to be unused.
184 my ( $booksellerid, $authorisedby, $basketname, $basketnote, $basketbooksellernote, $basketcontractnumber ) = @_;
185 my $dbh = C4::Context->dbh;
188 (creationdate,booksellerid,authorisedby)
189 VALUES (now(),'$booksellerid','$authorisedby')
193 #find & return basketno MYSQL dependant, but $dbh->last_insert_id always returns null :-(
194 my $basket = $dbh->{'mysql_insertid'};
195 ModBasketHeader($basket, $basketname || '', $basketnote || '', $basketbooksellernote || '', $basketcontractnumber || undef);
199 #------------------------------------------------------------#
205 &CloseBasket($basketno);
207 close a basket (becomes unmodifiable,except for recieves)
215 my $dbh = C4::Context->dbh;
221 my $sth = $dbh->prepare($query);
222 $sth->execute($basketno);
225 #------------------------------------------------------------#
227 =head3 GetBasketAsCSV
231 &GetBasketAsCSV($basketno);
233 Export a basket as CSV
240 my $basket = GetBasket($basketno);
241 my @orders = GetOrders($basketno);
242 my $contract = GetContract($basket->{'contractnumber'});
243 my $csv = Text::CSV->new();
246 # TODO: Translate headers
247 my @headers = qw(contractname ordernumber line entrydate isbn author title publishercode collectiontitle notes quantity rrp);
249 $csv->combine(@headers);
250 $output = $csv->string() . "\n";
253 foreach my $order (@orders) {
255 my $bd = GetBiblioData($order->{'biblionumber'});
257 $contract->{'contractname'},
258 $order->{'ordernumber'},
259 $order->{'entrydate'},
263 $bd->{'publishercode'},
264 $bd->{'collectiontitle'},
266 $order->{'quantity'},
269 push (@rows, \@cols);
272 # Sort by publishercode
273 # TODO: Sort by publishercode then by title
274 @rows = sort { @$a[7] cmp @$b[7] } @rows;
276 foreach my $row (@rows) {
277 $csv->combine(@$row);
278 $output .= $csv->string() . "\n";
287 =head3 CloseBasketgroup
291 &CloseBasketgroup($basketgroupno);
299 sub CloseBasketgroup {
300 my ($basketgroupno) = @_;
301 my $dbh = C4::Context->dbh;
302 my $sth = $dbh->prepare("
303 UPDATE aqbasketgroups
307 $sth->execute($basketgroupno);
310 #------------------------------------------------------------#
312 =head3 ReOpenBaskergroup($basketgroupno)
316 &ReOpenBaskergroup($basketgroupno);
324 sub ReOpenBasketgroup {
325 my ($basketgroupno) = @_;
326 my $dbh = C4::Context->dbh;
327 my $sth = $dbh->prepare("
328 UPDATE aqbasketgroups
332 $sth->execute($basketgroupno);
335 #------------------------------------------------------------#
342 &DelBasket($basketno);
344 Deletes the basket that has basketno field $basketno in the aqbasket table.
348 =item C<$basketno> is the primary key of the basket in the aqbasket table.
356 my ( $basketno ) = @_;
357 my $query = "DELETE FROM aqbasket WHERE basketno=?";
358 my $dbh = C4::Context->dbh;
359 my $sth = $dbh->prepare($query);
360 $sth->execute($basketno);
364 #------------------------------------------------------------#
370 &ModBasket($basketinfo);
372 Modifies a basket, using a hashref $basketinfo for the relevant information, only $basketinfo->{'basketno'} is required.
376 =item C<$basketno> is the primary key of the basket in the aqbasket table.
384 my $basketinfo = shift;
385 my $query = "UPDATE aqbasket SET ";
387 foreach my $key (keys %$basketinfo){
388 if ($key ne 'basketno'){
389 $query .= "$key=?, ";
390 push(@params, $basketinfo->{$key} || undef );
393 # get rid of the "," at the end of $query
394 if (substr($query, length($query)-2) eq ', '){
399 $query .= "WHERE basketno=?";
400 push(@params, $basketinfo->{'basketno'});
401 my $dbh = C4::Context->dbh;
402 my $sth = $dbh->prepare($query);
403 $sth->execute(@params);
407 #------------------------------------------------------------#
409 =head3 ModBasketHeader
413 &ModBasketHeader($basketno, $basketname, $note, $booksellernote, $contractnumber);
415 Modifies a basket's header.
419 =item C<$basketno> is the "basketno" field in the "aqbasket" table;
421 =item C<$basketname> is the "basketname" field in the "aqbasket" table;
423 =item C<$note> is the "note" field in the "aqbasket" table;
425 =item C<$booksellernote> is the "booksellernote" field in the "aqbasket" table;
427 =item C<$contractnumber> is the "contractnumber" (foreign) key in the "aqbasket" table.
434 sub ModBasketHeader {
435 my ($basketno, $basketname, $note, $booksellernote, $contractnumber) = @_;
436 my $query = "UPDATE aqbasket SET basketname=?, note=?, booksellernote=? WHERE basketno=?";
437 my $dbh = C4::Context->dbh;
438 my $sth = $dbh->prepare($query);
439 $sth->execute($basketname,$note,$booksellernote,$basketno);
440 if ( $contractnumber ) {
441 my $query2 ="UPDATE aqbasket SET contractnumber=? WHERE basketno=?";
442 my $sth2 = $dbh->prepare($query2);
443 $sth2->execute($contractnumber,$basketno);
449 #------------------------------------------------------------#
451 =head3 GetBasketsByBookseller
455 @results = &GetBasketsByBookseller($booksellerid, $extra);
457 Returns a list of hashes of all the baskets that belong to bookseller 'booksellerid'.
461 =item C<$booksellerid> is the 'id' field of the bookseller in the aqbooksellers table
463 =item C<$extra> is the extra sql parameters, can be
465 - $extra->{groupby}: group baskets by column
466 ex. $extra->{groupby} = aqbasket.basketgroupid
467 - $extra->{orderby}: order baskets by column
468 - $extra->{limit}: limit number of results (can be helpful for pagination)
476 sub GetBasketsByBookseller {
477 my ($booksellerid, $extra) = @_;
478 my $query = "SELECT * FROM aqbasket WHERE booksellerid=?";
480 if ($extra->{groupby}) {
481 $query .= " GROUP by $extra->{groupby}";
483 if ($extra->{orderby}){
484 $query .= " ORDER by $extra->{orderby}";
486 if ($extra->{limit}){
487 $query .= " LIMIT $extra->{limit}";
490 my $dbh = C4::Context->dbh;
491 my $sth = $dbh->prepare($query);
492 $sth->execute($booksellerid);
493 my $results = $sth->fetchall_arrayref({});
498 #------------------------------------------------------------#
500 =head3 GetBasketsByBasketgroup
504 $baskets = &GetBasketsByBasketgroup($basketgroupid);
508 Returns a reference to all baskets that belong to basketgroup $basketgroupid.
516 sub GetBasketsByBasketgroup {
517 my $basketgroupid = shift;
518 my $query = "SELECT * FROM aqbasket
519 LEFT JOIN aqcontract USING(contractnumber) WHERE basketgroupid=?";
520 my $dbh = C4::Context->dbh;
521 my $sth = $dbh->prepare($query);
522 $sth->execute($basketgroupid);
523 my $results = $sth->fetchall_arrayref({});
528 #------------------------------------------------------------#
530 =head3 NewBasketgroup
534 $basketgroupid = NewBasketgroup(\%hashref);
538 Adds a basketgroup to the aqbasketgroups table, and add the initial baskets to it.
540 $hashref->{'booksellerid'} is the 'id' field of the bookseller in the aqbooksellers table,
542 $hashref->{'name'} is the 'name' field of the basketgroup in the aqbasketgroups table,
544 $hashref->{'basketlist'} is a list reference of the 'id's of the baskets that belong to this group,
546 $hashref->{'deliveryplace'} is the 'deliveryplace' field of the basketgroup in the aqbasketgroups table,
548 $hashref->{'deliverycomment'} is the 'deliverycomment' field of the basketgroup in the aqbasketgroups table,
550 $hashref->{'closed'} is the 'closed' field of the aqbasketgroups table, it is false if 0, true otherwise.
559 my $basketgroupinfo = shift;
560 die "booksellerid is required to create a basketgroup" unless $basketgroupinfo->{'booksellerid'};
561 my $query = "INSERT INTO aqbasketgroups (";
563 foreach my $field ('name', 'deliveryplace', 'deliverycomment', 'closed') {
564 if ( $basketgroupinfo->{$field} ) {
565 $query .= "$field, ";
566 push(@params, $basketgroupinfo->{$field});
569 $query .= "booksellerid) VALUES (";
574 push(@params, $basketgroupinfo->{'booksellerid'});
575 my $dbh = C4::Context->dbh;
576 my $sth = $dbh->prepare($query);
577 $sth->execute(@params);
578 my $basketgroupid = $dbh->{'mysql_insertid'};
579 if( $basketgroupinfo->{'basketlist'} ) {
580 foreach my $basketno (@{$basketgroupinfo->{'basketlist'}}) {
581 my $query2 = "UPDATE aqbasket SET basketgroupid=? WHERE basketno=?";
582 my $sth2 = $dbh->prepare($query2);
583 $sth2->execute($basketgroupid, $basketno);
586 return $basketgroupid;
589 #------------------------------------------------------------#
591 =head3 ModBasketgroup
595 ModBasketgroup(\%hashref);
599 Modifies a basketgroup in the aqbasketgroups table, and add the baskets to it.
601 $hashref->{'id'} is the 'id' field of the basketgroup in the aqbasketgroup table, this parameter is mandatory,
603 $hashref->{'name'} is the 'name' field of the basketgroup in the aqbasketgroups table,
605 $hashref->{'basketlist'} is a list reference of the 'id's of the baskets that belong to this group,
607 $hashref->{'billingplace'} is the 'billingplace' field of the basketgroup in the aqbasketgroups table,
609 $hashref->{'deliveryplace'} is the 'deliveryplace' field of the basketgroup in the aqbasketgroups table,
611 $hashref->{'deliverycomment'} is the 'deliverycomment' field of the basketgroup in the aqbasketgroups table,
613 $hashref->{'closed'} is the 'closed' field of the aqbasketgroups table, it is false if 0, true otherwise.
622 my $basketgroupinfo = shift;
623 die "basketgroup id is required to edit a basketgroup" unless $basketgroupinfo->{'id'};
624 my $dbh = C4::Context->dbh;
625 my $query = "UPDATE aqbasketgroups SET ";
627 foreach my $field (qw(name billingplace deliveryplace deliverycomment closed)) {
628 if ( defined $basketgroupinfo->{$field} ) {
629 $query .= "$field=?, ";
630 push(@params, $basketgroupinfo->{$field});
635 $query .= " WHERE id=?";
636 push(@params, $basketgroupinfo->{'id'});
637 my $sth = $dbh->prepare($query);
638 $sth->execute(@params);
640 $sth = $dbh->prepare('UPDATE aqbasket SET basketgroupid = NULL WHERE basketgroupid = ?');
641 $sth->execute($basketgroupinfo->{'id'});
643 if($basketgroupinfo->{'basketlist'} && @{$basketgroupinfo->{'basketlist'}}){
644 $sth = $dbh->prepare("UPDATE aqbasket SET basketgroupid=? WHERE basketno=?");
645 foreach my $basketno (@{$basketgroupinfo->{'basketlist'}}) {
646 $sth->execute($basketgroupinfo->{'id'}, $basketno);
653 #------------------------------------------------------------#
655 =head3 DelBasketgroup
659 DelBasketgroup($basketgroupid);
663 Deletes a basketgroup in the aqbasketgroups table, and removes the reference to it from the baskets,
665 =item C<$basketgroupid> is the 'id' field of the basket in the aqbasketgroup table
674 my $basketgroupid = shift;
675 die "basketgroup id is required to edit a basketgroup" unless $basketgroupid;
676 my $query = "DELETE FROM aqbasketgroups WHERE id=?";
677 my $dbh = C4::Context->dbh;
678 my $sth = $dbh->prepare($query);
679 $sth->execute($basketgroupid);
683 #------------------------------------------------------------#
687 =head2 FUNCTIONS ABOUT ORDERS
693 =head3 GetBasketgroup
697 $basketgroup = &GetBasketgroup($basketgroupid);
701 Returns a reference to the hash containing all infermation about the basketgroup.
710 my $basketgroupid = shift;
711 die "basketgroup id is required to edit a basketgroup" unless $basketgroupid;
712 my $query = "SELECT * FROM aqbasketgroups WHERE id=?";
713 my $dbh = C4::Context->dbh;
714 my $sth = $dbh->prepare($query);
715 $sth->execute($basketgroupid);
716 my $result = $sth->fetchrow_hashref;
721 #------------------------------------------------------------#
723 =head3 GetBasketgroups
727 $basketgroups = &GetBasketgroups($booksellerid);
731 Returns a reference to the array of all the basketgroups of bookseller $booksellerid.
739 sub GetBasketgroups {
740 my $booksellerid = shift;
741 die "bookseller id is required to edit a basketgroup" unless $booksellerid;
742 my $query = "SELECT * FROM aqbasketgroups WHERE booksellerid=?";
743 my $dbh = C4::Context->dbh;
744 my $sth = $dbh->prepare($query);
745 $sth->execute($booksellerid);
746 my $results = $sth->fetchall_arrayref({});
751 #------------------------------------------------------------#
755 =head2 FUNCTIONS ABOUT ORDERS
761 #------------------------------------------------------------#
763 =head3 GetPendingOrders
767 $orders = &GetPendingOrders($booksellerid, $grouped, $owner);
769 Finds pending orders from the bookseller with the given ID. Ignores
770 completed and cancelled orders.
772 C<$booksellerid> contains the bookseller identifier
773 C<$grouped> contains 0 or 1. 0 means returns the list, 1 means return the total
774 C<$owner> contains 0 or 1. 0 means any owner. 1 means only the list of orders entered by the user itself.
776 C<$orders> is a reference-to-array; each element is a
777 reference-to-hash with the following fields:
778 C<$grouped> is a boolean that, if set to 1 will group all order lines of the same basket
779 in a single result line
783 =item C<authorizedby>
789 These give the value of the corresponding field in the aqorders table
790 of the Koha database.
796 Results are ordered from most to least recent.
800 sub GetPendingOrders {
801 my ($supplierid,$grouped,$owner,$basketno) = @_;
802 my $dbh = C4::Context->dbh;
804 SELECT ".($grouped?"count(*),":"")."aqbasket.basketno,
805 surname,firstname,aqorders.*,biblio.*,biblioitems.isbn,
806 aqbasket.closedate, aqbasket.creationdate, aqbasket.basketname
808 LEFT JOIN aqbasket ON aqbasket.basketno=aqorders.basketno
809 LEFT JOIN borrowers ON aqbasket.authorisedby=borrowers.borrowernumber
810 LEFT JOIN biblio ON biblio.biblionumber=aqorders.biblionumber
811 LEFT JOIN biblioitems ON biblioitems.biblionumber=biblio.biblionumber
813 AND (quantity > quantityreceived OR quantityreceived is NULL)
814 AND datecancellationprinted IS NULL
815 AND (to_days(now())-to_days(closedate) < 180 OR closedate IS NULL)
817 ## FIXME Why 180 days ???
818 my @query_params = ( $supplierid );
819 my $userenv = C4::Context->userenv;
820 if ( C4::Context->preference("IndependantBranches") ) {
821 if ( ($userenv) && ( $userenv->{flags} != 1 ) ) {
822 $strsth .= " and (borrowers.branchcode = ?
823 or borrowers.branchcode = '')";
824 push @query_params, $userenv->{branch};
828 $strsth .= " AND aqbasket.authorisedby=? ";
829 push @query_params, $userenv->{'number'};
832 $strsth .= " AND aqbasket.basketno=? ";
833 push @query_params, $basketno;
835 $strsth .= " group by aqbasket.basketno" if $grouped;
836 $strsth .= " order by aqbasket.basketno";
838 my $sth = $dbh->prepare($strsth);
839 $sth->execute( @query_params );
840 my $results = $sth->fetchall_arrayref({});
845 #------------------------------------------------------------#
851 @orders = &GetOrders($basketnumber, $orderby);
853 Looks up the pending (non-cancelled) orders with the given basket
854 number. If C<$booksellerID> is non-empty, only orders from that seller
858 C<&basket> returns a two-element array. C<@orders> is an array of
859 references-to-hash, whose keys are the fields from the aqorders,
860 biblio, and biblioitems tables in the Koha database.
867 my ( $basketno, $orderby ) = @_;
868 my $dbh = C4::Context->dbh;
870 SELECT biblio.*,biblioitems.*,
875 LEFT JOIN aqbudgets ON aqbudgets.budget_id = aqorders.budget_id
876 LEFT JOIN biblio ON biblio.biblionumber = aqorders.biblionumber
877 LEFT JOIN biblioitems ON biblioitems.biblionumber =biblio.biblionumber
879 AND (datecancellationprinted IS NULL OR datecancellationprinted='0000-00-00')
882 $orderby = "biblioitems.publishercode,biblio.title" unless $orderby;
883 $query .= " ORDER BY $orderby";
884 my $sth = $dbh->prepare($query);
885 $sth->execute($basketno);
886 my $results = $sth->fetchall_arrayref({});
891 #------------------------------------------------------------#
893 =head3 GetOrderNumber
897 $ordernumber = &GetOrderNumber($biblioitemnumber, $biblionumber);
901 Looks up the ordernumber with the given biblionumber and biblioitemnumber.
903 Returns the number of this order.
907 =item C<$ordernumber> is the order number.
913 my ( $biblionumber,$biblioitemnumber ) = @_;
914 my $dbh = C4::Context->dbh;
919 AND biblioitemnumber=?
921 my $sth = $dbh->prepare($query);
922 $sth->execute( $biblionumber, $biblioitemnumber );
924 return $sth->fetchrow;
927 #------------------------------------------------------------#
933 $order = &GetOrder($ordernumber);
935 Looks up an order by order number.
937 Returns a reference-to-hash describing the order. The keys of
938 C<$order> are fields from the biblio, biblioitems, aqorders tables of the Koha database.
945 my ($ordernumber) = @_;
946 my $dbh = C4::Context->dbh;
948 SELECT biblioitems.*, biblio.*, aqorders.*
950 LEFT JOIN biblio on biblio.biblionumber=aqorders.biblionumber
951 LEFT JOIN biblioitems on biblioitems.biblionumber=aqorders.biblionumber
952 WHERE aqorders.ordernumber=?
955 my $sth= $dbh->prepare($query);
956 $sth->execute($ordernumber);
957 my $data = $sth->fetchrow_hashref;
962 #------------------------------------------------------------#
968 &NewOrder(\%hashref);
970 Adds a new order to the database. Any argument that isn't described
971 below is the new value of the field with the same name in the aqorders
972 table of the Koha database.
976 =item $hashref->{'basketno'} is the basketno foreign key in aqorders, it is mandatory
979 =item $hashref->{'ordernumber'} is a "minimum order number."
981 =item $hashref->{'budgetdate'} is effectively ignored.
982 If it's undef (anything false) or the string 'now', the current day is used.
983 Else, the upcoming July 1st is used.
985 =item $hashref->{'subscription'} may be either "yes", or anything else for "no".
987 =item $hashref->{'uncertainprice'} may be 0 for "the price is known" or 1 for "the price is uncertain"
989 =item defaults entrydate to Now
991 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".
1000 my $orderinfo = shift;
1001 #### ------------------------------
1002 my $dbh = C4::Context->dbh;
1006 # if these parameters are missing, we can't continue
1007 for my $key (qw/basketno quantity biblionumber budget_id/) {
1008 die "Mandatory parameter $key missing" unless $orderinfo->{$key};
1011 if ( $orderinfo->{'subscription'} eq 'yes' ) {
1012 $orderinfo->{'subscription'} = 1;
1014 $orderinfo->{'subscription'} = 0;
1016 $orderinfo->{'entrydate'} ||= C4::Dates->new()->output("iso");
1018 my $ordernumber=InsertInTable("aqorders",$orderinfo);
1019 return ( $orderinfo->{'basketno'}, $ordernumber );
1024 #------------------------------------------------------------#
1038 #my ($biblioitemnumber,$ordernumber, $biblionumber) = @_;
1039 my ($itemnumber, $ordernumber) = @_;
1040 my $dbh = C4::Context->dbh;
1042 INSERT INTO aqorders_items
1043 (itemnumber, ordernumber)
1046 my $sth = $dbh->prepare($query);
1047 $sth->execute( $itemnumber, $ordernumber);
1050 #------------------------------------------------------------#
1056 &ModOrder(\%hashref);
1060 Modifies an existing order. Updates the order with order number
1061 $hashref->{'ordernumber'} and biblionumber $hashref->{'biblionumber'}. All other keys of the hash
1062 update the fields with the same name in the aqorders table of the Koha database.
1071 my $orderinfo = shift;
1073 die "Ordernumber is required" if $orderinfo->{'ordernumber'} eq '' ;
1074 die "Biblionumber is required" if $orderinfo->{'biblionumber'} eq '';
1076 my $dbh = C4::Context->dbh;
1078 # delete($orderinfo->{'branchcode'});
1079 # the hash contains a lot of entries not in aqorders, so get the columns ...
1080 my $sth = $dbh->prepare("SELECT * FROM aqorders LIMIT 1;");
1082 my $colnames = $sth->{NAME};
1083 my $query = "UPDATE aqorders SET ";
1085 foreach my $orderinfokey (grep(!/ordernumber/, keys %$orderinfo)){
1086 # ... and skip hash entries that are not in the aqorders table
1087 # FIXME : probably not the best way to do it (would be better to have a correct hash)
1088 next unless grep(/^$orderinfokey$/, @$colnames);
1089 $query .= "$orderinfokey=?, ";
1090 push(@params, $orderinfo->{$orderinfokey});
1093 $query .= "timestamp=NOW() WHERE ordernumber=?";
1094 # push(@params, $specorderinfo{'ordernumber'});
1095 push(@params, $orderinfo->{'ordernumber'} );
1096 $sth = $dbh->prepare($query);
1097 $sth->execute(@params);
1101 #------------------------------------------------------------#
1107 &ModOrderItem(\%hashref);
1111 Modifies the itemnumber in the aqorders_items table. The input hash needs three entities:
1112 - itemnumber: the old itemnumber
1113 - ordernumber: the order this item is attached to
1114 - newitemnumber: the new itemnumber we want to attach the line to
1123 my $orderiteminfo = shift;
1124 if (! $orderiteminfo->{'ordernumber'} || ! $orderiteminfo->{'itemnumber'} || ! $orderiteminfo->{'newitemnumber'}){
1125 die "Ordernumber, itemnumber and newitemnumber is required";
1128 my $dbh = C4::Context->dbh;
1130 my $query = "UPDATE aqorders_items set itemnumber=? where itemnumber=? and ordernumber=?";
1131 my @params = ($orderiteminfo->{'newitemnumber'}, $orderiteminfo->{'itemnumber'}, $orderiteminfo->{'ordernumber'});
1133 warn Data::Dumper::Dumper(@params);
1134 my $sth = $dbh->prepare($query);
1135 $sth->execute(@params);
1139 #------------------------------------------------------------#
1142 =head3 ModOrderBibliotemNumber
1146 &ModOrderBiblioitemNumber($biblioitemnumber,$ordernumber, $biblionumber);
1148 Modifies the biblioitemnumber for an existing order.
1149 Updates the order with order number C<$ordernum> and biblionumber C<$biblionumber>.
1155 #FIXME: is this used at all?
1156 sub ModOrderBiblioitemNumber {
1157 my ($biblioitemnumber,$ordernumber, $biblionumber) = @_;
1158 my $dbh = C4::Context->dbh;
1161 SET biblioitemnumber = ?
1162 WHERE ordernumber = ?
1163 AND biblionumber = ?";
1164 my $sth = $dbh->prepare($query);
1165 $sth->execute( $biblioitemnumber, $ordernumber, $biblionumber );
1168 #------------------------------------------------------------#
1170 =head3 ModReceiveOrder
1174 &ModReceiveOrder($biblionumber, $ordernumber, $quantityreceived, $user,
1175 $unitprice, $booksellerinvoicenumber, $biblioitemnumber,
1176 $freight, $bookfund, $rrp);
1178 Updates an order, to reflect the fact that it was received, at least
1179 in part. All arguments not mentioned below update the fields with the
1180 same name in the aqorders table of the Koha database.
1182 If a partial order is received, splits the order into two. The received
1183 portion must have a booksellerinvoicenumber.
1185 Updates the order with bibilionumber C<$biblionumber> and ordernumber
1193 sub ModReceiveOrder {
1195 $biblionumber, $ordernumber, $quantrec, $user, $cost,
1196 $invoiceno, $freight, $rrp, $budget_id, $datereceived
1199 my $dbh = C4::Context->dbh;
1200 # warn "DATE BEFORE : $daterecieved";
1201 # $daterecieved=POSIX::strftime("%Y-%m-%d",CORE::localtime) unless $daterecieved;
1202 # warn "DATE REC : $daterecieved";
1203 $datereceived = C4::Dates->output('iso') unless $datereceived;
1204 my $suggestionid = GetSuggestionFromBiblionumber( $dbh, $biblionumber );
1205 if ($suggestionid) {
1206 ModSuggestion( {suggestionid=>$suggestionid,
1207 STATUS=>'AVAILABLE',
1208 biblionumber=> $biblionumber}
1212 my $sth=$dbh->prepare("
1213 SELECT * FROM aqorders
1214 WHERE biblionumber=? AND aqorders.ordernumber=?");
1216 $sth->execute($biblionumber,$ordernumber);
1217 my $order = $sth->fetchrow_hashref();
1220 if ( $order->{quantity} > $quantrec ) {
1221 $sth=$dbh->prepare("
1223 SET quantityreceived=?
1225 , booksellerinvoicenumber=?
1230 WHERE biblionumber=? AND ordernumber=?");
1232 $sth->execute($quantrec,$datereceived,$invoiceno,$cost,$freight,$rrp,$quantrec,$biblionumber,$ordernumber);
1235 # create a new order for the remaining items, and set its bookfund.
1236 foreach my $orderkey ( "linenumber", "allocation" ) {
1237 delete($order->{'$orderkey'});
1239 $order->{'quantity'} -= $quantrec;
1240 $order->{'quantityreceived'} = 0;
1241 my $newOrder = NewOrder($order);
1243 $sth=$dbh->prepare("update aqorders
1244 set quantityreceived=?,datereceived=?,booksellerinvoicenumber=?,
1245 unitprice=?,freight=?,rrp=?
1246 where biblionumber=? and ordernumber=?");
1247 $sth->execute($quantrec,$datereceived,$invoiceno,$cost,$freight,$rrp,$biblionumber,$ordernumber);
1250 return $datereceived;
1252 #------------------------------------------------------------#
1256 @results = &SearchOrder($search, $biblionumber, $complete);
1258 Searches for orders.
1260 C<$search> may take one of several forms: if it is an ISBN,
1261 C<&ordersearch> returns orders with that ISBN. If C<$search> is an
1262 order number, C<&ordersearch> returns orders with that order number
1263 and biblionumber C<$biblionumber>. Otherwise, C<$search> is considered
1264 to be a space-separated list of search terms; in this case, all of the
1265 terms must appear in the title (matching the beginning of title
1268 If C<$complete> is C<yes>, the results will include only completed
1269 orders. In any case, C<&ordersearch> ignores cancelled orders.
1271 C<&ordersearch> returns an array.
1272 C<@results> is an array of references-to-hash with the following keys:
1278 =item C<seriestitle>
1289 #### -------- SearchOrder-------------------------------
1290 my ($ordernumber, $search, $supplierid, $basket) = @_;
1292 my $dbh = C4::Context->dbh;
1297 LEFT JOIN biblio ON aqorders.biblionumber=biblio.biblionumber
1298 LEFT JOIN biblioitems ON biblioitems.biblionumber=biblio.biblionumber
1299 LEFT JOIN aqbasket ON aqorders.basketno = aqbasket.basketno
1300 WHERE (datecancellationprinted is NULL)";
1303 $query .= " AND (aqorders.ordernumber=?)";
1304 push @args, $ordernumber;
1307 $query .= " AND (biblio.title like ? OR biblio.author LIKE ? OR biblioitems.isbn like ?)";
1308 push @args, ("%$search%","%$search%","%$search%");
1311 $query .= "AND aqbasket.booksellerid = ?";
1312 push @args, $supplierid;
1315 $query .= "AND aqorders.basketno = ?";
1316 push @args, $basket;
1319 my $sth = $dbh->prepare($query);
1320 $sth->execute(@args);
1321 my $results = $sth->fetchall_arrayref({});
1326 #------------------------------------------------------------#
1332 &DelOrder($biblionumber, $ordernumber);
1334 Cancel the order with the given order and biblio numbers. It does not
1335 delete any entries in the aqorders table, it merely marks them as
1343 my ( $bibnum, $ordernumber ) = @_;
1344 my $dbh = C4::Context->dbh;
1347 SET datecancellationprinted=now()
1348 WHERE biblionumber=? AND ordernumber=?
1350 my $sth = $dbh->prepare($query);
1351 $sth->execute( $bibnum, $ordernumber );
1355 =head2 FUNCTIONS ABOUT PARCELS
1359 #------------------------------------------------------------#
1365 @results = &GetParcel($booksellerid, $code, $date);
1367 Looks up all of the received items from the supplier with the given
1368 bookseller ID at the given date, for the given code (bookseller Invoice number). Ignores cancelled and completed orders.
1370 C<@results> is an array of references-to-hash. The keys of each element are fields from
1371 the aqorders, biblio, and biblioitems tables of the Koha database.
1373 C<@results> is sorted alphabetically by book title.
1380 #gets all orders from a certain supplier, orders them alphabetically
1381 my ( $supplierid, $code, $datereceived ) = @_;
1382 my $dbh = C4::Context->dbh;
1385 if $code; # add % if we search on a given code (otherwise, let him empty)
1387 SELECT authorisedby,
1392 aqorders.biblionumber,
1393 aqorders.ordernumber,
1395 aqorders.quantityreceived,
1402 LEFT JOIN aqbasket ON aqbasket.basketno=aqorders.basketno
1403 LEFT JOIN borrowers ON aqbasket.authorisedby=borrowers.borrowernumber
1404 LEFT JOIN biblio ON aqorders.biblionumber=biblio.biblionumber
1406 aqbasket.booksellerid = ?
1407 AND aqorders.booksellerinvoicenumber LIKE ?
1408 AND aqorders.datereceived = ? ";
1410 my @query_params = ( $supplierid, $code, $datereceived );
1411 if ( C4::Context->preference("IndependantBranches") ) {
1412 my $userenv = C4::Context->userenv;
1413 if ( ($userenv) && ( $userenv->{flags} != 1 ) ) {
1414 $strsth .= " and (borrowers.branchcode = ?
1415 or borrowers.branchcode = '')";
1416 push @query_params, $userenv->{branch};
1419 $strsth .= " ORDER BY aqbasket.basketno";
1420 # ## parcelinformation : $strsth
1421 my $sth = $dbh->prepare($strsth);
1422 $sth->execute( @query_params );
1423 while ( my $data = $sth->fetchrow_hashref ) {
1424 push( @results, $data );
1426 # ## countparcelbiblio: scalar(@results)
1432 #------------------------------------------------------------#
1438 $results = &GetParcels($bookseller, $order, $code, $datefrom, $dateto);
1439 get a lists of parcels.
1448 is the bookseller this function has to get parcels.
1451 To know on what criteria the results list has to be ordered.
1454 is the booksellerinvoicenumber.
1456 =item $datefrom & $dateto
1457 to know on what date this function has to filter its search.
1460 a pointer on a hash list containing parcel informations as such :
1464 =item Last operation
1466 =item Number of biblio
1468 =item Number of items
1475 my ($bookseller,$order, $code, $datefrom, $dateto) = @_;
1476 my $dbh = C4::Context->dbh;
1477 my @query_params = ();
1479 SELECT aqorders.booksellerinvoicenumber,
1480 datereceived,purchaseordernumber,
1481 count(DISTINCT biblionumber) AS biblio,
1482 sum(quantity) AS itemsexpected,
1483 sum(quantityreceived) AS itemsreceived
1484 FROM aqorders LEFT JOIN aqbasket ON aqbasket.basketno = aqorders.basketno
1485 WHERE aqbasket.booksellerid = $bookseller and datereceived IS NOT NULL
1488 if ( defined $code ) {
1489 $strsth .= ' and aqorders.booksellerinvoicenumber like ? ';
1490 # add a % to the end of the code to allow stemming.
1491 push @query_params, "$code%";
1494 if ( defined $datefrom ) {
1495 $strsth .= ' and datereceived >= ? ';
1496 push @query_params, $datefrom;
1499 if ( defined $dateto ) {
1500 $strsth .= 'and datereceived <= ? ';
1501 push @query_params, $dateto;
1504 $strsth .= "group by aqorders.booksellerinvoicenumber,datereceived ";
1506 # can't use a placeholder to place this column name.
1507 # but, we could probably be checking to make sure it is a column that will be fetched.
1508 $strsth .= "order by $order " if ($order);
1510 my $sth = $dbh->prepare($strsth);
1512 $sth->execute( @query_params );
1513 my $results = $sth->fetchall_arrayref({});
1518 #------------------------------------------------------------#
1520 =head3 GetLateOrders
1524 @results = &GetLateOrders;
1526 Searches for bookseller with late orders.
1529 the table of supplier with late issues. This table is full of hashref.
1537 my $supplierid = shift;
1540 my $dbh = C4::Context->dbh;
1542 #BEWARE, order of parenthesis and LEFT JOIN is important for speed
1543 my $dbdriver = C4::Context->config("db_scheme") || "mysql";
1545 my @query_params = ($delay); # delay is the first argument regardless
1547 SELECT aqbasket.basketno,
1548 aqorders.ordernumber,
1549 DATE(aqbasket.closedate) AS orderdate,
1550 aqorders.rrp AS unitpricesupplier,
1551 aqorders.ecost AS unitpricelib,
1552 aqbudgets.budget_name AS budget,
1553 borrowers.branchcode AS branch,
1554 aqbooksellers.name AS supplier,
1556 biblioitems.publishercode AS publisher,
1557 biblioitems.publicationyear,
1561 aqorders LEFT JOIN biblio ON biblio.biblionumber = aqorders.biblionumber
1562 LEFT JOIN biblioitems ON biblioitems.biblionumber = biblio.biblionumber
1563 LEFT JOIN aqbudgets ON aqorders.budget_id = aqbudgets.budget_id,
1564 aqbasket LEFT JOIN borrowers ON aqbasket.authorisedby = borrowers.borrowernumber
1565 LEFT JOIN aqbooksellers ON aqbasket.booksellerid = aqbooksellers.id
1566 WHERE aqorders.basketno = aqbasket.basketno
1567 AND ( datereceived = ''
1568 OR datereceived IS NULL
1569 OR aqorders.quantityreceived < aqorders.quantity
1573 if ($dbdriver eq "mysql") {
1575 aqorders.quantity - IFNULL(aqorders.quantityreceived,0) AS quantity,
1576 (aqorders.quantity - IFNULL(aqorders.quantityreceived,0)) * aqorders.rrp AS subtotal,
1577 DATEDIFF(CURDATE( ),closedate) AS latesince
1579 $from .= " AND (closedate <= DATE_SUB(CURDATE( ),INTERVAL ? DAY)) ";
1581 HAVING quantity <> 0
1582 AND unitpricesupplier <> 0
1583 AND unitpricelib <> 0
1586 # FIXME: account for IFNULL as above
1588 aqorders.quantity AS quantity,
1589 aqorders.quantity * aqorders.rrp AS subtotal,
1590 (CURDATE - closedate) AS latesince
1592 $from .= " AND (closedate <= (CURDATE -(INTERVAL ? DAY)) ";
1594 if (defined $supplierid) {
1595 $from .= ' AND aqbasket.booksellerid = ? ';
1596 push @query_params, $supplierid;
1598 if (defined $branch) {
1599 $from .= ' AND borrowers.branchcode LIKE ? ';
1600 push @query_params, $branch;
1602 if (C4::Context->preference("IndependantBranches")
1603 && C4::Context->userenv
1604 && C4::Context->userenv->{flags} != 1 ) {
1605 $from .= ' AND borrowers.branchcode LIKE ? ';
1606 push @query_params, C4::Context->userenv->{branch};
1608 my $query = "$select $from $having\nORDER BY latesince, basketno, borrowers.branchcode, supplier";
1609 $debug and print STDERR "GetLateOrders query: $query\nGetLateOrders args: " . join(" ",@query_params);
1610 my $sth = $dbh->prepare($query);
1611 $sth->execute(@query_params);
1613 while (my $data = $sth->fetchrow_hashref) {
1614 $data->{orderdate} = format_date($data->{orderdate});
1615 push @results, $data;
1620 #------------------------------------------------------------#
1626 (\@order_loop, $total_qty, $total_price, $total_qtyreceived) = GetHistory( $title, $author, $name, $from_placed_on, $to_placed_on );
1628 Retreives some acquisition history information
1631 $order_loop is a list of hashrefs that each look like this:
1633 'author' => 'Twain, Mark',
1635 'biblionumber' => '215',
1637 'creationdate' => 'MM/DD/YYYY',
1638 'datereceived' => undef,
1641 'invoicenumber' => undef,
1643 'ordernumber' => '1',
1645 'quantityreceived' => undef,
1646 'title' => 'The Adventures of Huckleberry Finn'
1648 $total_qty is the sum of all of the quantities in $order_loop
1649 $total_price is the cost of each in $order_loop times the quantity
1650 $total_qtyreceived is the sum of all of the quantityreceived entries in $order_loop
1657 my ( $title, $author, $name, $from_placed_on, $to_placed_on ) = @_;
1660 my $total_qtyreceived = 0;
1661 my $total_price = 0;
1663 # don't run the query if there are no parameters (list would be too long for sure !)
1664 if ( $title || $author || $name || $from_placed_on || $to_placed_on ) {
1665 my $dbh = C4::Context->dbh;
1671 name,aqbasket.creationdate,
1672 aqorders.datereceived,
1674 aqorders.quantityreceived,
1676 aqorders.ordernumber,
1677 aqorders.booksellerinvoicenumber as invoicenumber,
1678 aqbooksellers.id as id,
1679 aqorders.biblionumber
1681 LEFT JOIN aqbasket ON aqorders.basketno=aqbasket.basketno
1682 LEFT JOIN aqbooksellers ON aqbasket.booksellerid=aqbooksellers.id
1683 LEFT JOIN biblio ON biblio.biblionumber=aqorders.biblionumber";
1685 $query .= " LEFT JOIN borrowers ON aqbasket.authorisedby=borrowers.borrowernumber"
1686 if ( C4::Context->preference("IndependantBranches") );
1688 $query .= " WHERE (datecancellationprinted is NULL or datecancellationprinted='0000-00-00') ";
1690 my @query_params = ();
1692 if ( defined $title ) {
1693 $query .= " AND biblio.title LIKE ? ";
1694 push @query_params, "%$title%";
1697 if ( defined $author ) {
1698 $query .= " AND biblio.author LIKE ? ";
1699 push @query_params, "%$author%";
1702 if ( defined $name ) {
1703 $query .= " AND name LIKE ? ";
1704 push @query_params, "%$name%";
1707 if ( defined $from_placed_on ) {
1708 $query .= " AND creationdate >= ? ";
1709 push @query_params, $from_placed_on;
1712 if ( defined $to_placed_on ) {
1713 $query .= " AND creationdate <= ? ";
1714 push @query_params, $to_placed_on;
1717 if ( C4::Context->preference("IndependantBranches") ) {
1718 my $userenv = C4::Context->userenv;
1719 if ( ($userenv) && ( $userenv->{flags} != 1 ) ) {
1720 $query .= " AND (borrowers.branchcode = ? OR borrowers.branchcode ='' ) ";
1721 push @query_params, $userenv->{branch};
1724 $query .= " ORDER BY booksellerid";
1725 my $sth = $dbh->prepare($query);
1726 $sth->execute( @query_params );
1728 while ( my $line = $sth->fetchrow_hashref ) {
1729 $line->{count} = $cnt++;
1730 $line->{toggle} = 1 if $cnt % 2;
1731 push @order_loop, $line;
1732 $line->{creationdate} = format_date( $line->{creationdate} );
1733 $line->{datereceived} = format_date( $line->{datereceived} );
1734 $total_qty += $line->{'quantity'};
1735 $total_qtyreceived += $line->{'quantityreceived'};
1736 $total_price += $line->{'quantity'} * $line->{'ecost'};
1739 return \@order_loop, $total_qty, $total_price, $total_qtyreceived;
1742 =head2 GetRecentAcqui
1744 $results = GetRecentAcqui($days);
1746 C<$results> is a ref to a table which containts hashref
1750 sub GetRecentAcqui {
1752 my $dbh = C4::Context->dbh;
1756 ORDER BY timestamp DESC
1759 my $sth = $dbh->prepare($query);
1761 my $results = $sth->fetchall_arrayref({});
1769 $contractlist = &GetContracts($booksellerid, $activeonly);
1771 Looks up the contracts that belong to a bookseller
1773 Returns a list of contracts
1775 =item C<$booksellerid> is the "id" field in the "aqbooksellers" table.
1777 =item C<$activeonly> if exists get only contracts that are still active.
1783 my ( $booksellerid, $activeonly ) = @_;
1784 my $dbh = C4::Context->dbh;
1786 if (! $activeonly) {
1790 WHERE booksellerid=?
1795 WHERE booksellerid=?
1796 AND contractenddate >= CURDATE( )";
1798 my $sth = $dbh->prepare($query);
1799 $sth->execute( $booksellerid );
1801 while (my $data = $sth->fetchrow_hashref ) {
1802 push(@results, $data);
1808 #------------------------------------------------------------#
1814 $contract = &GetContract($contractID);
1816 Looks up the contract that has PRIMKEY (contractnumber) value $contractID
1824 my ( $contractno ) = @_;
1825 my $dbh = C4::Context->dbh;
1829 WHERE contractnumber=?
1832 my $sth = $dbh->prepare($query);
1833 $sth->execute( $contractno );
1834 my $result = $sth->fetchrow_hashref;
1843 Koha Developement team <info@koha.org>