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
28 use vars qw($VERSION @ISA @EXPORT);
30 # set the version for version checking
31 $VERSION = do { my @v = '$Revision$' =~ /\d+/g;;
35 C4::Acquisition - Koha functions for dealing with orders and acquisitions
43 The functions in this module deal with acquisitions, managing book
44 orders, converting money to different currencies, and so forth.
54 &getbasket &getbasketcontent &newbasket &closebasket
56 &getorders &getallorders &getrecorders
57 &getorder &neworder &delorder
58 &ordersearch &histsearch
59 &modorder &getsingleorder &invoice &receiveorder
60 &updaterecorder &newordernum
61 &getsupplierlistwithlateorders
63 &getparcels &getparcelinformation
64 &bookfunds &curconvert &getcurrencies &bookfundbreakdown
65 &updatecurrencies &getcurrency
67 &bookseller &breakdown
79 $aqbasket = &getbasket($basketnumber);
81 get all basket informations in aqbasket for a given basket
86 my $dbh=C4::Context->dbh;
87 my $sth=$dbh->prepare("select aqbasket.*,borrowers.firstname+' '+borrowers.surname as authorisedbyname, borrowers.branchcode as branch from aqbasket left join borrowers on aqbasket.authorisedby=borrowers.borrowernumber where basketno=?");
88 $sth->execute($basketno);
89 return($sth->fetchrow_hashref);
92 =item getbasketcontent
94 ($count, @orders) = &getbasketcontent($basketnumber, $booksellerID);
96 Looks up the pending (non-cancelled) orders with the given basket
97 number. If C<$booksellerID> is non-empty, only orders from that seller
100 C<&basket> returns a two-element array. C<@orders> is an array of
101 references-to-hash, whose keys are the fields from the aqorders,
102 biblio, and biblioitems tables in the Koha database. C<$count> is the
103 number of elements in C<@orders>.
107 sub getbasketcontent {
108 my ($basketno,$supplier,$orderby)=@_;
109 my $dbh = C4::Context->dbh;
110 my $query="Select aqorderbreakdown.*,biblio.*,biblioitems.*,aqorders.*,biblio.title from aqorders,biblio,biblioitems
111 left join aqorderbreakdown on aqorderbreakdown.ordernumber=aqorders.ordernumber
112 where basketno='$basketno'
113 and biblio.biblionumber=aqorders.biblionumber and biblioitems.biblioitemnumber
114 =aqorders.biblioitemnumber
115 and (datecancellationprinted is NULL or datecancellationprinted =
117 if ($supplier ne ''){
118 $query.=" and aqorders.booksellerid='$supplier'";
121 $orderby="biblioitems.publishercode" unless $orderby;
122 $query.=" order by $orderby";
123 my $sth=$dbh->prepare($query);
128 while (my $data=$sth->fetchrow_hashref){
138 $basket = &newbasket();
140 Create a new basket in aqbasket table
144 my ($booksellerid,$authorisedby) = @_;
145 my $dbh = C4::Context->dbh;
146 my $sth=$dbh->do("insert into aqbasket (creationdate,booksellerid,authorisedby) values(now(),'$booksellerid','$authorisedby')");
147 #find & return basketno MYSQL dependant, but $dbh->last_insert_id always returns null :-(
148 my $basket = $dbh->{'mysql_insertid'};
154 &newbasket($basketno);
156 close a basket (becomes unmodifiable,except for recieves
161 my $dbh = C4::Context->dbh;
162 my $sth=$dbh->prepare("update aqbasket set closedate=now() where basketno=?");
163 $sth->execute($basketno);
168 &neworder($basket, $biblionumber, $title, $quantity, $listprice,
169 $booksellerid, $who, $notes, $bookfund, $biblioitemnumber, $rrp,
170 $ecost, $gst, $budget, $unitprice, $subscription,
171 $booksellerinvoicenumber);
173 Adds a new order to the database. Any argument that isn't described
174 below is the new value of the field with the same name in the aqorders
175 table of the Koha database.
177 C<$ordnum> is a "minimum order number." After adding the new entry to
178 the aqorders table, C<&neworder> finds the first entry in aqorders
179 with order number greater than or equal to C<$ordnum>, and adds an
180 entry to the aqorderbreakdown table, with the order number just found,
181 and the book fund ID of the newly-added order.
183 C<$budget> is effectively ignored.
185 C<$subscription> may be either "yes", or anything else for "no".
190 my ($basketno,$bibnum,$title,$quantity,$listprice,$booksellerid,$authorisedby,$notes,$bookfund,$bibitemnum,$rrp,$ecost,$gst,$budget,$cost,$sub,$invoice,$sort1,$sort2)=@_;
191 if ($budget eq 'now'){
194 $budget="'2001-07-01'";
201 # if $basket empty, it's also a new basket, create it
203 $basketno=newbasket($booksellerid,$authorisedby);
205 my $dbh = C4::Context->dbh;
206 my $sth=$dbh->prepare("insert into aqorders
207 (biblionumber,title,basketno,quantity,listprice,notes,
208 biblioitemnumber,rrp,ecost,gst,unitprice,subscription,sort1,sort2)
209 values (?,?,?,?,?,?,?,?,?,?,?,?,?,?)");
210 $sth->execute($bibnum,$title,$basketno,$quantity,$listprice,$notes,
211 $bibitemnum,$rrp,$ecost,$gst,$cost,$sub,$sort1,$sort2);
213 #get ordnum MYSQL dependant, but $dbh->last_insert_id returns null
214 my $ordnum = $dbh->{'mysql_insertid'};
215 $sth=$dbh->prepare("insert into aqorderbreakdown (ordernumber,bookfundid) values
217 $sth->execute($ordnum,$bookfund);
224 &delorder($biblionumber, $ordernumber);
226 Cancel the order with the given order and biblio numbers. It does not
227 delete any entries in the aqorders table, it merely marks them as
233 my ($bibnum,$ordnum)=@_;
234 my $dbh = C4::Context->dbh;
235 my $sth=$dbh->prepare("update aqorders set datecancellationprinted=now()
236 where biblionumber=? and ordernumber=?");
237 $sth->execute($bibnum,$ordnum);
243 &modorder($title, $ordernumber, $quantity, $listprice,
244 $biblionumber, $basketno, $supplier, $who, $notes,
245 $bookfundid, $bibitemnum, $rrp, $ecost, $gst, $budget,
246 $unitprice, $booksellerinvoicenumber);
248 Modifies an existing order. Updates the order with order number
249 C<$ordernumber> and biblionumber C<$biblionumber>. All other arguments
250 update the fields with the same name in the aqorders table of the Koha
253 Entries with order number C<$ordernumber> in the aqorderbreakdown
254 table are also updated to the new book fund ID.
259 my ($title,$ordnum,$quantity,$listprice,$bibnum,$basketno,$supplier,$who,$notes,$bookfund,$bibitemnum,$rrp,$ecost,$gst,$budget,$cost,$invoice,$sort1,$sort2)=@_;
260 my $dbh = C4::Context->dbh;
261 my $sth=$dbh->prepare("update aqorders set title=?,
262 quantity=?,listprice=?,basketno=?,
263 rrp=?,ecost=?,unitprice=?,booksellerinvoicenumber=?,
264 notes=?,sort1=?, sort2=?
266 ordernumber=? and biblionumber=?");
267 $sth->execute($title,$quantity,$listprice,$basketno,$rrp,$ecost,$cost,$invoice,$notes,$sort1,$sort2,$ordnum,$bibnum);
269 $sth=$dbh->prepare("update aqorderbreakdown set bookfundid=? where
271 unless ($sth->execute($bookfund,$ordnum)) { # zero rows affected [Bug 734]
272 my $query="insert into aqorderbreakdown (ordernumber,bookfundid) values (?,?)";
273 $sth=$dbh->prepare($query);
274 $sth->execute($ordnum,$bookfund);
281 $order = &newordernum();
283 Finds the next unused order number in the aqorders table of the Koha
284 database, and returns it.
288 # FIXME - Race condition
290 my $dbh = C4::Context->dbh;
291 my $sth=$dbh->prepare("Select max(ordernumber) from aqorders");
293 my $data=$sth->fetchrow_arrayref;
294 my $ordnum=$$data[0];
302 &receiveorder($biblionumber, $ordernumber, $quantityreceived, $user,
303 $unitprice, $booksellerinvoicenumber, $biblioitemnumber,
304 $freight, $bookfund, $rrp);
306 Updates an order, to reflect the fact that it was received, at least
307 in part. All arguments not mentioned below update the fields with the
308 same name in the aqorders table of the Koha database.
310 Updates the order with bibilionumber C<$biblionumber> and ordernumber
313 Also updates the book fund ID in the aqorderbreakdown table.
318 my ($biblio,$ordnum,$quantrec,$user,$cost,$invoiceno,$freight,$rrp)=@_;
319 my $dbh = C4::Context->dbh;
320 my $sth=$dbh->prepare("update aqorders set quantityreceived=?,datereceived=now(),booksellerinvoicenumber=?,
321 unitprice=?,freight=?,rrp=?
322 where biblionumber=? and ordernumber=?");
323 my $suggestionid = findsuggestion_from_biblionumber($dbh,$biblio);
325 changestatus($suggestionid,'AVAILABLE','',$biblio);
327 $sth->execute($quantrec,$invoiceno,$cost,$freight,$rrp,$biblio,$ordnum);
333 &updaterecorder($biblionumber, $ordernumber, $user, $unitprice,
336 Updates the order with biblionumber C<$biblionumber> and order number
337 C<$ordernumber>. C<$bookfundid> is the new value for the book fund ID
338 in the aqorderbreakdown table of the Koha database. All other
339 arguments update the fields with the same name in the aqorders table.
346 my($biblio,$ordnum,$user,$cost,$bookfund,$rrp)=@_;
347 my $dbh = C4::Context->dbh;
348 my $sth=$dbh->prepare("update aqorders set
350 where biblionumber=? and ordernumber=?
352 $sth->execute($cost,$rrp,$biblio,$ordnum);
354 $sth=$dbh->prepare("update aqorderbreakdown set bookfundid=? where ordernumber=?");
355 $sth->execute($bookfund,$ordnum);
367 ($count, $orders) = &getorders($booksellerid);
369 Finds pending orders from the bookseller with the given ID. Ignores
370 completed and cancelled orders.
372 C<$count> is the number of elements in C<@{$orders}>.
374 C<$orders> is a reference-to-array; each element is a
375 reference-to-hash with the following fields:
381 Gives the number of orders in with this basket number.
383 =item C<authorizedby>
389 These give the value of the corresponding field in the aqorders table
390 of the Koha database.
394 Results are ordered from most to least recent.
400 my $dbh = C4::Context->dbh;
401 my $strsth ="Select count(*),authorisedby,creationdate,aqbasket.basketno,
402 closedate,surname,firstname,aqorders.title
404 left join aqbasket on aqbasket.basketno=aqorders.basketno
405 left join borrowers on aqbasket.authorisedby=borrowers.borrowernumber
406 where booksellerid=? and (quantity > quantityreceived or
407 quantityreceived is NULL) and datecancellationprinted is NULL and (to_days(now())-to_days(closedate) < 180 or closedate is null)";
408 if (C4::Context->preference("IndependantBranches")) {
409 my $userenv = C4::Context->userenv;
410 if (($userenv)&&($userenv->{flags} != 1)){
411 $strsth .= " and (borrowers.branchcode = '".$userenv->{branch}."' or borrowers.branchcode ='')";
414 $strsth.=" group by basketno order by aqbasket.basketno";
415 my $sth=$dbh->prepare($strsth);
416 $sth->execute($supplierid);
418 while (my $data=$sth->fetchrow_hashref){
419 push(@results,$data);
422 return (scalar(@results),\@results);
427 ($order, $ordernumber) = &getorder($biblioitemnumber, $biblionumber);
429 Looks up the order with the given biblionumber and biblioitemnumber.
431 Returns a two-element array. C<$ordernumber> is the order number.
432 C<$order> is a reference-to-hash describing the order; its keys are
433 fields from the biblio, biblioitems, aqorders, and aqorderbreakdown
434 tables of the Koha database.
440 my $dbh = C4::Context->dbh;
441 my $sth=$dbh->prepare("Select ordernumber from aqorders where biblionumber=? and biblioitemnumber=?");
442 $sth->execute($bib,$bi);
443 # FIXME - Use fetchrow_array(), since we're only interested in the one
445 my $ordnum=$sth->fetchrow_hashref;
447 my $order=getsingleorder($ordnum->{'ordernumber'});
448 return ($order,$ordnum->{'ordernumber'});
453 $order = &getsingleorder($ordernumber);
455 Looks up an order by order number.
457 Returns a reference-to-hash describing the order. The keys of
458 C<$order> are fields from the biblio, biblioitems, aqorders, and
459 aqorderbreakdown tables of the Koha database.
465 my $dbh = C4::Context->dbh;
466 my $sth=$dbh->prepare("Select * from biblio,biblioitems,aqorders left join aqorderbreakdown
467 on aqorders.ordernumber=aqorderbreakdown.ordernumber
468 where aqorders.ordernumber=?
469 and biblio.biblionumber=aqorders.biblionumber and
470 biblioitems.biblioitemnumber=aqorders.biblioitemnumber");
471 $sth->execute($ordnum);
472 my $data=$sth->fetchrow_hashref;
479 ($count, @results) = &getallorders($booksellerid);
481 Looks up all of the pending orders from the supplier with the given
482 bookseller ID. Ignores cancelled and completed orders.
484 C<$count> is the number of elements in C<@results>. C<@results> is an
485 array of references-to-hash. The keys of each element are fields from
486 the aqorders, biblio, and biblioitems tables of the Koha database.
488 C<@results> is sorted alphabetically by book title.
493 #gets all orders from a certain supplier, orders them alphabetically
495 my $dbh = C4::Context->dbh;
497 my $strsth ="Select count(*),authorisedby,creationdate,aqbasket.basketno,
498 closedate,surname,firstname,aqorders.biblionumber,aqorders.title, aqorders.ordernumber
500 left join aqbasket on aqbasket.basketno=aqorders.basketno
501 left join borrowers on aqbasket.authorisedby=borrowers.borrowernumber
502 where booksellerid=? and (quantity > quantityreceived or
503 quantityreceived is NULL) and datecancellationprinted is NULL ";
505 if (C4::Context->preference("IndependantBranches")) {
506 my $userenv = C4::Context->userenv;
507 if (($userenv) &&($userenv->{flags} != 1)){
508 $strsth .= " and (borrowers.branchcode = '".$userenv->{branch}."' or borrowers.branchcode ='')";
511 $strsth.=" group by basketno order by aqbasket.basketno";
512 my $sth=$dbh->prepare($strsth);
513 $sth->execute($supplierid);
514 while (my $data=$sth->fetchrow_hashref){
515 push(@results,$data);
518 return(scalar(@results),@results);
520 =item getparcelinformation
522 ($count, @results) = &getparcelinformation($booksellerid, $code, $date);
524 Looks up all of the received items from the supplier with the given
525 bookseller ID at the given date, for the given code. Ignores cancelled and completed orders.
527 C<$count> is the number of elements in C<@results>. C<@results> is an
528 array of references-to-hash. The keys of each element are fields from
529 the aqorders, biblio, and biblioitems tables of the Koha database.
531 C<@results> is sorted alphabetically by book title.
535 sub getparcelinformation {
536 #gets all orders from a certain supplier, orders them alphabetically
537 my ($supplierid,$code, $datereceived)=@_;
538 my $dbh = C4::Context->dbh;
540 $code .='%' if $code; # add % if we search on a given code (otherwise, let him empty)
541 my $strsth ="Select authorisedby,creationdate,aqbasket.basketno,closedate,surname,firstname,aqorders.biblionumber,aqorders.title,aqorders.ordernumber, aqorders.quantity, aqorders.quantityreceived, aqorders.unitprice, aqorders.listprice, aqorders.rrp, aqorders.ecost from aqorders,aqbasket left join borrowers on aqbasket.authorisedby=borrowers.borrowernumber where aqbasket.basketno=aqorders.basketno and aqbasket.booksellerid=? and aqorders.booksellerinvoicenumber like \"$code\" and aqorders.datereceived= \'$datereceived\'";
543 if (C4::Context->preference("IndependantBranches")) {
544 my $userenv = C4::Context->userenv;
545 if (($userenv) &&($userenv->{flags} != 1)){
546 $strsth .= " and (borrowers.branchcode = '".$userenv->{branch}."' or borrowers.branchcode ='')";
549 $strsth.=" order by aqbasket.basketno";
550 ### parcelinformation : $strsth
551 my $sth=$dbh->prepare($strsth);
552 $sth->execute($supplierid);
553 while (my $data=$sth->fetchrow_hashref){
554 push(@results,$data);
556 my $count =scalar(@results);
557 ### countparcelbiblio: $count
560 return(scalar(@results),@results);
562 =item getsupplierlistwithlateorders
564 %results = &getsupplierlistwithlateorders;
566 Searches for suppliers with late orders.
570 sub getsupplierlistwithlateorders {
572 my $dbh = C4::Context->dbh;
573 #FIXME NOT quite sure that this operation is valid for DBMs different from Mysql, HOPING so
574 #should be tested with other DBMs
577 my $dbdriver = C4::Context->config("db_scheme")||"mysql";
578 if ($dbdriver eq "mysql"){
579 $strsth="SELECT DISTINCT aqbasket.booksellerid, aqbooksellers.name
580 FROM aqorders, aqbasket
581 LEFT JOIN aqbooksellers ON aqbasket.booksellerid = aqbooksellers.id
582 WHERE aqorders.basketno = aqbasket.basketno AND
583 (closedate < DATE_SUB(CURDATE( ),INTERVAL $delay DAY) AND (datereceived = '' or datereceived is null))
586 $strsth="SELECT DISTINCT aqbasket.booksellerid, aqbooksellers.name
587 FROM aqorders, aqbasket
588 LEFT JOIN aqbooksellers ON aqbasket.aqbooksellerid = aqbooksellers.id
589 WHERE aqorders.basketno = aqbasket.basketno AND
590 (closedate < (CURDATE( )-(INTERVAL $delay DAY))) AND (datereceived = '' or datereceived is null))
593 # warn "C4::Acquisition getsupplierlistwithlateorders : ".$strsth;
594 my $sth = $dbh->prepare($strsth);
597 while (my ($id,$name) = $sth->fetchrow) {
598 $supplierlist{$id} = $name;
600 return %supplierlist;
605 %results = &getlateorders;
607 Searches for suppliers with late orders.
613 my $supplierid = shift;
616 my $dbh = C4::Context->dbh;
617 #BEWARE, order of parenthesis and LEFT JOIN is important for speed
619 my $dbdriver = C4::Context->config("db_scheme")||"mysql";
621 if ($dbdriver eq "mysql"){
622 $strsth ="SELECT aqbasket.basketno,
623 DATE(aqbasket.closedate) as orderdate, aqorders.quantity - IFNULL(aqorders.quantityreceived,0) as quantity, aqorders.rrp as unitpricesupplier,aqorders.ecost as unitpricelib,
624 (aqorders.quantity - IFNULL(aqorders.quantityreceived,0)) * aqorders.rrp as subtotal, aqbookfund.bookfundname as budget, borrowers.branchcode as branch,
625 aqbooksellers.name as supplier,
626 aqorders.title, biblio.author, biblioitems.publishercode as publisher, biblioitems.publicationyear,
627 DATEDIFF(CURDATE( ),closedate) AS latesince
630 (aqorders LEFT JOIN biblio on biblio.biblionumber = aqorders.biblionumber) LEFT JOIN biblioitems on biblioitems.biblionumber=biblio.biblionumber
631 ) LEFT JOIN aqorderbreakdown on aqorders.ordernumber = aqorderbreakdown.ordernumber
632 ) LEFT JOIN aqbookfund on aqorderbreakdown.bookfundid = aqbookfund.bookfundid
633 ),(aqbasket LEFT JOIN borrowers on aqbasket.authorisedby = borrowers.borrowernumber) LEFT JOIN aqbooksellers ON aqbasket.booksellerid = aqbooksellers.id
634 WHERE aqorders.basketno = aqbasket.basketno AND (closedate < DATE_SUB(CURDATE( ),INTERVAL $delay DAY))
635 AND ((datereceived = '' OR datereceived is null) OR (aqorders.quantityreceived < aqorders.quantity) ) ";
636 $strsth .= " AND aqbasket.booksellerid = $supplierid " if ($supplierid);
637 $strsth .= " AND borrowers.branchcode like \'".$branch."\'" if ($branch);
638 $strsth .= " AND borrowers.branchcode like \'".C4::Context->userenv->{branch}."\'" if (C4::Context->preference("IndependantBranches") && C4::Context->userenv && C4::Context->userenv->{flags}!=1);
639 $strsth .= " HAVING quantity<>0 AND unitpricesupplier<>0 AND unitpricelib<>0 ORDER BY latesince,basketno,borrowers.branchcode, supplier ";
641 $strsth ="SELECT aqbasket.basketno,
642 DATE(aqbasket.closedate) as orderdate,
643 aqorders.quantity, aqorders.rrp as unitpricesupplier,aqorders.ecost as unitpricelib, aqorders.quantity * aqorders.rrp as subtotal
644 aqbookfund.bookfundname as budget, borrowers.branchcode as branch,
645 aqbooksellers.name as supplier,
646 biblio.title, biblio.author, biblioitems.publishercode as publisher, biblioitems.publicationyear,
647 (CURDATE - closedate) AS latesince
650 (aqorders LEFT JOIN biblio on biblio.biblionumber = aqorders.biblionumber) LEFT JOIN biblioitems on biblioitems.biblionumber=biblio.biblionumber
651 ) LEFT JOIN aqorderbreakdown on aqorders.ordernumber = aqorderbreakdown.ordernumber
652 ) LEFT JOIN aqbookfund on aqorderbreakdown.bookfundid = aqbookfund.bookfundid
653 ),(aqbasket LEFT JOIN borrowers on aqbasket.authorisedby = borrowers.borrowernumber) LEFT JOIN aqbooksellers ON aqbasket.booksellerid = aqbooksellers.id
654 WHERE aqorders.basketno = aqbasket.basketno AND (closedate < (CURDATE -(INTERVAL $delay DAY))
655 AND ((datereceived = '' OR datereceived is null) OR (aqorders.quantityreceived < aqorders.quantity) ) ";
656 $strsth .= " AND aqbasket.booksellerid = $supplierid " if ($supplierid);
657 $strsth .= " AND borrowers.branchcode like \'".$branch."\'" if ($branch);
658 $strsth .= " AND borrowers.branchcode like \'".C4::Context->userenv->{branch}."\'" if (C4::Context->preference("IndependantBranches") && C4::Context->userenv->{flags}!=1);
659 $strsth .= " ORDER BY latesince,basketno,borrowers.branchcode, supplier";
661 warn "C4::Acquisition : getlateorders SQL:".$strsth;
662 my $sth = $dbh->prepare($strsth);
666 while (my $data = $sth->fetchrow_hashref) {
667 $data->{hilighted}=$hilighted if ($hilighted>0);
668 $data->{orderdate} = format_date($data->{orderdate});
669 push @results, $data;
670 $hilighted= -$hilighted;
673 return(scalar(@results),@results);
678 #gets all orders from a certain supplier, orders them alphabetically
680 my $dbh = C4::Context->dbh;
682 my $sth=$dbh->prepare("Select * from aqorders,biblio,biblioitems where booksellerid=?
683 and (cancelledby is NULL or cancelledby = '')
684 and biblio.biblionumber=aqorders.biblionumber and biblioitems.biblioitemnumber=
685 aqorders.biblioitemnumber and
686 aqorders.quantityreceived>0
687 and aqorders.datereceived >=now()
688 group by aqorders.biblioitemnumber
691 $sth->execute($supid);
692 while (my $data=$sth->fetchrow_hashref){
693 push(@results,$data);
696 return(scalar(@results),@results);
701 ($count, @results) = &ordersearch($search, $biblionumber, $complete);
705 C<$search> may take one of several forms: if it is an ISBN,
706 C<&ordersearch> returns orders with that ISBN. If C<$search> is an
707 order number, C<&ordersearch> returns orders with that order number
708 and biblionumber C<$biblionumber>. Otherwise, C<$search> is considered
709 to be a space-separated list of search terms; in this case, all of the
710 terms must appear in the title (matching the beginning of title
713 If C<$complete> is C<yes>, the results will include only completed
714 orders. In any case, C<&ordersearch> ignores cancelled orders.
716 C<&ordersearch> returns an array. C<$count> is the number of elements
717 in C<@results>. C<@results> is an array of references-to-hash with the
735 my ($search,$id,$biblio,$catview) = @_;
736 my $dbh = C4::Context->dbh;
737 my @data = split(' ',$search);
738 my @searchterms = ($id);
739 map { push(@searchterms,"$_%","% $_%") } @data;
740 push(@searchterms,$search,$search,$biblio);
741 my $sth=$dbh->prepare("Select biblio.*,biblioitems.*,aqorders.*,aqbasket.*,biblio.title from aqorders,biblioitems,biblio,aqbasket
742 where aqorders.biblioitemnumber = biblioitems.biblioitemnumber and
743 aqorders.basketno = aqbasket.basketno
744 and aqbasket.booksellerid = ?
745 and biblio.biblionumber=aqorders.biblionumber
746 and ((datecancellationprinted is NULL)
747 or (datecancellationprinted = '0000-00-00'))
749 .(join(" and ",map { "(biblio.title like ? or biblio.title like ?)" } @data))
750 .") or biblioitems.isbn=? or (aqorders.ordernumber=? and aqorders.biblionumber=?)) "
751 .(($catview ne 'yes')?" and (quantityreceived < quantity or quantityreceived is NULL)":"")
752 ." group by aqorders.ordernumber");
753 $sth->execute(@searchterms);
755 my $sth2=$dbh->prepare("Select * from biblio where biblionumber=?");
756 my $sth3=$dbh->prepare("Select * from aqorderbreakdown where ordernumber=?");
757 while (my $data=$sth->fetchrow_hashref){
758 $sth2->execute($data->{'biblionumber'});
759 my $data2=$sth2->fetchrow_hashref;
760 $data->{'author'}=$data2->{'author'};
761 $data->{'seriestitle'}=$data2->{'seriestitle'};
762 $sth3->execute($data->{'ordernumber'});
763 my $data3=$sth3->fetchrow_hashref;
764 $data->{'branchcode'}=$data3->{'branchcode'};
765 $data->{'bookfundid'}=$data3->{'bookfundid'};
766 push(@results,$data);
771 return(scalar(@results),@results);
776 my ($title,$author,$name,$from_placed_on,$to_placed_on)=@_;
779 my $total_qtyreceived=0;
781 # don't run the query if there are no parameters (list would be too long for sure !
782 if ($title || $author || $name || $from_placed_on || $to_placed_on) {
783 my $dbh= C4::Context->dbh;
784 my $query = "select biblio.title,biblio.author,aqorders.basketno,name,aqbasket.creationdate,aqorders.datereceived, aqorders.quantity, aqorders.quantityreceived, aqorders.ecost from aqorders,aqbasket,aqbooksellers,biblio";
785 $query .= ",borrowers " if (C4::Context->preference("IndependantBranches"));
786 $query .=" where aqorders.basketno=aqbasket.basketno and aqbasket.booksellerid=aqbooksellers.id and biblio.biblionumber=aqorders.biblionumber ";
787 $query .= " and aqbasket.authorisedby=borrowers.borrowernumber" if (C4::Context->preference("IndependantBranches"));
788 $query .= " and biblio.title like ".$dbh->quote("%".$title."%") if $title;
789 $query .= " and biblio.author like ".$dbh->quote("%".$author."%") if $author;
790 $query .= " and name like ".$dbh->quote("%".$name."%") if $name;
791 $query .= " and creationdate >" .$dbh->quote($from_placed_on) if $from_placed_on;
792 $query .= " and creationdate<".$dbh->quote($to_placed_on) if $to_placed_on;
793 if (C4::Context->preference("IndependantBranches")) {
794 my $userenv = C4::Context->userenv;
795 if (($userenv) &&($userenv->{flags} != 1)){
796 $query .= " and (borrowers.branchcode = '".$userenv->{branch}."' or borrowers.branchcode ='')";
799 $query .=" order by booksellerid";
800 warn "query histearch: ".$query;
801 my $sth = $dbh->prepare($query);
804 while (my $line = $sth->fetchrow_hashref) {
805 $line->{count}=$cnt++;
806 $line->{toggle}=1 if $cnt %2;
807 push @order_loop, $line;
808 $line->{creationdate} = format_date($line->{creationdate});
809 $line->{datereceived} = format_date($line->{datereceived});
810 $total_qty += $line->{'quantity'};
811 $total_qtyreceived += $line->{'quantityreceived'};
812 $total_price += $line->{'quantity'}*$line->{'ecost'};
815 return \@order_loop,$total_qty,$total_price,$total_qtyreceived;
825 ($count, @results) = &invoice($booksellerinvoicenumber);
827 Looks up orders by invoice number.
829 Returns an array. C<$count> is the number of elements in C<@results>.
830 C<@results> is an array of references-to-hash; the keys of each
831 elements are fields from the aqorders, biblio, and biblioitems tables
832 of the Koha database.
838 my $dbh = C4::Context->dbh;
840 my $sth=$dbh->prepare("Select * from aqorders,biblio,biblioitems where
841 booksellerinvoicenumber=?
842 and biblio.biblionumber=aqorders.biblionumber and biblioitems.biblioitemnumber=
843 aqorders.biblioitemnumber group by aqorders.ordernumber,aqorders.biblioitemnumber");
844 $sth->execute($invoice);
845 while (my $data=$sth->fetchrow_hashref){
846 push(@results,$data);
849 return(scalar(@results),@results);
854 ($count, @results) = &bookfunds();
856 Returns a list of all book funds.
858 C<$count> is the number of elements in C<@results>. C<@results> is an
859 array of references-to-hash, whose keys are fields from the aqbookfund
860 and aqbudget tables of the Koha database. Results are ordered
861 alphabetically by book fund name.
867 my $dbh = C4::Context->dbh;
868 my $userenv = C4::Context->userenv;
869 my $branch = $userenv->{branch};
872 if (!($branch eq '')) {
873 $strsth="Select * from aqbookfund,aqbudget where aqbookfund.bookfundid
874 =aqbudget.bookfundid and startdate<now() and enddate>now() and (aqbookfund.branchcode is null or aqbookfund.branchcode='' or aqbookfund.branchcode= ? )
875 group by aqbookfund.bookfundid order by bookfundname";
877 $strsth="Select * from aqbookfund,aqbudget where aqbookfund.bookfundid
878 =aqbudget.bookfundid and startdate<now() and enddate>now()
879 group by aqbookfund.bookfundid order by bookfundname";
881 my $sth=$dbh->prepare($strsth);
882 if (!($branch eq '')){
883 $sth->execute($branch);
888 while (my $data=$sth->fetchrow_hashref){
889 push(@results,$data);
892 return(scalar(@results),@results);
895 =item bookfundbreakdown
897 returns the total comtd & spent for a given bookfund, and a given year
898 used in acqui-home.pl
902 sub bookfundbreakdown {
904 my $dbh = C4::Context->dbh;
905 my $sth=$dbh->prepare("SELECT startdate, enddate, quantity, datereceived, freight, unitprice, listprice, ecost, quantityreceived, subscription
906 FROM aqorders, aqorderbreakdown, aqbudget, aqbasket
907 WHERE aqorderbreakdown.bookfundid = ?
908 AND aqorders.ordernumber = aqorderbreakdown.ordernumber
910 datecancellationprinted IS NULL
911 OR datecancellationprinted = '0000-00-00'
913 AND aqbudget.bookfundid = aqorderbreakdown.bookfundid
914 AND aqbasket.basketno = aqorders.basketno
915 AND aqbasket.creationdate >= startdate
916 AND enddate >= aqbasket.creationdate
917 and startdate<=now() and enddate>=now()");
921 while (my $data=$sth->fetchrow_hashref){
922 if ($data->{'subscription'} == 1){
923 $spent+=$data->{'quantity'}*$data->{'unitprice'};
925 my $leftover=$data->{'quantity'}-$data->{'quantityreceived'};
926 $comtd+=($data->{'ecost'})*$leftover;
927 $spent+=($data->{'unitprice'})*$data->{'quantityreceived'};
931 return($spent,$comtd);
938 $foreignprice = &curconvert($currency, $localprice);
940 Converts the price C<$localprice> to foreign currency C<$currency> by
941 dividing by the exchange rate, and returns the result.
943 If no exchange rate is found, C<&curconvert> assumes the rate is one
949 my ($currency,$price)=@_;
950 my $dbh = C4::Context->dbh;
951 my $sth=$dbh->prepare("Select rate from currency where currency=?");
952 $sth->execute($currency);
953 my $cur=($sth->fetchrow_array())[0];
958 return($price / $cur);
963 ($count, $currencies) = &getcurrencies();
965 Returns the list of all known currencies.
967 C<$count> is the number of elements in C<$currencies>. C<$currencies>
968 is a reference-to-array; its elements are references-to-hash, whose
969 keys are the fields from the currency table in the Koha database.
974 my $dbh = C4::Context->dbh;
975 my $sth=$dbh->prepare("Select * from currency");
978 while (my $data=$sth->fetchrow_hashref){
979 push(@results,$data);
982 return(scalar(@results),\@results);
985 =item updatecurrencies
987 &updatecurrencies($currency, $newrate);
989 Sets the exchange rate for C<$currency> to be C<$newrate>.
993 sub updatecurrencies {
994 my ($currency,$rate)=@_;
995 my $dbh = C4::Context->dbh;
996 my $sth=$dbh->prepare("update currency set rate=? where currency=?");
997 $sth->execute($rate,$currency);
1009 ($count, @results) = &bookseller($searchstring);
1011 Looks up a book seller. C<$searchstring> may be either a book seller
1012 ID, or a string to look for in the book seller's name.
1014 C<$count> is the number of elements in C<@results>. C<@results> is an
1015 array of references-to-hash, whose keys are the fields of of the
1016 aqbooksellers table in the Koha database.
1021 my ($searchstring)=@_;
1022 my $dbh = C4::Context->dbh;
1023 my $sth=$dbh->prepare("Select * from aqbooksellers where name like ? or id = ?");
1024 $sth->execute("$searchstring%",$searchstring);
1026 while (my $data=$sth->fetchrow_hashref){
1027 push(@results,$data);
1030 return(scalar(@results),@results);
1035 ($count, $results) = &breakdown($ordernumber);
1037 Looks up an order by order ID, and returns its breakdown.
1039 C<$count> is the number of elements in C<$results>. C<$results> is a
1040 reference-to-array; its elements are references-to-hash, whose keys
1041 are the fields of the aqorderbreakdown table in the Koha database.
1047 my $dbh = C4::Context->dbh;
1048 my $sth=$dbh->prepare("Select * from aqorderbreakdown where ordernumber=?");
1051 while (my $data=$sth->fetchrow_hashref){
1052 push(@results,$data);
1055 return(scalar(@results),\@results);
1061 ($count, @results) = &branches();
1063 Returns a list of all library branches.
1065 C<$count> is the number of elements in C<@results>. C<@results> is an
1066 array of references-to-hash, whose keys are the fields of the branches
1067 table of the Koha database.
1072 my $dbh = C4::Context->dbh;
1074 if (C4::Context->preference("IndependantBranches") && (C4::Context->userenv) && (C4::Context->userenv->{flags} != 1)){
1075 my $strsth ="Select * from branches ";
1076 $strsth.= " WHERE branchcode = ".$dbh->quote(C4::Context->userenv->{branch});
1077 $strsth.= " order by branchname";
1078 warn "C4::Acquisition->branches : ".$strsth;
1079 $sth=$dbh->prepare($strsth);
1081 $sth = $dbh->prepare("Select * from branches order by branchname");
1086 while (my $data = $sth->fetchrow_hashref) {
1087 push(@results,$data);
1091 return(scalar(@results), @results);
1096 &updatesup($bookseller);
1098 Updates the information for a given bookseller. C<$bookseller> is a
1099 reference-to-hash whose keys are the fields of the aqbooksellers table
1100 in the Koha database. It must contain entries for all of the fields.
1101 The entry to modify is determined by C<$bookseller-E<gt>{id}>.
1103 The easiest way to get all of the necessary fields is to look up a
1104 book seller with C<&booksellers>, modify what's necessary, then call
1105 C<&updatesup> with the result.
1111 my $dbh = C4::Context->dbh;
1112 my $sth=$dbh->prepare("Update aqbooksellers set
1113 name=?,address1=?,address2=?,address3=?,address4=?,postal=?,
1114 phone=?,fax=?,url=?,contact=?,contpos=?,contphone=?,contfax=?,contaltphone=?,
1115 contemail=?,contnotes=?,active=?,
1116 listprice=?, invoiceprice=?,gstreg=?, listincgst=?,
1117 invoiceincgst=?, specialty=?,discount=?,invoicedisc=?,
1120 $sth->execute($data->{'name'},$data->{'address1'},$data->{'address2'},
1121 $data->{'address3'},$data->{'address4'},$data->{'postal'},$data->{'phone'},
1122 $data->{'fax'},$data->{'url'},$data->{'contact'},$data->{'contpos'},
1123 $data->{'contphone'},$data->{'contfax'},$data->{'contaltphone'},
1124 $data->{'contemail'},
1125 $data->{'contnote'},$data->{'active'},$data->{'listprice'},
1126 $data->{'invoiceprice'},$data->{'gstreg'},$data->{'listincgst'},
1127 $data->{'invoiceincgst'},$data->{'specialty'},$data->{'discount'},
1128 $data->{'invoicedisc'},$data->{'nocalc'},$data->{'id'});
1134 $id = &insertsup($bookseller);
1136 Creates a new bookseller. C<$bookseller> is a reference-to-hash whose
1137 keys are the fields of the aqbooksellers table in the Koha database.
1138 All fields must be present.
1140 Returns the ID of the newly-created bookseller.
1146 my $dbh = C4::Context->dbh;
1147 my $sth=$dbh->prepare("Select max(id) from aqbooksellers");
1149 my $data2=$sth->fetchrow_hashref;
1151 $data2->{'max(id)'}++;
1152 $sth=$dbh->prepare("Insert into aqbooksellers (id) values (?)");
1153 $sth->execute($data2->{'max(id)'});
1155 $data->{'id'}=$data2->{'max(id)'};
1157 return($data->{'id'});
1162 ($count, $results) = &getparcels($dbh, $bookseller, $order, $limit);
1164 get a lists of parcels
1165 Returns the count of parcels returned and a pointer on a hash list containing parcel informations as such :
1175 my ($bookseller, $order, $code,$datefrom,$dateto, $limit)=@_;
1176 my $dbh = C4::Context->dbh;
1177 my $strsth = "SELECT aqorders.booksellerinvoicenumber, datereceived, count(DISTINCT biblionumber) as biblio, sum(quantity) as itemsexpected, sum(quantityreceived) as itemsreceived from aqorders, aqbasket where aqbasket.basketno = aqorders.basketno and aqbasket.booksellerid = $bookseller and datereceived is not null ";
1178 $strsth .= "and aqorders.booksellerinvoicenumber like \"$code%\" " if ($code);
1179 $strsth .= "and datereceived >=".$dbh->quote($datefrom)." " if ($datefrom);
1180 $strsth .= "and datereceived <=".$dbh->quote($dateto)." " if ($dateto);
1181 $strsth .= "group by aqorders.booksellerinvoicenumber,datereceived ";
1182 $strsth .= "order by $order " if ($order);
1183 $strsth .= " LIMIT 0,$limit" if ($limit);
1184 my $sth=$dbh->prepare($strsth);
1185 ### getparcels: $strsth
1188 while (my $data2=$sth->fetchrow_hashref) {
1189 push @results, $data2;
1193 return(scalar(@results), @results);
1196 END { } # module clean-up code here (global destructor)
1205 Koha Developement team <info@koha.org>