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
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
64 &bookfunds &curconvert &getcurrencies &bookfundbreakdown
65 &updatecurrencies &getcurrency
68 &bookseller &breakdown
80 $aqbasket = &getbasket($basketnumber);
82 get all basket informations in aqbasket for a given basket
87 my $dbh=C4::Context->dbh;
88 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=?");
89 $sth->execute($basketno);
90 return($sth->fetchrow_hashref);
93 =item getbasketcontent
95 ($count, @orders) = &getbasketcontent($basketnumber, $booksellerID);
97 Looks up the pending (non-cancelled) orders with the given basket
98 number. If C<$booksellerID> is non-empty, only orders from that seller
101 C<&basket> returns a two-element array. C<@orders> is an array of
102 references-to-hash, whose keys are the fields from the aqorders,
103 biblio, and biblioitems tables in the Koha database. C<$count> is the
104 number of elements in C<@orders>.
108 sub getbasketcontent {
109 my ($basketno,$supplier,$orderby)=@_;
110 my $dbh = C4::Context->dbh;
111 my $query="Select aqorderbreakdown.*,biblio.*,biblioitems.*,aqorders.*,biblio.title from aqorders,biblio,biblioitems
112 left join aqorderbreakdown on aqorderbreakdown.ordernumber=aqorders.ordernumber
113 where basketno='$basketno'
114 and biblio.biblionumber=aqorders.biblionumber and biblioitems.biblioitemnumber
115 =aqorders.biblioitemnumber
116 and (datecancellationprinted is NULL or datecancellationprinted =
118 if ($supplier ne ''){
119 $query.=" and aqorders.booksellerid='$supplier'";
122 $orderby="biblioitems.publishercode" unless $orderby;
123 $query.=" order by $orderby";
124 my $sth=$dbh->prepare($query);
129 while (my $data=$sth->fetchrow_hashref){
139 $basket = &newbasket();
141 Create a new basket in aqbasket table
145 my ($booksellerid,$authorisedby) = @_;
146 my $dbh = C4::Context->dbh;
147 my $sth=$dbh->do("insert into aqbasket (creationdate,booksellerid,authorisedby) values(now(),'$booksellerid','$authorisedby')");
148 #find & return basketno MYSQL dependant, but $dbh->last_insert_id always returns null :-(
149 my $basket = $dbh->{'mysql_insertid'};
155 &newbasket($basketno);
157 close a basket (becomes unmodifiable,except for recieves
162 my $dbh = C4::Context->dbh;
163 my $sth=$dbh->prepare("update aqbasket set closedate=now() where basketno=?");
164 $sth->execute($basketno);
169 &neworder($basket, $biblionumber, $title, $quantity, $listprice,
170 $booksellerid, $who, $notes, $bookfund, $biblioitemnumber, $rrp,
171 $ecost, $gst, $budget, $unitprice, $subscription,
172 $booksellerinvoicenumber);
174 Adds a new order to the database. Any argument that isn't described
175 below is the new value of the field with the same name in the aqorders
176 table of the Koha database.
178 C<$ordnum> is a "minimum order number." After adding the new entry to
179 the aqorders table, C<&neworder> finds the first entry in aqorders
180 with order number greater than or equal to C<$ordnum>, and adds an
181 entry to the aqorderbreakdown table, with the order number just found,
182 and the book fund ID of the newly-added order.
184 C<$budget> is effectively ignored.
186 C<$subscription> may be either "yes", or anything else for "no".
191 my ($basketno,$bibnum,$title,$quantity,$listprice,$booksellerid,$authorisedby,$notes,$bookfund,$bibitemnum,$rrp,$ecost,$gst,$budget,$cost,$sub,$invoice,$sort1,$sort2)=@_;
192 if ($budget eq 'now'){
195 $budget="'2001-07-01'";
202 # if $basket empty, it's also a new basket, create it
204 $basketno=newbasket($booksellerid,$authorisedby);
206 my $dbh = C4::Context->dbh;
207 my $sth=$dbh->prepare("insert into aqorders
208 (biblionumber,title,basketno,quantity,listprice,notes,
209 biblioitemnumber,rrp,ecost,gst,unitprice,subscription,sort1,sort2)
210 values (?,?,?,?,?,?,?,?,?,?,?,?,?,?)");
211 $sth->execute($bibnum,$title,$basketno,$quantity,$listprice,$notes,
212 $bibitemnum,$rrp,$ecost,$gst,$cost,$sub,$sort1,$sort2);
214 #get ordnum MYSQL dependant, but $dbh->last_insert_id returns null
215 my $ordnum = $dbh->{'mysql_insertid'};
216 $sth=$dbh->prepare("insert into aqorderbreakdown (ordernumber,bookfundid) values
218 $sth->execute($ordnum,$bookfund);
225 &delorder($biblionumber, $ordernumber);
227 Cancel the order with the given order and biblio numbers. It does not
228 delete any entries in the aqorders table, it merely marks them as
234 my ($bibnum,$ordnum)=@_;
235 my $dbh = C4::Context->dbh;
236 my $sth=$dbh->prepare("update aqorders set datecancellationprinted=now()
237 where biblionumber=? and ordernumber=?");
238 $sth->execute($bibnum,$ordnum);
244 &modorder($title, $ordernumber, $quantity, $listprice,
245 $biblionumber, $basketno, $supplier, $who, $notes,
246 $bookfundid, $bibitemnum, $rrp, $ecost, $gst, $budget,
247 $unitprice, $booksellerinvoicenumber);
249 Modifies an existing order. Updates the order with order number
250 C<$ordernumber> and biblionumber C<$biblionumber>. All other arguments
251 update the fields with the same name in the aqorders table of the Koha
254 Entries with order number C<$ordernumber> in the aqorderbreakdown
255 table are also updated to the new book fund ID.
260 my ($title,$ordnum,$quantity,$listprice,$bibnum,$basketno,$supplier,$who,$notes,$bookfund,$bibitemnum,$rrp,$ecost,$gst,$budget,$cost,$invoice,$sort1,$sort2)=@_;
261 my $dbh = C4::Context->dbh;
262 my $sth=$dbh->prepare("update aqorders set title=?,
263 quantity=?,listprice=?,basketno=?,
264 rrp=?,ecost=?,unitprice=?,booksellerinvoicenumber=?,
265 notes=?,sort1=?, sort2=?
267 ordernumber=? and biblionumber=?");
268 $sth->execute($title,$quantity,$listprice,$basketno,$rrp,$ecost,$cost,$invoice,$notes,$sort1,$sort2,$ordnum,$bibnum);
270 $sth=$dbh->prepare("update aqorderbreakdown set bookfundid=? where
272 unless ($sth->execute($bookfund,$ordnum)) { # zero rows affected [Bug 734]
273 my $query="insert into aqorderbreakdown (ordernumber,bookfundid) values (?,?)";
274 $sth=$dbh->prepare($query);
275 $sth->execute($ordnum,$bookfund);
282 $order = &newordernum();
284 Finds the next unused order number in the aqorders table of the Koha
285 database, and returns it.
289 # FIXME - Race condition
291 my $dbh = C4::Context->dbh;
292 my $sth=$dbh->prepare("Select max(ordernumber) from aqorders");
294 my $data=$sth->fetchrow_arrayref;
295 my $ordnum=$$data[0];
303 &receiveorder($biblionumber, $ordernumber, $quantityreceived, $user,
304 $unitprice, $booksellerinvoicenumber, $biblioitemnumber,
305 $freight, $bookfund, $rrp);
307 Updates an order, to reflect the fact that it was received, at least
308 in part. All arguments not mentioned below update the fields with the
309 same name in the aqorders table of the Koha database.
311 Updates the order with bibilionumber C<$biblionumber> and ordernumber
314 Also updates the book fund ID in the aqorderbreakdown table.
319 my ($biblio,$ordnum,$quantrec,$user,$cost,$invoiceno,$freight,$rrp)=@_;
320 my $dbh = C4::Context->dbh;
321 my $sth=$dbh->prepare("update aqorders set quantityreceived=?,datereceived=now(),booksellerinvoicenumber=?,
322 unitprice=?,freight=?,rrp=?
323 where biblionumber=? and ordernumber=?");
324 my $suggestionid = findsuggestion_from_biblionumber($dbh,$biblio);
326 changestatus($suggestionid,'AVAILABLE','',$biblio);
328 $sth->execute($quantrec,$invoiceno,$cost,$freight,$rrp,$biblio,$ordnum);
334 &updaterecorder($biblionumber, $ordernumber, $user, $unitprice,
337 Updates the order with biblionumber C<$biblionumber> and order number
338 C<$ordernumber>. C<$bookfundid> is the new value for the book fund ID
339 in the aqorderbreakdown table of the Koha database. All other
340 arguments update the fields with the same name in the aqorders table.
347 my($biblio,$ordnum,$user,$cost,$bookfund,$rrp)=@_;
348 my $dbh = C4::Context->dbh;
349 my $sth=$dbh->prepare("update aqorders set
351 where biblionumber=? and ordernumber=?
353 $sth->execute($cost,$rrp,$biblio,$ordnum);
355 $sth=$dbh->prepare("update aqorderbreakdown set bookfundid=? where ordernumber=?");
356 $sth->execute($bookfund,$ordnum);
368 ($count, $orders) = &getorders($booksellerid);
370 Finds pending orders from the bookseller with the given ID. Ignores
371 completed and cancelled orders.
373 C<$count> is the number of elements in C<@{$orders}>.
375 C<$orders> is a reference-to-array; each element is a
376 reference-to-hash with the following fields:
382 Gives the number of orders in with this basket number.
384 =item C<authorizedby>
390 These give the value of the corresponding field in the aqorders table
391 of the Koha database.
395 Results are ordered from most to least recent.
401 my $dbh = C4::Context->dbh;
402 my $strsth ="Select count(*),authorisedby,creationdate,aqbasket.basketno,
403 closedate,surname,firstname,aqorders.title
405 left join aqbasket on aqbasket.basketno=aqorders.basketno
406 left join borrowers on aqbasket.authorisedby=borrowers.borrowernumber
407 where booksellerid=? and (quantity > quantityreceived or
408 quantityreceived is NULL) and datecancellationprinted is NULL ";
410 if (C4::Context->preference("IndependantBranches")) {
411 my $userenv = C4::Context->userenv;
412 unless ($userenv->{flags} == 1){
413 $strsth .= " and (borrowers.branchcode = '".$userenv->{branch}."' or borrowers.branchcode ='')";
416 $strsth.=" group by basketno order by aqbasket.basketno";
417 my $sth=$dbh->prepare($strsth);
418 $sth->execute($supplierid);
420 while (my $data=$sth->fetchrow_hashref){
421 push(@results,$data);
424 return (scalar(@results),\@results);
429 ($order, $ordernumber) = &getorder($biblioitemnumber, $biblionumber);
431 Looks up the order with the given biblionumber and biblioitemnumber.
433 Returns a two-element array. C<$ordernumber> is the order number.
434 C<$order> is a reference-to-hash describing the order; its keys are
435 fields from the biblio, biblioitems, aqorders, and aqorderbreakdown
436 tables of the Koha database.
442 my $dbh = C4::Context->dbh;
443 my $sth=$dbh->prepare("Select ordernumber from aqorders where biblionumber=? and biblioitemnumber=?");
444 $sth->execute($bib,$bi);
445 # FIXME - Use fetchrow_array(), since we're only interested in the one
447 my $ordnum=$sth->fetchrow_hashref;
449 my $order=getsingleorder($ordnum->{'ordernumber'});
450 return ($order,$ordnum->{'ordernumber'});
455 $order = &getsingleorder($ordernumber);
457 Looks up an order by order number.
459 Returns a reference-to-hash describing the order. The keys of
460 C<$order> are fields from the biblio, biblioitems, aqorders, and
461 aqorderbreakdown tables of the Koha database.
467 my $dbh = C4::Context->dbh;
468 my $sth=$dbh->prepare("Select * from biblio,biblioitems,aqorders left join aqorderbreakdown
469 on aqorders.ordernumber=aqorderbreakdown.ordernumber
470 where aqorders.ordernumber=?
471 and biblio.biblionumber=aqorders.biblionumber and
472 biblioitems.biblioitemnumber=aqorders.biblioitemnumber");
473 $sth->execute($ordnum);
474 my $data=$sth->fetchrow_hashref;
481 ($count, @results) = &getallorders($booksellerid);
483 Looks up all of the pending orders from the supplier with the given
484 bookseller ID. Ignores cancelled and completed orders.
486 C<$count> is the number of elements in C<@results>. C<@results> is an
487 array of references-to-hash. The keys of each element are fields from
488 the aqorders, biblio, and biblioitems tables of the Koha database.
490 C<@results> is sorted alphabetically by book title.
495 #gets all orders from a certain supplier, orders them alphabetically
497 my $dbh = C4::Context->dbh;
499 my $strsth="Select *,aqorders.title as suggestedtitle,biblio.title as truetitle from aqorders,biblio,biblioitems,aqbasket,aqbooksellers ";
500 $strsth .= ",borrowers " if (C4::Context->preference("IndependantBranches"));
501 $strsth .=" where aqorders.basketno=aqbasket.basketno and aqbasket.booksellerid=aqbooksellers.id and biblio.biblionumber=aqorders.biblionumber ";
502 $strsth .= " and aqbasket.authorisedby=borrowers.borrowernumber" if (C4::Context->preference("IndependantBranches"));
503 $strsth.=" and booksellerid=? and (cancelledby is NULL or cancelledby = '')
504 and (quantityreceived < quantity or quantityreceived is NULL)
505 and biblio.biblionumber=aqorders.biblionumber and biblioitems.biblioitemnumber=
506 aqorders.biblioitemnumber ";
507 if (C4::Context->preference("IndependantBranches")) {
508 my $userenv = C4::Context->userenv;
509 unless ($userenv->{flags} == 1){
510 $strsth .= " and (borrowers.branchcode = '".$userenv->{branch}."' or borrowers.branchcode ='')";
513 $strsth .= " group by aqorders.biblioitemnumber order by biblio.title";
514 my $sth=$dbh->prepare($strsth);
515 $sth->execute($supplierid);
516 while (my $data=$sth->fetchrow_hashref){
517 push(@results,$data);
520 return(scalar(@results),@results);
522 =item getsupplierlistwithlateorders
524 %results = &getsupplierlistwithlateorders;
526 Searches for suppliers with late orders.
530 sub getsupplierlistwithlateorders {
532 my $dbh = C4::Context->dbh;
533 #FIXME NOT quite sure that this operation is valid for DBMs different from Mysql, HOPING so
534 #should be tested with other DBMs
537 my $dbdriver = C4::Context->config("db_scheme")||"mysql";
538 if ($dbdriver eq "mysql"){
539 $strsth="SELECT DISTINCT aqbasket.booksellerid, aqbooksellers.name
540 FROM aqorders, aqbasket
541 LEFT JOIN aqbooksellers ON aqbasket.booksellerid = aqbooksellers.id
542 WHERE aqorders.basketno = aqbasket.basketno AND
543 (closedate < DATE_SUB(CURDATE( ),INTERVAL $delay DAY) AND (datereceived = '' or datereceived is null))
546 $strsth="SELECT DISTINCT aqbasket.booksellerid, aqbooksellers.name
547 FROM aqorders, aqbasket
548 LEFT JOIN aqbooksellers ON aqbasket.aqbooksellerid = aqbooksellers.id
549 WHERE aqorders.basketno = aqbasket.basketno AND
550 (closedate < (CURDATE( )-(INTERVAL $delay DAY))) AND (datereceived = '' or datereceived is null))
553 # warn "C4::Acquisition getsupplierlistwithlateorders : ".$strsth;
554 my $sth = $dbh->prepare($strsth);
557 while (my ($id,$name) = $sth->fetchrow) {
558 $supplierlist{$id} = $name;
560 return %supplierlist;
565 %results = &getlateorders;
567 Searches for suppliers with late orders.
573 my $supplierid = shift;
576 my $dbh = C4::Context->dbh;
577 #BEWARE, order of parenthesis and LEFT JOIN is important for speed
579 my $dbdriver = C4::Context->config("db_scheme")||"mysql";
581 if ($dbdriver eq "mysql"){
582 $strsth ="SELECT aqbasket.basketno,
583 DATE(aqbasket.closedate) as orderdate, aqorders.quantity - IFNULL(aqorders.quantityreceived,0) as quantity, aqorders.rrp as unitpricesupplier,aqorders.ecost as unitpricelib,
584 (aqorders.quantity - IFNULL(aqorders.quantityreceived,0)) * aqorders.rrp as subtotal, aqbookfund.bookfundname as budget, borrowers.branchcode as branch,
585 aqbooksellers.name as supplier,
586 aqorders.title, biblio.author, biblioitems.publishercode as publisher, biblioitems.publicationyear,
587 DATEDIFF(CURDATE( ),closedate) AS latesince
590 (aqorders LEFT JOIN biblio on biblio.biblionumber = aqorders.biblionumber) LEFT JOIN biblioitems on biblioitems.biblionumber=biblio.biblionumber
591 ) LEFT JOIN aqorderbreakdown on aqorders.ordernumber = aqorderbreakdown.ordernumber
592 ) LEFT JOIN aqbookfund on aqorderbreakdown.bookfundid = aqbookfund.bookfundid
593 ),(aqbasket LEFT JOIN borrowers on aqbasket.authorisedby = borrowers.borrowernumber) LEFT JOIN aqbooksellers ON aqbasket.booksellerid = aqbooksellers.id
594 WHERE aqorders.basketno = aqbasket.basketno AND (closedate < DATE_SUB(CURDATE( ),INTERVAL $delay DAY))
595 AND ((datereceived = '' OR datereceived is null) OR (aqorders.quantityreceived < aqorders.quantity) ) ";
596 $strsth .= " AND aqbasket.booksellerid = $supplierid " if ($supplierid);
597 $strsth .= " AND borrowers.branchcode like \'".$branch."\'" if ($branch);
598 $strsth .= " AND borrowers.branchcode like \'".C4::Context->userenv->{branch}."\'" if (C4::Context->preference("IndependantBranches") && C4::Context->userenv && C4::Context->userenv->{flags}!=1);
599 $strsth .= " HAVING quantity<>0 AND unitpricesupplier<>0 AND unitpricelib<>0 ORDER BY latesince,basketno,borrowers.branchcode, supplier ";
601 $strsth ="SELECT aqbasket.basketno,
602 DATE(aqbasket.closedate) as orderdate,
603 aqorders.quantity, aqorders.rrp as unitpricesupplier,aqorders.ecost as unitpricelib, aqorders.quantity * aqorders.rrp as subtotal
604 aqbookfund.bookfundname as budget, borrowers.branchcode as branch,
605 aqbooksellers.name as supplier,
606 biblio.title, biblio.author, biblioitems.publishercode as publisher, biblioitems.publicationyear,
607 (CURDATE - closedate) AS latesince
610 (aqorders LEFT JOIN biblio on biblio.biblionumber = aqorders.biblionumber) LEFT JOIN biblioitems on biblioitems.biblionumber=biblio.biblionumber
611 ) LEFT JOIN aqorderbreakdown on aqorders.ordernumber = aqorderbreakdown.ordernumber
612 ) LEFT JOIN aqbookfund on aqorderbreakdown.bookfundid = aqbookfund.bookfundid
613 ),(aqbasket LEFT JOIN borrowers on aqbasket.authorisedby = borrowers.borrowernumber) LEFT JOIN aqbooksellers ON aqbasket.booksellerid = aqbooksellers.id
614 WHERE aqorders.basketno = aqbasket.basketno AND (closedate < (CURDATE -(INTERVAL $delay DAY))
615 AND ((datereceived = '' OR datereceived is null) OR (aqorders.quantityreceived < aqorders.quantity) ) ";
616 $strsth .= " AND aqbasket.booksellerid = $supplierid " if ($supplierid);
617 $strsth .= " AND borrowers.branchcode like \'".$branch."\'" if ($branch);
618 $strsth .= " AND borrowers.branchcode like \'".C4::Context->userenv->{branch}."\'" if (C4::Context->preference("IndependantBranches") && C4::Context->userenv->{flags}!=1);
619 $strsth .= " ORDER BY latesince,basketno,borrowers.branchcode, supplier";
621 warn "C4::Acquisition : getlateorders SQL:".$strsth;
622 my $sth = $dbh->prepare($strsth);
626 while (my $data = $sth->fetchrow_hashref) {
627 $data->{hilighted}=$hilighted if ($hilighted>0);
628 $data->{orderdate} = format_date($data->{orderdate});
629 push @results, $data;
630 $hilighted= -$hilighted;
633 return(scalar(@results),@results);
638 #gets all orders from a certain supplier, orders them alphabetically
640 my $dbh = C4::Context->dbh;
642 my $sth=$dbh->prepare("Select * from aqorders,biblio,biblioitems where booksellerid=?
643 and (cancelledby is NULL or cancelledby = '')
644 and biblio.biblionumber=aqorders.biblionumber and biblioitems.biblioitemnumber=
645 aqorders.biblioitemnumber and
646 aqorders.quantityreceived>0
647 and aqorders.datereceived >=now()
648 group by aqorders.biblioitemnumber
651 $sth->execute($supid);
652 while (my $data=$sth->fetchrow_hashref){
653 push(@results,$data);
656 return(scalar(@results),@results);
661 ($count, @results) = &ordersearch($search, $biblionumber, $complete);
665 C<$search> may take one of several forms: if it is an ISBN,
666 C<&ordersearch> returns orders with that ISBN. If C<$search> is an
667 order number, C<&ordersearch> returns orders with that order number
668 and biblionumber C<$biblionumber>. Otherwise, C<$search> is considered
669 to be a space-separated list of search terms; in this case, all of the
670 terms must appear in the title (matching the beginning of title
673 If C<$complete> is C<yes>, the results will include only completed
674 orders. In any case, C<&ordersearch> ignores cancelled orders.
676 C<&ordersearch> returns an array. C<$count> is the number of elements
677 in C<@results>. C<@results> is an array of references-to-hash with the
695 my ($search,$id,$biblio,$catview) = @_;
696 my $dbh = C4::Context->dbh;
697 my @data = split(' ',$search);
698 my @searchterms = ($id);
699 map { push(@searchterms,"$_%","% $_%") } @data;
700 push(@searchterms,$search,$search,$biblio);
701 my $sth=$dbh->prepare("Select biblio.*,biblioitems.*,aqorders.*,aqbasket.*,biblio.title from aqorders,biblioitems,biblio,aqbasket
702 where aqorders.biblioitemnumber = biblioitems.biblioitemnumber and
703 aqorders.basketno = aqbasket.basketno
704 and aqbasket.booksellerid = ?
705 and biblio.biblionumber=aqorders.biblionumber
706 and ((datecancellationprinted is NULL)
707 or (datecancellationprinted = '0000-00-00'))
709 .(join(" and ",map { "(biblio.title like ? or biblio.title like ?)" } @data))
710 .") or biblioitems.isbn=? or (aqorders.ordernumber=? and aqorders.biblionumber=?)) "
711 .(($catview ne 'yes')?" and (quantityreceived < quantity or quantityreceived is NULL)":"")
712 ." group by aqorders.ordernumber");
713 $sth->execute(@searchterms);
715 my $sth2=$dbh->prepare("Select * from biblio where biblionumber=?");
716 my $sth3=$dbh->prepare("Select * from aqorderbreakdown where ordernumber=?");
717 while (my $data=$sth->fetchrow_hashref){
718 $sth2->execute($data->{'biblionumber'});
719 my $data2=$sth2->fetchrow_hashref;
720 $data->{'author'}=$data2->{'author'};
721 $data->{'seriestitle'}=$data2->{'seriestitle'};
722 $sth3->execute($data->{'ordernumber'});
723 my $data3=$sth3->fetchrow_hashref;
724 $data->{'branchcode'}=$data3->{'branchcode'};
725 $data->{'bookfundid'}=$data3->{'bookfundid'};
726 push(@results,$data);
731 return(scalar(@results),@results);
736 my ($title,$author,$name,$from_placed_on,$to_placed_on)=@_;
739 my $total_qtyreceived=0;
741 # don't run the query if there are no parameters (list would be too long for sure !
742 if ($title || $author || $name || $from_placed_on || $to_placed_on) {
743 my $dbh= C4::Context->dbh;
744 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";
745 $query .= ",borrowers " if (C4::Context->preference("IndependantBranches"));
746 $query .=" where aqorders.basketno=aqbasket.basketno and aqbasket.booksellerid=aqbooksellers.id and biblio.biblionumber=aqorders.biblionumber ";
747 $query .= " and aqbasket.authorisedby=borrowers.borrowernumber" if (C4::Context->preference("IndependantBranches"));
748 $query .= " and biblio.title like ".$dbh->quote("%".$title."%") if $title;
749 $query .= " and biblio.author like ".$dbh->quote("%".$author."%") if $author;
750 $query .= " and name like ".$dbh->quote("%".$name."%") if $name;
751 $query .= " and creationdate >" .$dbh->quote($from_placed_on) if $from_placed_on;
752 $query .= " and creationdate<".$dbh->quote($to_placed_on) if $to_placed_on;
753 if (C4::Context->preference("IndependantBranches")) {
754 my $userenv = C4::Context->userenv;
755 if (($userenv) &&($userenv->{flags} != 1)){
756 $query .= " and (borrowers.branchcode = '".$userenv->{branch}."' or borrowers.branchcode ='')";
759 $query .=" order by booksellerid";
760 warn "query histearch: ".$query;
761 my $sth = $dbh->prepare($query);
764 while (my $line = $sth->fetchrow_hashref) {
765 $line->{count}=$cnt++;
766 $line->{toggle}=1 if $cnt %2;
767 push @order_loop, $line;
768 $line->{creationdate} = format_date($line->{creationdate});
769 $line->{datereceived} = format_date($line->{datereceived});
770 $total_qty += $line->{'quantity'};
771 $total_qtyreceived += $line->{'quantityreceived'};
772 $total_price += $line->{'quantity'}*$line->{'ecost'};
775 return \@order_loop,$total_qty,$total_price,$total_qtyreceived;
785 ($count, @results) = &invoice($booksellerinvoicenumber);
787 Looks up orders by invoice number.
789 Returns an array. C<$count> is the number of elements in C<@results>.
790 C<@results> is an array of references-to-hash; the keys of each
791 elements are fields from the aqorders, biblio, and biblioitems tables
792 of the Koha database.
798 my $dbh = C4::Context->dbh;
800 my $sth=$dbh->prepare("Select * from aqorders,biblio,biblioitems where
801 booksellerinvoicenumber=?
802 and biblio.biblionumber=aqorders.biblionumber and biblioitems.biblioitemnumber=
803 aqorders.biblioitemnumber group by aqorders.ordernumber,aqorders.biblioitemnumber");
804 $sth->execute($invoice);
805 while (my $data=$sth->fetchrow_hashref){
806 push(@results,$data);
809 return(scalar(@results),@results);
814 ($count, @results) = &bookfunds();
816 Returns a list of all book funds.
818 C<$count> is the number of elements in C<@results>. C<@results> is an
819 array of references-to-hash, whose keys are fields from the aqbookfund
820 and aqbudget tables of the Koha database. Results are ordered
821 alphabetically by book fund name.
827 my $dbh = C4::Context->dbh;
831 $strsth="Select * from aqbookfund,aqbudget where aqbookfund.bookfundid
832 =aqbudget.bookfundid and startdate<now() and enddate>now() and (aqbookfund.branchcode is null or aqbookfund.branchcode='' or aqbookfund.branchcode= ? )
833 group by aqbookfund.bookfundid order by bookfundname";
835 $strsth="Select * from aqbookfund,aqbudget where aqbookfund.bookfundid
836 =aqbudget.bookfundid and startdate<now() and enddate>now()
837 group by aqbookfund.bookfundid order by bookfundname";
839 my $sth=$dbh->prepare($strsth);
841 $sth->execute($branch);
846 while (my $data=$sth->fetchrow_hashref){
847 push(@results,$data);
850 return(scalar(@results),@results);
853 =item bookfundbreakdown
855 returns the total comtd & spent for a given bookfund, and a given year
856 used in acqui-home.pl
860 sub bookfundbreakdown {
862 my $dbh = C4::Context->dbh;
863 my $sth=$dbh->prepare("SELECT startdate, enddate, quantity, datereceived, freight, unitprice, listprice, ecost, quantityreceived, subscription
864 FROM aqorders, aqorderbreakdown, aqbudget, aqbasket
865 WHERE aqorderbreakdown.bookfundid = ?
866 AND aqorders.ordernumber = aqorderbreakdown.ordernumber
868 datecancellationprinted IS NULL
869 OR datecancellationprinted = '0000-00-00'
871 AND aqbudget.bookfundid = aqorderbreakdown.bookfundid
872 AND aqbasket.basketno = aqorders.basketno
873 AND aqbasket.creationdate >= startdate
874 AND enddate >= aqbasket.creationdate
875 and startdate<=now() and enddate>=now()");
879 while (my $data=$sth->fetchrow_hashref){
880 if ($data->{'subscription'} == 1){
881 $spent+=$data->{'quantity'}*$data->{'unitprice'};
883 my $leftover=$data->{'quantity'}-$data->{'quantityreceived'};
884 $comtd+=($data->{'ecost'})*$leftover;
885 $spent+=($data->{'unitprice'})*$data->{'quantityreceived'};
889 return($spent,$comtd);
896 $foreignprice = &curconvert($currency, $localprice);
898 Converts the price C<$localprice> to foreign currency C<$currency> by
899 dividing by the exchange rate, and returns the result.
901 If no exchange rate is found, C<&curconvert> assumes the rate is one
907 my ($currency,$price)=@_;
908 my $dbh = C4::Context->dbh;
909 my $sth=$dbh->prepare("Select rate from currency where currency=?");
910 $sth->execute($currency);
911 my $cur=($sth->fetchrow_array())[0];
916 return($price / $cur);
921 ($count, $currencies) = &getcurrencies();
923 Returns the list of all known currencies.
925 C<$count> is the number of elements in C<$currencies>. C<$currencies>
926 is a reference-to-array; its elements are references-to-hash, whose
927 keys are the fields from the currency table in the Koha database.
932 my $dbh = C4::Context->dbh;
933 my $sth=$dbh->prepare("Select * from currency");
936 while (my $data=$sth->fetchrow_hashref){
937 push(@results,$data);
940 return(scalar(@results),\@results);
943 =item updatecurrencies
945 &updatecurrencies($currency, $newrate);
947 Sets the exchange rate for C<$currency> to be C<$newrate>.
951 sub updatecurrencies {
952 my ($currency,$rate)=@_;
953 my $dbh = C4::Context->dbh;
954 my $sth=$dbh->prepare("update currency set rate=? where currency=?");
955 $sth->execute($rate,$currency);
967 ($count, @results) = &bookseller($searchstring);
969 Looks up a book seller. C<$searchstring> may be either a book seller
970 ID, or a string to look for in the book seller's name.
972 C<$count> is the number of elements in C<@results>. C<@results> is an
973 array of references-to-hash, whose keys are the fields of of the
974 aqbooksellers table in the Koha database.
979 my ($searchstring)=@_;
980 my $dbh = C4::Context->dbh;
981 my $sth=$dbh->prepare("Select * from aqbooksellers where name like ? or id = ?");
982 $sth->execute("$searchstring%",$searchstring);
984 while (my $data=$sth->fetchrow_hashref){
985 push(@results,$data);
988 return(scalar(@results),@results);
993 ($count, $results) = &breakdown($ordernumber);
995 Looks up an order by order ID, and returns its breakdown.
997 C<$count> is the number of elements in C<$results>. C<$results> is a
998 reference-to-array; its elements are references-to-hash, whose keys
999 are the fields of the aqorderbreakdown table in the Koha database.
1005 my $dbh = C4::Context->dbh;
1006 my $sth=$dbh->prepare("Select * from aqorderbreakdown where ordernumber=?");
1009 while (my $data=$sth->fetchrow_hashref){
1010 push(@results,$data);
1013 return(scalar(@results),\@results);
1018 &updatesup($bookseller);
1020 Updates the information for a given bookseller. C<$bookseller> is a
1021 reference-to-hash whose keys are the fields of the aqbooksellers table
1022 in the Koha database. It must contain entries for all of the fields.
1023 The entry to modify is determined by C<$bookseller-E<gt>{id}>.
1025 The easiest way to get all of the necessary fields is to look up a
1026 book seller with C<&booksellers>, modify what's necessary, then call
1027 C<&updatesup> with the result.
1033 my $dbh = C4::Context->dbh;
1034 my $sth=$dbh->prepare("Update aqbooksellers set
1035 name=?,address1=?,address2=?,address3=?,address4=?,postal=?,
1036 phone=?,fax=?,url=?,contact=?,contpos=?,contphone=?,contfax=?,contaltphone=?,
1037 contemail=?,contnotes=?,active=?,
1038 listprice=?, invoiceprice=?,gstreg=?, listincgst=?,
1039 invoiceincgst=?, specialty=?,discount=?,invoicedisc=?,
1042 $sth->execute($data->{'name'},$data->{'address1'},$data->{'address2'},
1043 $data->{'address3'},$data->{'address4'},$data->{'postal'},$data->{'phone'},
1044 $data->{'fax'},$data->{'url'},$data->{'contact'},$data->{'contpos'},
1045 $data->{'contphone'},$data->{'contfax'},$data->{'contaltphone'},
1046 $data->{'contemail'},
1047 $data->{'contnote'},$data->{'active'},$data->{'listprice'},
1048 $data->{'invoiceprice'},$data->{'gstreg'},$data->{'listincgst'},
1049 $data->{'invoiceincgst'},$data->{'specialty'},$data->{'discount'},
1050 $data->{'invoicedisc'},$data->{'nocalc'},$data->{'id'});
1056 $id = &insertsup($bookseller);
1058 Creates a new bookseller. C<$bookseller> is a reference-to-hash whose
1059 keys are the fields of the aqbooksellers table in the Koha database.
1060 All fields must be present.
1062 Returns the ID of the newly-created bookseller.
1068 my $dbh = C4::Context->dbh;
1069 my $sth=$dbh->prepare("Select max(id) from aqbooksellers");
1071 my $data2=$sth->fetchrow_hashref;
1073 $data2->{'max(id)'}++;
1074 $sth=$dbh->prepare("Insert into aqbooksellers (id) values (?)");
1075 $sth->execute($data2->{'max(id)'});
1077 $data->{'id'}=$data2->{'max(id)'};
1079 return($data->{'id'});
1082 END { } # module clean-up code here (global destructor)
1091 Koha Developement team <info@koha.org>