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
29 use vars qw($VERSION @ISA @EXPORT);
31 # set the version for version checking
32 $VERSION = do { my @v = '$Revision$' =~ /\d+/g; shift(@v) . "." . join( "_", map { sprintf "%03d", $_ } @v ); };
34 # used in reciveorder subroutine
35 # to provide library specific handling
36 my $library_name = C4::Context->preference("LibraryName");
40 C4::Acquisition - Koha functions for dealing with orders and acquisitions
48 The functions in this module deal with acquisitions, managing book
49 orders, converting money to different currencies, and so forth.
59 &getbasket &getbasketcontent &newbasket &closebasket
61 &getorders &getallorders &getrecorders
62 &getorder &neworder &delorder
63 &ordersearch &histsearch
64 &modorder &getsingleorder &invoice &receiveorder
65 &updaterecorder &newordernum
66 &getsupplierlistwithlateorders
68 &getparcels &getparcelinformation
69 &bookfunds &curconvert &getcurrencies &bookfundbreakdown
70 &updatecurrencies &getcurrency
72 &bookseller &breakdown
85 $aqbasket = &getbasket($basketnumber);
87 get all basket informations in aqbasket for a given basket
92 my $dbh = C4::Context->dbh;
95 "select aqbasket.*,borrowers.firstname+' '+borrowers.surname as authorisedbyname, borrowers.branchcode as branch from aqbasket left join borrowers on aqbasket.authorisedby=borrowers.borrowernumber where basketno=?"
97 $sth->execute($basketno);
98 return ( $sth->fetchrow_hashref );
102 =item getbasketcontent
104 ($count, @orders) = &getbasketcontent($basketnumber, $booksellerID);
106 Looks up the pending (non-cancelled) orders with the given basket
107 number. If C<$booksellerID> is non-empty, only orders from that seller
110 C<&basket> returns a two-element array. C<@orders> is an array of
111 references-to-hash, whose keys are the fields from the aqorders,
112 biblio, and biblioitems tables in the Koha database. C<$count> is the
113 number of elements in C<@orders>.
118 sub getbasketcontent {
119 my ( $basketno, $supplier, $orderby ) = @_;
120 my $dbh = C4::Context->dbh;
122 "SELECT aqorderbreakdown.*,biblio.*,biblioitems.*,aqorders.*,biblio.title FROM aqorders,biblio,biblioitems
123 LEFT JOIN aqorderbreakdown ON aqorderbreakdown.ordernumber=aqorders.ordernumber
125 AND biblio.biblionumber=aqorders.biblionumber AND biblioitems.biblioitemnumber
126 =aqorders.biblioitemnumber
127 AND (datecancellationprinted IS NULL OR datecancellationprinted =
129 if ( $supplier ne '' ) {
130 $query .= " AND aqorders.booksellerid=?";
133 $orderby = "biblioitems.publishercode" unless $orderby;
134 $query .= " ORDER BY $orderby";
135 my $sth = $dbh->prepare($query);
136 if ( $supplier ne '' ) {
137 $sth->execute( $basketno, $supplier );
140 $sth->execute($basketno);
146 while ( my $data = $sth->fetchrow_hashref ) {
147 $results[$i] = $data;
151 return ( $i, @results );
156 $basket = &newbasket();
158 Create a new basket in aqbasket table
162 my ( $booksellerid, $authorisedby ) = @_;
163 my $dbh = C4::Context->dbh;
166 "insert into aqbasket (creationdate,booksellerid,authorisedby) values(now(),'$booksellerid','$authorisedby')"
169 #find & return basketno MYSQL dependant, but $dbh->last_insert_id always returns null :-(
170 my $basket = $dbh->{'mysql_insertid'};
176 &newbasket($basketno);
178 close a basket (becomes unmodifiable,except for recieves
183 my $dbh = C4::Context->dbh;
185 $dbh->prepare("update aqbasket set closedate=now() where basketno=?");
186 $sth->execute($basketno);
191 &neworder($basket, $biblionumber, $title, $quantity, $listprice,
192 $booksellerid, $who, $notes, $bookfund, $biblioitemnumber, $rrp,
193 $ecost, $gst, $budget, $unitprice, $subscription,
194 $booksellerinvoicenumber);
196 Adds a new order to the database. Any argument that isn't described
197 below is the new value of the field with the same name in the aqorders
198 table of the Koha database.
200 C<$ordnum> is a "minimum order number." After adding the new entry to
201 the aqorders table, C<&neworder> finds the first entry in aqorders
202 with order number greater than or equal to C<$ordnum>, and adds an
203 entry to the aqorderbreakdown table, with the order number just found,
204 and the book fund ID of the newly-added order.
206 C<$budget> is effectively ignored.
208 C<$subscription> may be either "yes", or anything else for "no".
215 $basketno, $bibnum, $title, $quantity,
216 $listprice, $booksellerid, $authorisedby, $notes,
217 $bookfund, $bibitemnum, $rrp, $ecost,
218 $gst, $budget, $cost, $sub,
219 $invoice, $sort1, $sort2
224 if ( !$budget || $budget eq 'now' ) {
225 $sth = $dbh->prepare(
226 "INSERT INTO aqorders
227 (biblionumber,title,basketno,quantity,listprice,notes,
228 biblioitemnumber,rrp,ecost,gst,unitprice,subscription,sort1,sort2,budgetdate,entrydate)
229 VALUES ( ?,?,?,?,?,?,?,?,?,?,?,?,?,?,now(),now() )"
232 $bibnum, $title, $basketno, $quantity, $listprice,
233 $notes, $bibitemnum, $rrp, $ecost, $gst,
234 $cost, $sub, $sort1, $sort2
239 ##FIXME HARDCODED DATE.
240 $budget = "'2006-07-01'";
241 $sth = $dbh->prepare(
242 "INSERT INTO aqorders
243 (biblionumber,title,basketno,quantity,listprice,notes,
244 biblioitemnumber,rrp,ecost,gst,unitprice,subscription,sort1,sort2,budgetdate,entrydate)
245 VALUES ( ?,?,?,?,?,?,?,?,?,?,?,?,?,?,?,now() )"
248 $bibnum, $title, $basketno, $quantity, $listprice,
249 $notes, $bibitemnum, $rrp, $ecost, $gst,
250 $cost, $sub, $sort1, $sort2, $budget
256 #get ordnum MYSQL dependant, but $dbh->last_insert_id returns null
257 my $ordnum = $dbh->{'mysql_insertid'};
258 $sth = $dbh->prepare(
259 "INSERT INTO aqorderbreakdown (ordernumber,bookfundid) VALUES
262 $sth->execute( $ordnum, $bookfund );
269 &delorder($biblionumber, $ordernumber);
271 Cancel the order with the given order and biblio numbers. It does not
272 delete any entries in the aqorders table, it merely marks them as
279 my ( $bibnum, $ordnum ) = @_;
280 my $dbh = C4::Context->dbh;
281 my $sth = $dbh->prepare(
282 "update aqorders set datecancellationprinted=now()
283 where biblionumber=? and ordernumber=?"
285 $sth->execute( $bibnum, $ordnum );
291 &modorder($title, $ordernumber, $quantity, $listprice,
292 $biblionumber, $basketno, $supplier, $who, $notes,
293 $bookfundid, $bibitemnum, $rrp, $ecost, $gst, $budget,
294 $unitprice, $booksellerinvoicenumber);
296 Modifies an existing order. Updates the order with order number
297 C<$ordernumber> and biblionumber C<$biblionumber>. All other arguments
298 update the fields with the same name in the aqorders table of the Koha
301 Entries with order number C<$ordernumber> in the aqorderbreakdown
302 table are also updated to the new book fund ID.
309 $title, $ordnum, $quantity, $listprice, $bibnum,
310 $basketno, $supplier, $who, $notes, $bookfund,
311 $bibitemnum, $rrp, $ecost, $gst, $budget,
312 $cost, $invoice, $sort1, $sort2
315 my $dbh = C4::Context->dbh;
316 my $sth = $dbh->prepare(
317 "update aqorders set title=?,
318 quantity=?,listprice=?,basketno=?,
319 rrp=?,ecost=?,unitprice=?,booksellerinvoicenumber=?,
320 notes=?,sort1=?, sort2=?
322 ordernumber=? and biblionumber=?"
325 $title, $quantity, $listprice, $basketno, $rrp,
326 $ecost, $cost, $invoice, $notes, $sort1,
327 $sort2, $ordnum, $bibnum
330 $sth = $dbh->prepare(
331 "update aqorderbreakdown set bookfundid=? where
335 unless ( $sth->execute( $bookfund, $ordnum ) )
336 { # zero rows affected [Bug 734]
338 "insert into aqorderbreakdown (ordernumber,bookfundid) values (?,?)";
339 $sth = $dbh->prepare($query);
340 $sth->execute( $ordnum, $bookfund );
347 $order = &newordernum();
349 Finds the next unused order number in the aqorders table of the Koha
350 database, and returns it.
355 # FIXME - Race condition
357 my $dbh = C4::Context->dbh;
358 my $sth = $dbh->prepare("Select max(ordernumber) from aqorders");
360 my $data = $sth->fetchrow_arrayref;
361 my $ordnum = $$data[0];
369 &receiveorder($biblionumber, $ordernumber, $quantityreceived, $user,
370 $unitprice, $booksellerinvoicenumber, $biblioitemnumber,
371 $freight, $bookfund, $rrp);
373 Updates an order, to reflect the fact that it was received, at least
374 in part. All arguments not mentioned below update the fields with the
375 same name in the aqorders table of the Koha database.
377 Updates the order with bibilionumber C<$biblionumber> and ordernumber
380 Also updates the book fund ID in the aqorderbreakdown table.
386 my ( $biblio, $ordnum, $quantrec, $user, $cost, $invoiceno, $freight, $rrp, $bookfund)
388 my $dbh = C4::Context->dbh;
389 my $sth = $dbh->prepare(
390 "update aqorders set quantityreceived=?,datereceived=now(),booksellerinvoicenumber=?,
391 unitprice=?,freight=?,rrp=?
392 where biblionumber=? and ordernumber=?"
394 my $suggestionid = GetSuggestionFromBiblionumber( $dbh, $biblio );
396 ModStatus( $suggestionid, 'AVAILABLE', '', $biblio );
398 $sth->execute( $quantrec, $invoiceno, $cost, $freight, $rrp, $biblio,
402 # Allows libraries to change their bookfund during receiving orders
403 # allows them to adjust budgets
404 if ( C4::Context->preferene("LooseBudgets") ) {
405 my $sth = $dbh->prepare(
406 "UPDATE aqorderbreakdown SET bookfundid=?
409 $sth->execute( $bookfund, $ordnum );
416 &updaterecorder($biblionumber, $ordernumber, $user, $unitprice,
419 Updates the order with biblionumber C<$biblionumber> and order number
420 C<$ordernumber>. C<$bookfundid> is the new value for the book fund ID
421 in the aqorderbreakdown table of the Koha database. All other
422 arguments update the fields with the same name in the aqorders table.
430 my ( $biblio, $ordnum, $user, $cost, $bookfund, $rrp ) = @_;
431 my $dbh = C4::Context->dbh;
432 my $sth = $dbh->prepare(
435 where biblionumber=? and ordernumber=?
438 $sth->execute( $cost, $rrp, $biblio, $ordnum );
442 "update aqorderbreakdown set bookfundid=? where ordernumber=?");
443 $sth->execute( $bookfund, $ordnum );
455 ($count, $orders) = &getorders($booksellerid);
457 Finds pending orders from the bookseller with the given ID. Ignores
458 completed and cancelled orders.
460 C<$count> is the number of elements in C<@{$orders}>.
462 C<$orders> is a reference-to-array; each element is a
463 reference-to-hash with the following fields:
469 Gives the number of orders in with this basket number.
471 =item C<authorizedby>
477 These give the value of the corresponding field in the aqorders table
478 of the Koha database.
482 Results are ordered from most to least recent.
488 my ($supplierid) = @_;
489 my $dbh = C4::Context->dbh;
490 my $strsth = "Select count(*),authorisedby,creationdate,aqbasket.basketno,
491 closedate,surname,firstname,aqorders.title
493 left join aqbasket on aqbasket.basketno=aqorders.basketno
494 left join borrowers on aqbasket.authorisedby=borrowers.borrowernumber
495 where booksellerid=? and (quantity > quantityreceived or
496 quantityreceived is NULL) and datecancellationprinted is NULL and (to_days(now())-to_days(closedate) < 180 or closedate is null)";
497 if ( C4::Context->preference("IndependantBranches") ) {
498 my $userenv = C4::Context->userenv;
499 if ( ($userenv) && ( $userenv->{flags} != 1 ) ) {
501 " and (borrowers.branchcode = '"
503 . "' or borrowers.branchcode ='')";
506 $strsth .= " group by basketno order by aqbasket.basketno";
507 my $sth = $dbh->prepare($strsth);
508 $sth->execute($supplierid);
510 while ( my $data = $sth->fetchrow_hashref ) {
511 push( @results, $data );
514 return ( scalar(@results), \@results );
519 ($order, $ordernumber) = &getorder($biblioitemnumber, $biblionumber);
521 Looks up the order with the given biblionumber and biblioitemnumber.
523 Returns a two-element array. C<$ordernumber> is the order number.
524 C<$order> is a reference-to-hash describing the order; its keys are
525 fields from the biblio, biblioitems, aqorders, and aqorderbreakdown
526 tables of the Koha database.
531 my ( $bi, $bib ) = @_;
532 my $dbh = C4::Context->dbh;
535 "Select ordernumber from aqorders where biblionumber=? and biblioitemnumber=?"
537 $sth->execute( $bib, $bi );
539 # FIXME - Use fetchrow_array(), since we're only interested in the one
541 my $ordnum = $sth->fetchrow_hashref;
543 my $order = getsingleorder( $ordnum->{'ordernumber'} );
544 return ( $order, $ordnum->{'ordernumber'} );
549 $order = &getsingleorder($ordernumber);
551 Looks up an order by order number.
553 Returns a reference-to-hash describing the order. The keys of
554 C<$order> are fields from the biblio, biblioitems, aqorders, and
555 aqorderbreakdown tables of the Koha database.
561 my $dbh = C4::Context->dbh;
562 my $sth = $dbh->prepare(
563 "Select * from biblio,biblioitems,aqorders left join aqorderbreakdown
564 on aqorders.ordernumber=aqorderbreakdown.ordernumber
565 where aqorders.ordernumber=?
566 and biblio.biblionumber=aqorders.biblionumber and
567 biblioitems.biblioitemnumber=aqorders.biblioitemnumber"
569 $sth->execute($ordnum);
570 my $data = $sth->fetchrow_hashref;
577 ($count, @results) = &getallorders($booksellerid);
579 Looks up all of the pending orders from the supplier with the given
580 bookseller ID. Ignores cancelled and completed orders.
582 C<$count> is the number of elements in C<@results>. C<@results> is an
583 array of references-to-hash. The keys of each element are fields from
584 the aqorders, biblio, and biblioitems tables of the Koha database.
586 C<@results> is sorted alphabetically by book title.
593 #gets all orders from a certain supplier, orders them alphabetically
594 my ($supplierid) = @_;
595 my $dbh = C4::Context->dbh;
597 my $strsth = "Select count(*),authorisedby,creationdate,aqbasket.basketno,
598 closedate,surname,firstname,aqorders.biblionumber,aqorders.title, aqorders.ordernumber
600 left join aqbasket on aqbasket.basketno=aqorders.basketno
601 left join borrowers on aqbasket.authorisedby=borrowers.borrowernumber
602 where booksellerid=? and (quantity > quantityreceived or
603 quantityreceived is NULL) and datecancellationprinted is NULL ";
605 if ( C4::Context->preference("IndependantBranches") ) {
606 my $userenv = C4::Context->userenv;
607 if ( ($userenv) && ( $userenv->{flags} != 1 ) ) {
609 " and (borrowers.branchcode = '"
611 . "' or borrowers.branchcode ='')";
614 $strsth .= " group by basketno order by aqbasket.basketno";
615 my $sth = $dbh->prepare($strsth);
616 $sth->execute($supplierid);
617 while ( my $data = $sth->fetchrow_hashref ) {
618 push( @results, $data );
621 return ( scalar(@results), @results );
624 =item getparcelinformation
626 ($count, @results) = &getparcelinformation($booksellerid, $code, $date);
628 Looks up all of the received items from the supplier with the given
629 bookseller ID at the given date, for the given code. Ignores cancelled and completed orders.
631 C<$count> is the number of elements in C<@results>. C<@results> is an
632 array of references-to-hash. The keys of each element are fields from
633 the aqorders, biblio, and biblioitems tables of the Koha database.
635 C<@results> is sorted alphabetically by book title.
640 sub getparcelinformation {
642 #gets all orders from a certain supplier, orders them alphabetically
643 my ( $supplierid, $code, $datereceived ) = @_;
644 my $dbh = C4::Context->dbh;
647 if $code; # add % if we search on a given code (otherwise, let him empty)
649 "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\'";
651 if ( C4::Context->preference("IndependantBranches") ) {
652 my $userenv = C4::Context->userenv;
653 if ( ($userenv) && ( $userenv->{flags} != 1 ) ) {
655 " and (borrowers.branchcode = '"
657 . "' or borrowers.branchcode ='')";
660 $strsth .= " order by aqbasket.basketno";
661 ### parcelinformation : $strsth
662 my $sth = $dbh->prepare($strsth);
663 $sth->execute($supplierid);
664 while ( my $data = $sth->fetchrow_hashref ) {
665 push( @results, $data );
667 my $count = scalar(@results);
668 ### countparcelbiblio: $count
671 return ( scalar(@results), @results );
673 =item getparcelinformation
675 ($count, @results) = &getparcelinformation($booksellerid, $code, $date);
677 Looks up all of the received items from the supplier with the given
678 bookseller ID at the given date, for the given code. Ignores cancelled and completed orders.
680 C<$count> is the number of elements in C<@results>. C<@results> is an
681 array of references-to-hash. The keys of each element are fields from
682 the aqorders, biblio, and biblioitems tables of the Koha database.
684 C<@results> is sorted alphabetically by book title.
688 sub getparcelinformation {
689 #gets all orders from a certain supplier, orders them alphabetically
690 my ($supplierid,$code, $datereceived)=@_;
691 my $dbh = C4::Context->dbh;
693 $code .='%' if $code; # add % if we search on a given code (otherwise, let him empty)
694 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\'";
696 if (C4::Context->preference("IndependantBranches")) {
697 my $userenv = C4::Context->userenv;
698 if (($userenv) &&($userenv->{flags} != 1)){
699 $strsth .= " and (borrowers.branchcode = '".$userenv->{branch}."' or borrowers.branchcode ='')";
702 $strsth.=" order by aqbasket.basketno";
703 ### parcelinformation : $strsth
704 my $sth=$dbh->prepare($strsth);
705 $sth->execute($supplierid);
706 while (my $data=$sth->fetchrow_hashref){
707 push(@results,$data);
709 my $count =scalar(@results);
710 ### countparcelbiblio: $count
713 return(scalar(@results),@results);
715 =item getsupplierlistwithlateorders
717 %results = &getsupplierlistwithlateorders;
719 Searches for suppliers with late orders.
724 sub getsupplierlistwithlateorders {
726 my $dbh = C4::Context->dbh;
728 #FIXME NOT quite sure that this operation is valid for DBMs different from Mysql, HOPING so
729 #should be tested with other DBMs
732 my $dbdriver = C4::Context->config("db_scheme") || "mysql";
733 if ( $dbdriver eq "mysql" ) {
734 $strsth = "SELECT DISTINCT aqbasket.booksellerid, aqbooksellers.name
735 FROM aqorders, aqbasket
736 LEFT JOIN aqbooksellers ON aqbasket.booksellerid = aqbooksellers.id
737 WHERE aqorders.basketno = aqbasket.basketno AND
738 (closedate < DATE_SUB(CURDATE( ),INTERVAL $delay DAY) AND (datereceived = '' or datereceived is null))
742 $strsth = "SELECT DISTINCT aqbasket.booksellerid, aqbooksellers.name
743 FROM aqorders, aqbasket
744 LEFT JOIN aqbooksellers ON aqbasket.aqbooksellerid = aqbooksellers.id
745 WHERE aqorders.basketno = aqbasket.basketno AND
746 (closedate < (CURDATE( )-(INTERVAL $delay DAY))) AND (datereceived = '' or datereceived is null))
750 # warn "C4::Acquisition getsupplierlistwithlateorders : ".$strsth;
751 my $sth = $dbh->prepare($strsth);
754 while ( my ( $id, $name ) = $sth->fetchrow ) {
755 $supplierlist{$id} = $name;
757 return %supplierlist;
762 %results = &getlateorders;
764 Searches for suppliers with late orders.
771 my $supplierid = shift;
774 my $dbh = C4::Context->dbh;
776 #BEWARE, order of parenthesis and LEFT JOIN is important for speed
778 my $dbdriver = C4::Context->config("db_scheme") || "mysql";
781 if ( $dbdriver eq "mysql" ) {
782 $strsth = "SELECT aqbasket.basketno,
783 DATE(aqbasket.closedate) as orderdate, aqorders.quantity - IFNULL(aqorders.quantityreceived,0) as quantity, aqorders.rrp as unitpricesupplier,aqorders.ecost as unitpricelib,
784 (aqorders.quantity - IFNULL(aqorders.quantityreceived,0)) * aqorders.rrp as subtotal, aqbookfund.bookfundname as budget, borrowers.branchcode as branch,
785 aqbooksellers.name as supplier,
786 aqorders.title, biblio.author, biblioitems.publishercode as publisher, biblioitems.publicationyear,
787 DATEDIFF(CURDATE( ),closedate) AS latesince
790 (aqorders LEFT JOIN biblio on biblio.biblionumber = aqorders.biblionumber) LEFT JOIN biblioitems on biblioitems.biblionumber=biblio.biblionumber
791 ) LEFT JOIN aqorderbreakdown on aqorders.ordernumber = aqorderbreakdown.ordernumber
792 ) LEFT JOIN aqbookfund on aqorderbreakdown.bookfundid = aqbookfund.bookfundid
793 ),(aqbasket LEFT JOIN borrowers on aqbasket.authorisedby = borrowers.borrowernumber) LEFT JOIN aqbooksellers ON aqbasket.booksellerid = aqbooksellers.id
794 WHERE aqorders.basketno = aqbasket.basketno AND (closedate < DATE_SUB(CURDATE( ),INTERVAL $delay DAY))
795 AND ((datereceived = '' OR datereceived is null) OR (aqorders.quantityreceived < aqorders.quantity) ) ";
796 $strsth .= " AND aqbasket.booksellerid = $supplierid " if ($supplierid);
797 $strsth .= " AND borrowers.branchcode like \'" . $branch . "\'"
800 " AND borrowers.branchcode like \'"
801 . C4::Context->userenv->{branch} . "\'"
802 if ( C4::Context->preference("IndependantBranches")
803 && C4::Context->userenv
804 && C4::Context->userenv->{flags} != 1 );
806 " HAVING quantity<>0 AND unitpricesupplier<>0 AND unitpricelib<>0 ORDER BY latesince,basketno,borrowers.branchcode, supplier ";
809 $strsth = "SELECT aqbasket.basketno,
810 DATE(aqbasket.closedate) as orderdate,
811 aqorders.quantity, aqorders.rrp as unitpricesupplier,aqorders.ecost as unitpricelib, aqorders.quantity * aqorders.rrp as subtotal
812 aqbookfund.bookfundname as budget, borrowers.branchcode as branch,
813 aqbooksellers.name as supplier,
814 biblio.title, biblio.author, biblioitems.publishercode as publisher, biblioitems.publicationyear,
815 (CURDATE - closedate) AS latesince
818 (aqorders LEFT JOIN biblio on biblio.biblionumber = aqorders.biblionumber) LEFT JOIN biblioitems on biblioitems.biblionumber=biblio.biblionumber
819 ) LEFT JOIN aqorderbreakdown on aqorders.ordernumber = aqorderbreakdown.ordernumber
820 ) LEFT JOIN aqbookfund on aqorderbreakdown.bookfundid = aqbookfund.bookfundid
821 ),(aqbasket LEFT JOIN borrowers on aqbasket.authorisedby = borrowers.borrowernumber) LEFT JOIN aqbooksellers ON aqbasket.booksellerid = aqbooksellers.id
822 WHERE aqorders.basketno = aqbasket.basketno AND (closedate < (CURDATE -(INTERVAL $delay DAY))
823 AND ((datereceived = '' OR datereceived is null) OR (aqorders.quantityreceived < aqorders.quantity) ) ";
824 $strsth .= " AND aqbasket.booksellerid = $supplierid " if ($supplierid);
825 $strsth .= " AND borrowers.branchcode like \'" . $branch . "\'"
828 " AND borrowers.branchcode like \'"
829 . C4::Context->userenv->{branch} . "\'"
830 if ( C4::Context->preference("IndependantBranches")
831 && C4::Context->userenv->{flags} != 1 );
833 " ORDER BY latesince,basketno,borrowers.branchcode, supplier";
835 warn "C4::Acquisition : getlateorders SQL:" . $strsth;
836 my $sth = $dbh->prepare($strsth);
840 while ( my $data = $sth->fetchrow_hashref ) {
841 $data->{hilighted} = $hilighted if ( $hilighted > 0 );
842 $data->{orderdate} = format_date( $data->{orderdate} );
843 push @results, $data;
844 $hilighted = -$hilighted;
847 return ( scalar(@results), @results );
853 #gets all orders from a certain supplier, orders them alphabetically
855 my $dbh = C4::Context->dbh;
857 my $sth = $dbh->prepare(
858 "Select * from aqorders,biblio,biblioitems where booksellerid=?
859 and (cancelledby is NULL or cancelledby = '')
860 and biblio.biblionumber=aqorders.biblionumber and biblioitems.biblioitemnumber=
861 aqorders.biblioitemnumber and
862 aqorders.quantityreceived>0
863 and aqorders.datereceived >=now()
864 group by aqorders.biblioitemnumber
868 $sth->execute($supid);
869 while ( my $data = $sth->fetchrow_hashref ) {
870 push( @results, $data );
873 return ( scalar(@results), @results );
878 ($count, @results) = &ordersearch($search, $biblionumber, $complete);
882 C<$search> may take one of several forms: if it is an ISBN,
883 C<&ordersearch> returns orders with that ISBN. If C<$search> is an
884 order number, C<&ordersearch> returns orders with that order number
885 and biblionumber C<$biblionumber>. Otherwise, C<$search> is considered
886 to be a space-separated list of search terms; in this case, all of the
887 terms must appear in the title (matching the beginning of title
890 If C<$complete> is C<yes>, the results will include only completed
891 orders. In any case, C<&ordersearch> ignores cancelled orders.
893 C<&ordersearch> returns an array. C<$count> is the number of elements
894 in C<@results>. C<@results> is an array of references-to-hash with the
913 my ( $search, $id, $biblio, $catview ) = @_;
914 my $dbh = C4::Context->dbh;
915 my @data = split( ' ', $search );
918 @searchterms = ($id);
920 map { push( @searchterms, "$_%", "% $_%" ) } @data;
921 push( @searchterms, $search, $search, $biblio );
925 "SELECT *,biblio.title FROM aqorders,biblioitems,biblio,aqbasket
926 WHERE aqorders.biblioitemnumber = biblioitems.biblioitemnumber AND
927 aqorders.basketno = aqbasket.basketno
928 AND aqbasket.booksellerid = ?
929 AND biblio.biblionumber=aqorders.biblionumber
930 AND ((datecancellationprinted is NULL)
931 OR (datecancellationprinted = '0000-00-00'))
935 map { "(biblio.title like ? or biblio.title like ?)" } @data )
937 . ") OR biblioitems.isbn=? OR (aqorders.ordernumber=? AND aqorders.biblionumber=?)) ";
942 "SELECT *,biblio.title FROM aqorders,biblioitems,biblio,aqbasket
943 WHERE aqorders.biblioitemnumber = biblioitems.biblioitemnumber AND
944 aqorders.basketno = aqbasket.basketno
945 AND biblio.biblionumber=aqorders.biblionumber
946 AND ((datecancellationprinted is NULL)
947 OR (datecancellationprinted = '0000-00-00'))
948 AND (aqorders.quantityreceived < aqorders.quantity OR aqorders.quantityreceived is NULL)
952 map { "(biblio.title like ? OR biblio.title like ?)" } @data )
954 . ") or biblioitems.isbn=? OR (aqorders.ordernumber=? AND aqorders.biblionumber=?)) ";
956 $query .= " GROUP BY aqorders.ordernumber";
957 my $sth = $dbh->prepare($query);
958 $sth->execute(@searchterms);
960 my $sth2 = $dbh->prepare("SELECT * FROM biblio WHERE biblionumber=?");
962 $dbh->prepare("SELECT * FROM aqorderbreakdown WHERE ordernumber=?");
963 while ( my $data = $sth->fetchrow_hashref ) {
964 $sth2->execute( $data->{'biblionumber'} );
965 my $data2 = $sth2->fetchrow_hashref;
966 $data->{'author'} = $data2->{'author'};
967 $data->{'seriestitle'} = $data2->{'seriestitle'};
968 $sth3->execute( $data->{'ordernumber'} );
969 my $data3 = $sth3->fetchrow_hashref;
970 $data->{'branchcode'} = $data3->{'branchcode'};
971 $data->{'bookfundid'} = $data3->{'bookfundid'};
972 push( @results, $data );
977 return ( scalar(@results), @results );
981 my ( $title, $author, $name, $from_placed_on, $to_placed_on ) = @_;
984 my $total_qtyreceived = 0;
987 # don't run the query if there are no parameters (list would be too long for sure !
988 if ( $title || $author || $name || $from_placed_on || $to_placed_on ) {
989 my $dbh = C4::Context->dbh;
991 "select biblio.title,biblio.author,aqorders.basketno,name,aqbasket.creationdate,aqorders.datereceived, aqorders.quantity, aqorders.quantityreceived, aqorders.ecost from aqorders,aqbasket,aqbooksellers,biblio";
992 $query .= ",borrowers "
993 if ( C4::Context->preference("IndependantBranches") );
995 " where aqorders.basketno=aqbasket.basketno and aqbasket.booksellerid=aqbooksellers.id and biblio.biblionumber=aqorders.biblionumber ";
996 $query .= " and aqbasket.authorisedby=borrowers.borrowernumber"
997 if ( C4::Context->preference("IndependantBranches") );
998 $query .= " and biblio.title like " . $dbh->quote( "%" . $title . "%" )
1001 " and biblio.author like " . $dbh->quote( "%" . $author . "%" )
1003 $query .= " and name like " . $dbh->quote( "%" . $name . "%" ) if $name;
1004 $query .= " and creationdate >" . $dbh->quote($from_placed_on)
1006 $query .= " and creationdate<" . $dbh->quote($to_placed_on)
1009 if ( C4::Context->preference("IndependantBranches") ) {
1010 my $userenv = C4::Context->userenv;
1011 if ( ($userenv) && ( $userenv->{flags} != 1 ) ) {
1013 " and (borrowers.branchcode = '"
1014 . $userenv->{branch}
1015 . "' or borrowers.branchcode ='')";
1018 $query .= " order by booksellerid";
1019 warn "query histearch: " . $query;
1020 my $sth = $dbh->prepare($query);
1023 while ( my $line = $sth->fetchrow_hashref ) {
1024 $line->{count} = $cnt++;
1025 $line->{toggle} = 1 if $cnt % 2;
1026 push @order_loop, $line;
1027 $line->{creationdate} = format_date( $line->{creationdate} );
1028 $line->{datereceived} = format_date( $line->{datereceived} );
1029 $total_qty += $line->{'quantity'};
1030 $total_qtyreceived += $line->{'quantityreceived'};
1031 $total_price += $line->{'quantity'} * $line->{'ecost'};
1034 return \@order_loop, $total_qty, $total_price, $total_qtyreceived;
1045 ($count, @results) = &invoice($booksellerinvoicenumber);
1047 Looks up orders by invoice number.
1049 Returns an array. C<$count> is the number of elements in C<@results>.
1050 C<@results> is an array of references-to-hash; the keys of each
1051 elements are fields from the aqorders, biblio, and biblioitems tables
1052 of the Koha database.
1059 my $dbh = C4::Context->dbh;
1061 my $sth = $dbh->prepare(
1062 "Select * from aqorders,biblio,biblioitems where
1063 booksellerinvoicenumber=?
1064 and biblio.biblionumber=aqorders.biblionumber and biblioitems.biblioitemnumber=
1065 aqorders.biblioitemnumber group by aqorders.ordernumber,aqorders.biblioitemnumber"
1067 $sth->execute($invoice);
1068 while ( my $data = $sth->fetchrow_hashref ) {
1069 push( @results, $data );
1072 return ( scalar(@results), @results );
1077 ($count, @results) = &bookfunds();
1079 Returns a list of all book funds.
1081 C<$count> is the number of elements in C<@results>. C<@results> is an
1082 array of references-to-hash, whose keys are fields from the aqbookfund
1083 and aqbudget tables of the Koha database. Results are ordered
1084 alphabetically by book fund name.
1091 my $dbh = C4::Context->dbh;
1092 my $userenv = C4::Context->userenv;
1093 my $branch = $userenv->{branch};
1096 if ( $branch ne '' ) {
1097 $strsth = "SELECT * FROM aqbookfund,aqbudget WHERE aqbookfund.bookfundid
1098 =aqbudget.bookfundid AND startdate<now() AND enddate>now() AND (aqbookfund.branchcode is null or aqbookfund.branchcode='' or aqbookfund.branchcode= ? )
1099 GROUP BY aqbookfund.bookfundid ORDER BY bookfundname";
1102 $strsth = "SELECT * FROM aqbookfund,aqbudget WHERE aqbookfund.bookfundid
1103 =aqbudget.bookfundid AND startdate<now() AND enddate>now()
1104 GROUP BY aqbookfund.bookfundid ORDER BY bookfundname";
1106 my $sth = $dbh->prepare($strsth);
1107 if ( $branch ne '' ) {
1108 $sth->execute($branch);
1114 while ( my $data = $sth->fetchrow_hashref ) {
1115 push( @results, $data );
1118 return ( scalar(@results), @results );
1121 =item bookfundbreakdown
1123 returns the total comtd & spent for a given bookfund, and a given year
1124 used in acqui-home.pl
1129 sub bookfundbreakdown {
1130 my ( $id, $year ,$start, $end) = @_;
1131 my $dbh = C4::Context->dbh;
1132 my $sth = $dbh->prepare(
1133 "SELECT quantity,datereceived,freight,unitprice,listprice,ecost,
1134 quantityreceived,subscription
1135 FROM aqorders,aqorderbreakdown WHERE bookfundid=? AND
1136 aqorders.ordernumber=aqorderbreakdown.ordernumber
1137 AND (datecancellationprinted is NULL OR
1138 datecancellationprinted='0000-00-00')"
1141 $sth = $dbh->prepare(
1142 "SELECT quantity,datereceived,freight,unitprice,listprice,ecost,
1143 quantityreceived,subscription
1144 FROM aqorders,aqorderbreakdown
1145 WHERE bookfundid=? AND
1146 aqorders.ordernumber=aqorderbreakdown.ordernumber
1147 AND (datecancellationprinted is NULL OR
1148 datecancellationprinted='0000-00-00')
1149 AND ((datereceived >= ? AND datereceived < ?) OR
1150 (budgetdate >= ? AND budgetdate < ?))"
1152 $sth->execute( $id, $start, $end, $start, $end );
1160 while ( my $data = $sth->fetchrow_hashref ) {
1162 if ( $data->{'subscription'} == 1 ) {
1163 $spent += $data->{'quantity'} * $data->{'unitprice'};
1166 my $leftover = $data->{'quantity'} - $data->{'quantityreceived'};
1167 $comtd += ( $data->{'ecost'} ) * $leftover;
1168 $spent += ( $data->{'unitprice'} ) * $data->{'quantityreceived'};
1172 return ( $spent, $comtd );
1177 $foreignprice = &curconvert($currency, $localprice);
1179 Converts the price C<$localprice> to foreign currency C<$currency> by
1180 dividing by the exchange rate, and returns the result.
1182 If no exchange rate is found, C<&curconvert> assumes the rate is one
1189 my ( $currency, $price ) = @_;
1190 my $dbh = C4::Context->dbh;
1191 my $sth = $dbh->prepare("Select rate from currency where currency=?");
1192 $sth->execute($currency);
1193 my $cur = ( $sth->fetchrow_array() )[0];
1198 return ( $price / $cur );
1203 ($count, $currencies) = &getcurrencies();
1205 Returns the list of all known currencies.
1207 C<$count> is the number of elements in C<$currencies>. C<$currencies>
1208 is a reference-to-array; its elements are references-to-hash, whose
1209 keys are the fields from the currency table in the Koha database.
1215 my $dbh = C4::Context->dbh;
1216 my $sth = $dbh->prepare("Select * from currency");
1219 while ( my $data = $sth->fetchrow_hashref ) {
1220 push( @results, $data );
1223 return ( scalar(@results), \@results );
1226 =item updatecurrencies
1228 &updatecurrencies($currency, $newrate);
1230 Sets the exchange rate for C<$currency> to be C<$newrate>.
1235 sub updatecurrencies {
1236 my ( $currency, $rate ) = @_;
1237 my $dbh = C4::Context->dbh;
1238 my $sth = $dbh->prepare("update currency set rate=? where currency=?");
1239 $sth->execute( $rate, $currency );
1251 ($count, @results) = &bookseller($searchstring);
1253 Looks up a book seller. C<$searchstring> may be either a book seller
1254 ID, or a string to look for in the book seller's name.
1256 C<$count> is the number of elements in C<@results>. C<@results> is an
1257 array of references-to-hash, whose keys are the fields of of the
1258 aqbooksellers table in the Koha database.
1264 my ($searchstring) = @_;
1265 my $dbh = C4::Context->dbh;
1267 $dbh->prepare("Select * from aqbooksellers where name like ? or id = ?");
1268 $sth->execute( "$searchstring%", $searchstring );
1270 while ( my $data = $sth->fetchrow_hashref ) {
1271 push( @results, $data );
1274 return ( scalar(@results), @results );
1279 ($count, $results) = &breakdown($ordernumber);
1281 Looks up an order by order ID, and returns its breakdown.
1283 C<$count> is the number of elements in C<$results>. C<$results> is a
1284 reference-to-array; its elements are references-to-hash, whose keys
1285 are the fields of the aqorderbreakdown table in the Koha database.
1292 my $dbh = C4::Context->dbh;
1294 $dbh->prepare("Select * from aqorderbreakdown where ordernumber=?");
1297 while ( my $data = $sth->fetchrow_hashref ) {
1298 push( @results, $data );
1301 return ( scalar(@results), \@results );
1306 ($count, @results) = &branches();
1308 Returns a list of all library branches.
1310 C<$count> is the number of elements in C<@results>. C<@results> is an
1311 array of references-to-hash, whose keys are the fields of the branches
1312 table of the Koha database.
1318 my $dbh = C4::Context->dbh;
1320 if ( C4::Context->preference("IndependantBranches")
1321 && ( C4::Context->userenv )
1322 && ( C4::Context->userenv->{flags} != 1 ) )
1324 my $strsth = "Select * from branches ";
1326 " WHERE branchcode = "
1327 . $dbh->quote( C4::Context->userenv->{branch} );
1328 $strsth .= " order by branchname";
1329 warn "C4::Acquisition->branches : " . $strsth;
1330 $sth = $dbh->prepare($strsth);
1333 $sth = $dbh->prepare("Select * from branches order by branchname");
1338 while ( my $data = $sth->fetchrow_hashref ) {
1339 push( @results, $data );
1343 return ( scalar(@results), @results );
1348 &updatesup($bookseller);
1350 Updates the information for a given bookseller. C<$bookseller> is a
1351 reference-to-hash whose keys are the fields of the aqbooksellers table
1352 in the Koha database. It must contain entries for all of the fields.
1353 The entry to modify is determined by C<$bookseller-E<gt>{id}>.
1355 The easiest way to get all of the necessary fields is to look up a
1356 book seller with C<&booksellers>, modify what's necessary, then call
1357 C<&updatesup> with the result.
1364 my $dbh = C4::Context->dbh;
1365 my $sth = $dbh->prepare(
1366 "Update aqbooksellers set
1367 name=?,address1=?,address2=?,address3=?,address4=?,postal=?,
1368 phone=?,fax=?,url=?,contact=?,contpos=?,contphone=?,contfax=?,contaltphone=?,
1369 contemail=?,contnotes=?,active=?,
1370 listprice=?, invoiceprice=?,gstreg=?, listincgst=?,
1371 invoiceincgst=?, specialty=?,discount=?,invoicedisc=?,
1374 $sth->execute($data->{'name'},$data->{'address1'},$data->{'address2'},
1375 $data->{'address3'},$data->{'address4'},$data->{'postal'},$data->{'phone'},
1376 $data->{'fax'},$data->{'url'},$data->{'contact'},$data->{'contpos'},
1377 $data->{'contphone'},$data->{'contfax'},$data->{'contaltphone'},
1378 $data->{'contemail'},
1379 $data->{'contnotes'},$data->{'active'},$data->{'listprice'},
1380 $data->{'invoiceprice'},$data->{'gstreg'},$data->{'listincgst'},
1381 $data->{'invoiceincgst'},$data->{'specialty'},$data->{'discount'},
1382 $data->{'invoicedisc'},$data->{'nocalc'},$data->{'notes'},$data->{'id'});
1388 $id = &insertsup($bookseller);
1390 Creates a new bookseller. C<$bookseller> is a reference-to-hash whose
1391 keys are the fields of the aqbooksellers table in the Koha database.
1392 All fields must be present.
1394 Returns the ID of the newly-created bookseller.
1401 my $dbh = C4::Context->dbh;
1402 my $sth = $dbh->prepare("Select max(id) from aqbooksellers");
1404 my $data2 = $sth->fetchrow_hashref;
1406 $data2->{'max(id)'}++;
1407 $sth = $dbh->prepare("Insert into aqbooksellers (id) values (?)");
1408 $sth->execute( $data2->{'max(id)'} );
1410 $data->{'id'} = $data2->{'max(id)'};
1412 return ( $data->{'id'} );
1417 ($count, $results) = &getparcels($dbh, $bookseller, $order, $limit);
1419 get a lists of parcels
1420 Returns the count of parcels returned and a pointer on a hash list containing parcel informations as such :
1431 my ( $bookseller, $order, $code, $datefrom, $dateto, $limit ) = @_;
1432 my $dbh = C4::Context->dbh;
1434 "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 ";
1435 $strsth .= "and aqorders.booksellerinvoicenumber like \"$code%\" "
1437 $strsth .= "and datereceived >=" . $dbh->quote($datefrom) . " "
1439 $strsth .= "and datereceived <=" . $dbh->quote($dateto) . " " if ($dateto);
1440 $strsth .= "group by aqorders.booksellerinvoicenumber,datereceived ";
1441 $strsth .= "order by $order " if ($order);
1442 $strsth .= " LIMIT 0,$limit" if ($limit);
1443 my $sth = $dbh->prepare($strsth);
1444 ### getparcels: $strsth
1448 while ( my $data2 = $sth->fetchrow_hashref ) {
1449 push @results, $data2;
1453 return ( scalar(@results), @results );
1458 ($count, $results) = &getparcels($dbh, $bookseller, $order, $limit);
1460 get a lists of parcels
1461 Returns the count of parcels returned and a pointer on a hash list containing parcel informations as such :
1471 my ($bookseller, $order, $code,$datefrom,$dateto, $limit)=@_;
1472 my $dbh = C4::Context->dbh;
1473 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 ";
1474 $strsth .= "and aqorders.booksellerinvoicenumber like \"$code%\" " if ($code);
1475 $strsth .= "and datereceived >=".$dbh->quote($datefrom)." " if ($datefrom);
1476 $strsth .= "and datereceived <=".$dbh->quote($dateto)." " if ($dateto);
1477 $strsth .= "group by aqorders.booksellerinvoicenumber,datereceived ";
1478 $strsth .= "order by $order " if ($order);
1479 $strsth .= " LIMIT 0,$limit" if ($limit);
1480 my $sth=$dbh->prepare($strsth);
1481 ### getparcels: $strsth
1484 while (my $data2=$sth->fetchrow_hashref) {
1485 push @results, $data2;
1489 return(scalar(@results), @results);
1492 END { } # module clean-up code here (global destructor)
1501 Koha Developement team <info@koha.org>