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
223 if ( !$budget || $budget eq 'now' ) {
224 $sth = $dbh->prepare(
225 "INSERT INTO aqorders
226 (biblionumber,title,basketno,quantity,listprice,notes,
227 biblioitemnumber,rrp,ecost,gst,unitprice,subscription,sort1,sort2,budgetdate,entrydate)
228 VALUES ( ?,?,?,?,?,?,?,?,?,?,?,?,?,?,now(),now() )"
231 $bibnum, $title, $basketno, $quantity, $listprice,
232 $notes, $bibitemnum, $rrp, $ecost, $gst,
233 $cost, $sub, $sort1, $sort2
238 ##FIXME HARDCODED DATE.
239 $budget = "'2006-07-01'";
240 $sth = $dbh->prepare(
241 "INSERT INTO aqorders
242 (biblionumber,title,basketno,quantity,listprice,notes,
243 biblioitemnumber,rrp,ecost,gst,unitprice,subscription,sort1,sort2,budgetdate,entrydate)
244 VALUES ( ?,?,?,?,?,?,?,?,?,?,?,?,?,?,?,now() )"
247 $bibnum, $title, $basketno, $quantity, $listprice,
248 $notes, $bibitemnum, $rrp, $ecost, $gst,
249 $cost, $sub, $sort1, $sort2, $budget
255 #get ordnum MYSQL dependant, but $dbh->last_insert_id returns null
256 my $ordnum = $dbh->{'mysql_insertid'};
257 $sth = $dbh->prepare(
258 "INSERT INTO aqorderbreakdown (ordernumber,bookfundid) VALUES
261 $sth->execute( $ordnum, $bookfund );
268 &delorder($biblionumber, $ordernumber);
270 Cancel the order with the given order and biblio numbers. It does not
271 delete any entries in the aqorders table, it merely marks them as
278 my ( $bibnum, $ordnum ) = @_;
279 my $dbh = C4::Context->dbh;
280 my $sth = $dbh->prepare(
281 "update aqorders set datecancellationprinted=now()
282 where biblionumber=? and ordernumber=?"
284 $sth->execute( $bibnum, $ordnum );
290 &modorder($title, $ordernumber, $quantity, $listprice,
291 $biblionumber, $basketno, $supplier, $who, $notes,
292 $bookfundid, $bibitemnum, $rrp, $ecost, $gst, $budget,
293 $unitprice, $booksellerinvoicenumber);
295 Modifies an existing order. Updates the order with order number
296 C<$ordernumber> and biblionumber C<$biblionumber>. All other arguments
297 update the fields with the same name in the aqorders table of the Koha
300 Entries with order number C<$ordernumber> in the aqorderbreakdown
301 table are also updated to the new book fund ID.
308 $title, $ordnum, $quantity, $listprice, $bibnum,
309 $basketno, $supplier, $who, $notes, $bookfund,
310 $bibitemnum, $rrp, $ecost, $gst, $budget,
311 $cost, $invoice, $sort1, $sort2
314 my $dbh = C4::Context->dbh;
315 my $sth = $dbh->prepare(
316 "update aqorders set title=?,
317 quantity=?,listprice=?,basketno=?,
318 rrp=?,ecost=?,unitprice=?,booksellerinvoicenumber=?,
319 notes=?,sort1=?, sort2=?
321 ordernumber=? and biblionumber=?"
324 $title, $quantity, $listprice, $basketno, $rrp,
325 $ecost, $cost, $invoice, $notes, $sort1,
326 $sort2, $ordnum, $bibnum
329 $sth = $dbh->prepare(
330 "update aqorderbreakdown set bookfundid=? where
334 unless ( $sth->execute( $bookfund, $ordnum ) )
335 { # zero rows affected [Bug 734]
337 "insert into aqorderbreakdown (ordernumber,bookfundid) values (?,?)";
338 $sth = $dbh->prepare($query);
339 $sth->execute( $ordnum, $bookfund );
346 $order = &newordernum();
348 Finds the next unused order number in the aqorders table of the Koha
349 database, and returns it.
354 # FIXME - Race condition
356 my $dbh = C4::Context->dbh;
357 my $sth = $dbh->prepare("Select max(ordernumber) from aqorders");
359 my $data = $sth->fetchrow_arrayref;
360 my $ordnum = $$data[0];
368 &receiveorder($biblionumber, $ordernumber, $quantityreceived, $user,
369 $unitprice, $booksellerinvoicenumber, $biblioitemnumber,
370 $freight, $bookfund, $rrp);
372 Updates an order, to reflect the fact that it was received, at least
373 in part. All arguments not mentioned below update the fields with the
374 same name in the aqorders table of the Koha database.
376 Updates the order with bibilionumber C<$biblionumber> and ordernumber
379 Also updates the book fund ID in the aqorderbreakdown table.
385 my ( $biblio, $ordnum, $quantrec, $user, $cost, $invoiceno, $freight, $rrp $bookfund)
387 my $dbh = C4::Context->dbh;
388 my $sth = $dbh->prepare(
389 "update aqorders set quantityreceived=?,datereceived=now(),booksellerinvoicenumber=?,
390 unitprice=?,freight=?,rrp=?
391 where biblionumber=? and ordernumber=?"
393 my $suggestionid = findsuggestion_from_biblionumber( $dbh, $biblio );
395 changestatus( $suggestionid, 'AVAILABLE', '', $biblio );
397 $sth->execute( $quantrec, $invoiceno, $cost, $freight, $rrp, $biblio,
401 # Allows libraries to change their bookfund during receiving orders
402 # allows them to adjust budgets
403 if ( C4::Context->preferene("LooseBudgets") ) {
404 my $sth = $dbh->prepare(
405 "UPDATE aqorderbreakdown SET bookfundid=?
408 $sth->execute( $bookfund, $ordnum );
415 &updaterecorder($biblionumber, $ordernumber, $user, $unitprice,
418 Updates the order with biblionumber C<$biblionumber> and order number
419 C<$ordernumber>. C<$bookfundid> is the new value for the book fund ID
420 in the aqorderbreakdown table of the Koha database. All other
421 arguments update the fields with the same name in the aqorders table.
429 my ( $biblio, $ordnum, $user, $cost, $bookfund, $rrp ) = @_;
430 my $dbh = C4::Context->dbh;
431 my $sth = $dbh->prepare(
434 where biblionumber=? and ordernumber=?
437 $sth->execute( $cost, $rrp, $biblio, $ordnum );
441 "update aqorderbreakdown set bookfundid=? where ordernumber=?");
442 $sth->execute( $bookfund, $ordnum );
454 ($count, $orders) = &getorders($booksellerid);
456 Finds pending orders from the bookseller with the given ID. Ignores
457 completed and cancelled orders.
459 C<$count> is the number of elements in C<@{$orders}>.
461 C<$orders> is a reference-to-array; each element is a
462 reference-to-hash with the following fields:
468 Gives the number of orders in with this basket number.
470 =item C<authorizedby>
476 These give the value of the corresponding field in the aqorders table
477 of the Koha database.
481 Results are ordered from most to least recent.
487 my ($supplierid) = @_;
488 my $dbh = C4::Context->dbh;
489 my $strsth = "Select count(*),authorisedby,creationdate,aqbasket.basketno,
490 closedate,surname,firstname,aqorders.title
492 left join aqbasket on aqbasket.basketno=aqorders.basketno
493 left join borrowers on aqbasket.authorisedby=borrowers.borrowernumber
494 where booksellerid=? and (quantity > quantityreceived or
495 quantityreceived is NULL) and datecancellationprinted is NULL and (to_days(now())-to_days(closedate) < 180 or closedate is null)";
496 if ( C4::Context->preference("IndependantBranches") ) {
497 my $userenv = C4::Context->userenv;
498 if ( ($userenv) && ( $userenv->{flags} != 1 ) ) {
500 " and (borrowers.branchcode = '"
502 . "' or borrowers.branchcode ='')";
505 $strsth .= " group by basketno order by aqbasket.basketno";
506 my $sth = $dbh->prepare($strsth);
507 $sth->execute($supplierid);
509 while ( my $data = $sth->fetchrow_hashref ) {
510 push( @results, $data );
513 return ( scalar(@results), \@results );
518 ($order, $ordernumber) = &getorder($biblioitemnumber, $biblionumber);
520 Looks up the order with the given biblionumber and biblioitemnumber.
522 Returns a two-element array. C<$ordernumber> is the order number.
523 C<$order> is a reference-to-hash describing the order; its keys are
524 fields from the biblio, biblioitems, aqorders, and aqorderbreakdown
525 tables of the Koha database.
530 my ( $bi, $bib ) = @_;
531 my $dbh = C4::Context->dbh;
534 "Select ordernumber from aqorders where biblionumber=? and biblioitemnumber=?"
536 $sth->execute( $bib, $bi );
538 # FIXME - Use fetchrow_array(), since we're only interested in the one
540 my $ordnum = $sth->fetchrow_hashref;
542 my $order = getsingleorder( $ordnum->{'ordernumber'} );
543 return ( $order, $ordnum->{'ordernumber'} );
548 $order = &getsingleorder($ordernumber);
550 Looks up an order by order number.
552 Returns a reference-to-hash describing the order. The keys of
553 C<$order> are fields from the biblio, biblioitems, aqorders, and
554 aqorderbreakdown tables of the Koha database.
560 my $dbh = C4::Context->dbh;
561 my $sth = $dbh->prepare(
562 "Select * from biblio,biblioitems,aqorders left join aqorderbreakdown
563 on aqorders.ordernumber=aqorderbreakdown.ordernumber
564 where aqorders.ordernumber=?
565 and biblio.biblionumber=aqorders.biblionumber and
566 biblioitems.biblioitemnumber=aqorders.biblioitemnumber"
568 $sth->execute($ordnum);
569 my $data = $sth->fetchrow_hashref;
576 ($count, @results) = &getallorders($booksellerid);
578 Looks up all of the pending orders from the supplier with the given
579 bookseller ID. Ignores cancelled and completed orders.
581 C<$count> is the number of elements in C<@results>. C<@results> is an
582 array of references-to-hash. The keys of each element are fields from
583 the aqorders, biblio, and biblioitems tables of the Koha database.
585 C<@results> is sorted alphabetically by book title.
592 #gets all orders from a certain supplier, orders them alphabetically
593 my ($supplierid) = @_;
594 my $dbh = C4::Context->dbh;
596 my $strsth = "Select count(*),authorisedby,creationdate,aqbasket.basketno,
597 closedate,surname,firstname,aqorders.biblionumber,aqorders.title, aqorders.ordernumber
599 left join aqbasket on aqbasket.basketno=aqorders.basketno
600 left join borrowers on aqbasket.authorisedby=borrowers.borrowernumber
601 where booksellerid=? and (quantity > quantityreceived or
602 quantityreceived is NULL) and datecancellationprinted is NULL ";
604 if ( C4::Context->preference("IndependantBranches") ) {
605 my $userenv = C4::Context->userenv;
606 if ( ($userenv) && ( $userenv->{flags} != 1 ) ) {
608 " and (borrowers.branchcode = '"
610 . "' or borrowers.branchcode ='')";
613 $strsth .= " group by basketno order by aqbasket.basketno";
614 my $sth = $dbh->prepare($strsth);
615 $sth->execute($supplierid);
616 while ( my $data = $sth->fetchrow_hashref ) {
617 push( @results, $data );
620 return ( scalar(@results), @results );
623 =item getparcelinformation
625 ($count, @results) = &getparcelinformation($booksellerid, $code, $date);
627 Looks up all of the received items from the supplier with the given
628 bookseller ID at the given date, for the given code. Ignores cancelled and completed orders.
630 C<$count> is the number of elements in C<@results>. C<@results> is an
631 array of references-to-hash. The keys of each element are fields from
632 the aqorders, biblio, and biblioitems tables of the Koha database.
634 C<@results> is sorted alphabetically by book title.
639 sub getparcelinformation {
641 #gets all orders from a certain supplier, orders them alphabetically
642 my ( $supplierid, $code, $datereceived ) = @_;
643 my $dbh = C4::Context->dbh;
646 if $code; # add % if we search on a given code (otherwise, let him empty)
648 "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\'";
650 if ( C4::Context->preference("IndependantBranches") ) {
651 my $userenv = C4::Context->userenv;
652 if ( ($userenv) && ( $userenv->{flags} != 1 ) ) {
654 " and (borrowers.branchcode = '"
656 . "' or borrowers.branchcode ='')";
659 $strsth .= " order by aqbasket.basketno";
660 ### parcelinformation : $strsth
661 my $sth = $dbh->prepare($strsth);
662 $sth->execute($supplierid);
663 while ( my $data = $sth->fetchrow_hashref ) {
664 push( @results, $data );
666 my $count = scalar(@results);
667 ### countparcelbiblio: $count
670 return ( scalar(@results), @results );
673 =item getsupplierlistwithlateorders
675 %results = &getsupplierlistwithlateorders;
677 Searches for suppliers with late orders.
682 sub getsupplierlistwithlateorders {
684 my $dbh = C4::Context->dbh;
686 #FIXME NOT quite sure that this operation is valid for DBMs different from Mysql, HOPING so
687 #should be tested with other DBMs
690 my $dbdriver = C4::Context->config("db_scheme") || "mysql";
691 if ( $dbdriver eq "mysql" ) {
692 $strsth = "SELECT DISTINCT aqbasket.booksellerid, aqbooksellers.name
693 FROM aqorders, aqbasket
694 LEFT JOIN aqbooksellers ON aqbasket.booksellerid = aqbooksellers.id
695 WHERE aqorders.basketno = aqbasket.basketno AND
696 (closedate < DATE_SUB(CURDATE( ),INTERVAL $delay DAY) AND (datereceived = '' or datereceived is null))
700 $strsth = "SELECT DISTINCT aqbasket.booksellerid, aqbooksellers.name
701 FROM aqorders, aqbasket
702 LEFT JOIN aqbooksellers ON aqbasket.aqbooksellerid = aqbooksellers.id
703 WHERE aqorders.basketno = aqbasket.basketno AND
704 (closedate < (CURDATE( )-(INTERVAL $delay DAY))) AND (datereceived = '' or datereceived is null))
708 # warn "C4::Acquisition getsupplierlistwithlateorders : ".$strsth;
709 my $sth = $dbh->prepare($strsth);
712 while ( my ( $id, $name ) = $sth->fetchrow ) {
713 $supplierlist{$id} = $name;
715 return %supplierlist;
720 %results = &getlateorders;
722 Searches for suppliers with late orders.
729 my $supplierid = shift;
732 my $dbh = C4::Context->dbh;
734 #BEWARE, order of parenthesis and LEFT JOIN is important for speed
736 my $dbdriver = C4::Context->config("db_scheme") || "mysql";
739 if ( $dbdriver eq "mysql" ) {
740 $strsth = "SELECT aqbasket.basketno,
741 DATE(aqbasket.closedate) as orderdate, aqorders.quantity - IFNULL(aqorders.quantityreceived,0) as quantity, aqorders.rrp as unitpricesupplier,aqorders.ecost as unitpricelib,
742 (aqorders.quantity - IFNULL(aqorders.quantityreceived,0)) * aqorders.rrp as subtotal, aqbookfund.bookfundname as budget, borrowers.branchcode as branch,
743 aqbooksellers.name as supplier,
744 aqorders.title, biblio.author, biblioitems.publishercode as publisher, biblioitems.publicationyear,
745 DATEDIFF(CURDATE( ),closedate) AS latesince
748 (aqorders LEFT JOIN biblio on biblio.biblionumber = aqorders.biblionumber) LEFT JOIN biblioitems on biblioitems.biblionumber=biblio.biblionumber
749 ) LEFT JOIN aqorderbreakdown on aqorders.ordernumber = aqorderbreakdown.ordernumber
750 ) LEFT JOIN aqbookfund on aqorderbreakdown.bookfundid = aqbookfund.bookfundid
751 ),(aqbasket LEFT JOIN borrowers on aqbasket.authorisedby = borrowers.borrowernumber) LEFT JOIN aqbooksellers ON aqbasket.booksellerid = aqbooksellers.id
752 WHERE aqorders.basketno = aqbasket.basketno AND (closedate < DATE_SUB(CURDATE( ),INTERVAL $delay DAY))
753 AND ((datereceived = '' OR datereceived is null) OR (aqorders.quantityreceived < aqorders.quantity) ) ";
754 $strsth .= " AND aqbasket.booksellerid = $supplierid " if ($supplierid);
755 $strsth .= " AND borrowers.branchcode like \'" . $branch . "\'"
758 " AND borrowers.branchcode like \'"
759 . C4::Context->userenv->{branch} . "\'"
760 if ( C4::Context->preference("IndependantBranches")
761 && C4::Context->userenv
762 && C4::Context->userenv->{flags} != 1 );
764 " HAVING quantity<>0 AND unitpricesupplier<>0 AND unitpricelib<>0 ORDER BY latesince,basketno,borrowers.branchcode, supplier ";
767 $strsth = "SELECT aqbasket.basketno,
768 DATE(aqbasket.closedate) as orderdate,
769 aqorders.quantity, aqorders.rrp as unitpricesupplier,aqorders.ecost as unitpricelib, aqorders.quantity * aqorders.rrp as subtotal
770 aqbookfund.bookfundname as budget, borrowers.branchcode as branch,
771 aqbooksellers.name as supplier,
772 biblio.title, biblio.author, biblioitems.publishercode as publisher, biblioitems.publicationyear,
773 (CURDATE - closedate) AS latesince
776 (aqorders LEFT JOIN biblio on biblio.biblionumber = aqorders.biblionumber) LEFT JOIN biblioitems on biblioitems.biblionumber=biblio.biblionumber
777 ) LEFT JOIN aqorderbreakdown on aqorders.ordernumber = aqorderbreakdown.ordernumber
778 ) LEFT JOIN aqbookfund on aqorderbreakdown.bookfundid = aqbookfund.bookfundid
779 ),(aqbasket LEFT JOIN borrowers on aqbasket.authorisedby = borrowers.borrowernumber) LEFT JOIN aqbooksellers ON aqbasket.booksellerid = aqbooksellers.id
780 WHERE aqorders.basketno = aqbasket.basketno AND (closedate < (CURDATE -(INTERVAL $delay DAY))
781 AND ((datereceived = '' OR datereceived is null) OR (aqorders.quantityreceived < aqorders.quantity) ) ";
782 $strsth .= " AND aqbasket.booksellerid = $supplierid " if ($supplierid);
783 $strsth .= " AND borrowers.branchcode like \'" . $branch . "\'"
786 " AND borrowers.branchcode like \'"
787 . C4::Context->userenv->{branch} . "\'"
788 if ( C4::Context->preference("IndependantBranches")
789 && C4::Context->userenv->{flags} != 1 );
791 " ORDER BY latesince,basketno,borrowers.branchcode, supplier";
793 warn "C4::Acquisition : getlateorders SQL:" . $strsth;
794 my $sth = $dbh->prepare($strsth);
798 while ( my $data = $sth->fetchrow_hashref ) {
799 $data->{hilighted} = $hilighted if ( $hilighted > 0 );
800 $data->{orderdate} = format_date( $data->{orderdate} );
801 push @results, $data;
802 $hilighted = -$hilighted;
805 return ( scalar(@results), @results );
811 #gets all orders from a certain supplier, orders them alphabetically
813 my $dbh = C4::Context->dbh;
815 my $sth = $dbh->prepare(
816 "Select * from aqorders,biblio,biblioitems where booksellerid=?
817 and (cancelledby is NULL or cancelledby = '')
818 and biblio.biblionumber=aqorders.biblionumber and biblioitems.biblioitemnumber=
819 aqorders.biblioitemnumber and
820 aqorders.quantityreceived>0
821 and aqorders.datereceived >=now()
822 group by aqorders.biblioitemnumber
826 $sth->execute($supid);
827 while ( my $data = $sth->fetchrow_hashref ) {
828 push( @results, $data );
831 return ( scalar(@results), @results );
836 ($count, @results) = &ordersearch($search, $biblionumber, $complete);
840 C<$search> may take one of several forms: if it is an ISBN,
841 C<&ordersearch> returns orders with that ISBN. If C<$search> is an
842 order number, C<&ordersearch> returns orders with that order number
843 and biblionumber C<$biblionumber>. Otherwise, C<$search> is considered
844 to be a space-separated list of search terms; in this case, all of the
845 terms must appear in the title (matching the beginning of title
848 If C<$complete> is C<yes>, the results will include only completed
849 orders. In any case, C<&ordersearch> ignores cancelled orders.
851 C<&ordersearch> returns an array. C<$count> is the number of elements
852 in C<@results>. C<@results> is an array of references-to-hash with the
871 my ( $search, $id, $biblio, $catview ) = @_;
872 my $dbh = C4::Context->dbh;
873 my @data = split( ' ', $search );
876 @searchterms = ($id);
878 map { push( @searchterms, "$_%", "% $_%" ) } @data;
879 push( @searchterms, $search, $search, $biblio );
883 "SELECT *,biblio.title FROM aqorders,biblioitems,biblio,aqbasket
884 WHERE aqorders.biblioitemnumber = biblioitems.biblioitemnumber AND
885 aqorders.basketno = aqbasket.basketno
886 AND aqbasket.booksellerid = ?
887 AND biblio.biblionumber=aqorders.biblionumber
888 AND ((datecancellationprinted is NULL)
889 OR (datecancellationprinted = '0000-00-00'))
893 map { "(biblio.title like ? or biblio.title like ?)" } @data )
895 . ") OR biblioitems.isbn=? OR (aqorders.ordernumber=? AND aqorders.biblionumber=?)) ";
900 "SELECT *,biblio.title FROM aqorders,biblioitems,biblio,aqbasket
901 WHERE aqorders.biblioitemnumber = biblioitems.biblioitemnumber AND
902 aqorders.basketno = aqbasket.basketno
903 AND biblio.biblionumber=aqorders.biblionumber
904 AND ((datecancellationprinted is NULL)
905 OR (datecancellationprinted = '0000-00-00'))
906 AND (aqorders.quantityreceived < aqorders.quantity OR aqorders.quantityreceived is NULL)
910 map { "(biblio.title like ? OR biblio.title like ?)" } @data )
912 . ") or biblioitems.isbn=? OR (aqorders.ordernumber=? AND aqorders.biblionumber=?)) ";
914 $query .= " GROUP BY aqorders.ordernumber";
915 my $sth = $dbh->prepare($query);
916 $sth->execute(@searchterms);
918 my $sth2 = $dbh->prepare("SELECT * FROM biblio WHERE biblionumber=?");
920 $dbh->prepare("SELECT * FROM aqorderbreakdown WHERE ordernumber=?");
921 while ( my $data = $sth->fetchrow_hashref ) {
922 $sth2->execute( $data->{'biblionumber'} );
923 my $data2 = $sth2->fetchrow_hashref;
924 $data->{'author'} = $data2->{'author'};
925 $data->{'seriestitle'} = $data2->{'seriestitle'};
926 $sth3->execute( $data->{'ordernumber'} );
927 my $data3 = $sth3->fetchrow_hashref;
928 $data->{'branchcode'} = $data3->{'branchcode'};
929 $data->{'bookfundid'} = $data3->{'bookfundid'};
930 push( @results, $data );
935 return ( scalar(@results), @results );
939 my ( $title, $author, $name, $from_placed_on, $to_placed_on ) = @_;
942 my $total_qtyreceived = 0;
945 # don't run the query if there are no parameters (list would be too long for sure !
946 if ( $title || $author || $name || $from_placed_on || $to_placed_on ) {
947 my $dbh = C4::Context->dbh;
949 "select biblio.title,biblio.author,aqorders.basketno,name,aqbasket.creationdate,aqorders.datereceived, aqorders.quantity, aqorders.quantityreceived, aqorders.ecost from aqorders,aqbasket,aqbooksellers,biblio";
950 $query .= ",borrowers "
951 if ( C4::Context->preference("IndependantBranches") );
953 " where aqorders.basketno=aqbasket.basketno and aqbasket.booksellerid=aqbooksellers.id and biblio.biblionumber=aqorders.biblionumber ";
954 $query .= " and aqbasket.authorisedby=borrowers.borrowernumber"
955 if ( C4::Context->preference("IndependantBranches") );
956 $query .= " and biblio.title like " . $dbh->quote( "%" . $title . "%" )
959 " and biblio.author like " . $dbh->quote( "%" . $author . "%" )
961 $query .= " and name like " . $dbh->quote( "%" . $name . "%" ) if $name;
962 $query .= " and creationdate >" . $dbh->quote($from_placed_on)
964 $query .= " and creationdate<" . $dbh->quote($to_placed_on)
967 if ( C4::Context->preference("IndependantBranches") ) {
968 my $userenv = C4::Context->userenv;
969 if ( ($userenv) && ( $userenv->{flags} != 1 ) ) {
971 " and (borrowers.branchcode = '"
973 . "' or borrowers.branchcode ='')";
976 $query .= " order by booksellerid";
977 warn "query histearch: " . $query;
978 my $sth = $dbh->prepare($query);
981 while ( my $line = $sth->fetchrow_hashref ) {
982 $line->{count} = $cnt++;
983 $line->{toggle} = 1 if $cnt % 2;
984 push @order_loop, $line;
985 $line->{creationdate} = format_date( $line->{creationdate} );
986 $line->{datereceived} = format_date( $line->{datereceived} );
987 $total_qty += $line->{'quantity'};
988 $total_qtyreceived += $line->{'quantityreceived'};
989 $total_price += $line->{'quantity'} * $line->{'ecost'};
992 return \@order_loop, $total_qty, $total_price, $total_qtyreceived;
1003 ($count, @results) = &invoice($booksellerinvoicenumber);
1005 Looks up orders by invoice number.
1007 Returns an array. C<$count> is the number of elements in C<@results>.
1008 C<@results> is an array of references-to-hash; the keys of each
1009 elements are fields from the aqorders, biblio, and biblioitems tables
1010 of the Koha database.
1017 my $dbh = C4::Context->dbh;
1019 my $sth = $dbh->prepare(
1020 "Select * from aqorders,biblio,biblioitems where
1021 booksellerinvoicenumber=?
1022 and biblio.biblionumber=aqorders.biblionumber and biblioitems.biblioitemnumber=
1023 aqorders.biblioitemnumber group by aqorders.ordernumber,aqorders.biblioitemnumber"
1025 $sth->execute($invoice);
1026 while ( my $data = $sth->fetchrow_hashref ) {
1027 push( @results, $data );
1030 return ( scalar(@results), @results );
1035 ($count, @results) = &bookfunds();
1037 Returns a list of all book funds.
1039 C<$count> is the number of elements in C<@results>. C<@results> is an
1040 array of references-to-hash, whose keys are fields from the aqbookfund
1041 and aqbudget tables of the Koha database. Results are ordered
1042 alphabetically by book fund name.
1049 my $dbh = C4::Context->dbh;
1050 my $userenv = C4::Context->userenv;
1051 my $branch = $userenv->{branch};
1054 if ( $branch ne '' ) {
1055 $strsth = "SELECT * FROM aqbookfund,aqbudget WHERE aqbookfund.bookfundid
1056 =aqbudget.bookfundid AND startdate<now() AND enddate>now() AND (aqbookfund.branchcode is null or aqbookfund.branchcode='' or aqbookfund.branchcode= ? )
1057 GROUP BY aqbookfund.bookfundid ORDER BY bookfundname";
1060 $strsth = "SELECT * FROM aqbookfund,aqbudget WHERE aqbookfund.bookfundid
1061 =aqbudget.bookfundid AND startdate<now() AND enddate>now()
1062 GROUP BY aqbookfund.bookfundid ORDER BY bookfundname";
1064 my $sth = $dbh->prepare($strsth);
1065 if ( $branch ne '' ) {
1066 $sth->execute($branch);
1072 while ( my $data = $sth->fetchrow_hashref ) {
1073 push( @results, $data );
1076 return ( scalar(@results), @results );
1079 =item bookfundbreakdown
1081 returns the total comtd & spent for a given bookfund, and a given year
1082 used in acqui-home.pl
1087 sub bookfundbreakdown {
1088 my ( $id, $year ) = @_;
1089 my $dbh = C4::Context->dbh;
1090 my $sth = $dbh->prepare(
1091 "SELECT quantity,datereceived,freight,unitprice,listprice,ecost,
1092 quantityreceived,subscription
1093 FROM aqorders,aqorderbreakdown WHERE bookfundid=? AND
1094 aqorders.ordernumber=aqorderbreakdown.ordernumber
1095 AND (datecancellationprinted is NULL OR
1096 datecancellationprinted='0000-00-00')"
1099 $sth = $dbh->prepare(
1100 "SELECT quantity,datereceived,freight,unitprice,listprice,ecost,
1101 quantityreceived,subscription
1102 FROM aqorders,aqorderbreakdown
1103 WHERE bookfundid=? AND
1104 aqorders.ordernumber=aqorderbreakdown.ordernumber
1105 AND (datecancellationprinted is NULL OR
1106 datecancellationprinted='0000-00-00')
1107 AND ((datereceived >= ? AND datereceived < ?) OR
1108 (budgetdate >= ? AND budgetdate < ?))"
1110 $sth->execute( $id, $start, $end, $start, $end );
1118 while ( my $data = $sth->fetchrow_hashref ) {
1120 if ( $data->{'subscription'} == 1 ) {
1121 $spent += $data->{'quantity'} * $data->{'unitprice'};
1124 my $leftover = $data->{'quantity'} - $data->{'quantityreceived'};
1125 $comtd += ( $data->{'ecost'} ) * $leftover;
1126 $spent += ( $data->{'unitprice'} ) * $data->{'quantityreceived'};
1130 return ( $spent, $comtd );
1135 $foreignprice = &curconvert($currency, $localprice);
1137 Converts the price C<$localprice> to foreign currency C<$currency> by
1138 dividing by the exchange rate, and returns the result.
1140 If no exchange rate is found, C<&curconvert> assumes the rate is one
1147 my ( $currency, $price ) = @_;
1148 my $dbh = C4::Context->dbh;
1149 my $sth = $dbh->prepare("Select rate from currency where currency=?");
1150 $sth->execute($currency);
1151 my $cur = ( $sth->fetchrow_array() )[0];
1156 return ( $price / $cur );
1161 ($count, $currencies) = &getcurrencies();
1163 Returns the list of all known currencies.
1165 C<$count> is the number of elements in C<$currencies>. C<$currencies>
1166 is a reference-to-array; its elements are references-to-hash, whose
1167 keys are the fields from the currency table in the Koha database.
1173 my $dbh = C4::Context->dbh;
1174 my $sth = $dbh->prepare("Select * from currency");
1177 while ( my $data = $sth->fetchrow_hashref ) {
1178 push( @results, $data );
1181 return ( scalar(@results), \@results );
1184 =item updatecurrencies
1186 &updatecurrencies($currency, $newrate);
1188 Sets the exchange rate for C<$currency> to be C<$newrate>.
1193 sub updatecurrencies {
1194 my ( $currency, $rate ) = @_;
1195 my $dbh = C4::Context->dbh;
1196 my $sth = $dbh->prepare("update currency set rate=? where currency=?");
1197 $sth->execute( $rate, $currency );
1209 ($count, @results) = &bookseller($searchstring);
1211 Looks up a book seller. C<$searchstring> may be either a book seller
1212 ID, or a string to look for in the book seller's name.
1214 C<$count> is the number of elements in C<@results>. C<@results> is an
1215 array of references-to-hash, whose keys are the fields of of the
1216 aqbooksellers table in the Koha database.
1222 my ($searchstring) = @_;
1223 my $dbh = C4::Context->dbh;
1225 $dbh->prepare("Select * from aqbooksellers where name like ? or id = ?");
1226 $sth->execute( "$searchstring%", $searchstring );
1228 while ( my $data = $sth->fetchrow_hashref ) {
1229 push( @results, $data );
1232 return ( scalar(@results), @results );
1237 ($count, $results) = &breakdown($ordernumber);
1239 Looks up an order by order ID, and returns its breakdown.
1241 C<$count> is the number of elements in C<$results>. C<$results> is a
1242 reference-to-array; its elements are references-to-hash, whose keys
1243 are the fields of the aqorderbreakdown table in the Koha database.
1250 my $dbh = C4::Context->dbh;
1252 $dbh->prepare("Select * from aqorderbreakdown where ordernumber=?");
1255 while ( my $data = $sth->fetchrow_hashref ) {
1256 push( @results, $data );
1259 return ( scalar(@results), \@results );
1264 ($count, @results) = &branches();
1266 Returns a list of all library branches.
1268 C<$count> is the number of elements in C<@results>. C<@results> is an
1269 array of references-to-hash, whose keys are the fields of the branches
1270 table of the Koha database.
1276 my $dbh = C4::Context->dbh;
1278 if ( C4::Context->preference("IndependantBranches")
1279 && ( C4::Context->userenv )
1280 && ( C4::Context->userenv->{flags} != 1 ) )
1282 my $strsth = "Select * from branches ";
1284 " WHERE branchcode = "
1285 . $dbh->quote( C4::Context->userenv->{branch} );
1286 $strsth .= " order by branchname";
1287 warn "C4::Acquisition->branches : " . $strsth;
1288 $sth = $dbh->prepare($strsth);
1291 $sth = $dbh->prepare("Select * from branches order by branchname");
1296 while ( my $data = $sth->fetchrow_hashref ) {
1297 push( @results, $data );
1301 return ( scalar(@results), @results );
1306 &updatesup($bookseller);
1308 Updates the information for a given bookseller. C<$bookseller> is a
1309 reference-to-hash whose keys are the fields of the aqbooksellers table
1310 in the Koha database. It must contain entries for all of the fields.
1311 The entry to modify is determined by C<$bookseller-E<gt>{id}>.
1313 The easiest way to get all of the necessary fields is to look up a
1314 book seller with C<&booksellers>, modify what's necessary, then call
1315 C<&updatesup> with the result.
1322 my $dbh = C4::Context->dbh;
1323 my $sth = $dbh->prepare(
1324 "Update aqbooksellers set
1325 name=?,address1=?,address2=?,address3=?,address4=?,postal=?,
1326 phone=?,fax=?,url=?,contact=?,contpos=?,contphone=?,contfax=?,contaltphone=?,
1327 contemail=?,contnotes=?,active=?,
1328 listprice=?, invoiceprice=?,gstreg=?, listincgst=?,
1329 invoiceincgst=?, specialty=?,discount=?,invoicedisc=?,
1334 $data->{'name'}, $data->{'address1'},
1335 $data->{'address2'}, $data->{'address3'},
1336 $data->{'address4'}, $data->{'postal'},
1337 $data->{'phone'}, $data->{'fax'},
1338 $data->{'url'}, $data->{'contact'},
1339 $data->{'contpos'}, $data->{'contphone'},
1340 $data->{'contfax'}, $data->{'contaltphone'},
1341 $data->{'contemail'}, $data->{'contnote'},
1342 $data->{'active'}, $data->{'listprice'},
1343 $data->{'invoiceprice'}, $data->{'gstreg'},
1344 $data->{'listincgst'}, $data->{'invoiceincgst'},
1345 $data->{'specialty'}, $data->{'discount'},
1346 $data->{'invoicedisc'}, $data->{'nocalc'},
1354 $id = &insertsup($bookseller);
1356 Creates a new bookseller. C<$bookseller> is a reference-to-hash whose
1357 keys are the fields of the aqbooksellers table in the Koha database.
1358 All fields must be present.
1360 Returns the ID of the newly-created bookseller.
1367 my $dbh = C4::Context->dbh;
1368 my $sth = $dbh->prepare("Select max(id) from aqbooksellers");
1370 my $data2 = $sth->fetchrow_hashref;
1372 $data2->{'max(id)'}++;
1373 $sth = $dbh->prepare("Insert into aqbooksellers (id) values (?)");
1374 $sth->execute( $data2->{'max(id)'} );
1376 $data->{'id'} = $data2->{'max(id)'};
1378 return ( $data->{'id'} );
1383 ($count, $results) = &getparcels($dbh, $bookseller, $order, $limit);
1385 get a lists of parcels
1386 Returns the count of parcels returned and a pointer on a hash list containing parcel informations as such :
1397 my ( $bookseller, $order, $code, $datefrom, $dateto, $limit ) = @_;
1398 my $dbh = C4::Context->dbh;
1400 "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 ";
1401 $strsth .= "and aqorders.booksellerinvoicenumber like \"$code%\" "
1403 $strsth .= "and datereceived >=" . $dbh->quote($datefrom) . " "
1405 $strsth .= "and datereceived <=" . $dbh->quote($dateto) . " " if ($dateto);
1406 $strsth .= "group by aqorders.booksellerinvoicenumber,datereceived ";
1407 $strsth .= "order by $order " if ($order);
1408 $strsth .= " LIMIT 0,$limit" if ($limit);
1409 my $sth = $dbh->prepare($strsth);
1410 ### getparcels: $strsth
1414 while ( my $data2 = $sth->fetchrow_hashref ) {
1415 push @results, $data2;
1419 return ( scalar(@results), @results );
1422 END { } # module clean-up code here (global destructor)
1431 Koha Developement team <info@koha.org>