From a4c279ac4e2f4a2dd724331b710b17474f44c22c Mon Sep 17 00:00:00 2001 From: toins Date: Thu, 27 Jul 2006 13:39:00 +0000 Subject: [PATCH] Acquisition module has been cut into 3 files : *Bookseller.pm* : contains all functions dealing with bookseller. *Bookfund.pm* : contains all functions dealing with bookfund, currency & budget. *Acquisition.pm* contains all functions dealing with orders, basket & parcels. --- C4/Acquisition.pm | 1803 +++++++++++++++++---------------------------- C4/Bookfund.pm | 424 +++++++++++ C4/Bookseller.pm | 276 +++++++ 3 files changed, 1391 insertions(+), 1112 deletions(-) create mode 100755 C4/Bookfund.pm create mode 100755 C4/Bookseller.pm diff --git a/C4/Acquisition.pm b/C4/Acquisition.pm index 3edf80d0e8..413d6a2ed2 100644 --- a/C4/Acquisition.pm +++ b/C4/Acquisition.pm @@ -17,6 +17,8 @@ package C4::Acquisition; # Koha; if not, write to the Free Software Foundation, Inc., 59 Temple Place, # Suite 330, Boston, MA 02111-1307 USA +# $Id$ + use strict; require Exporter; use C4::Context; @@ -25,14 +27,12 @@ use MARC::Record; use C4::Suggestions; use Time::localtime; -# use C4::Biblio; - use vars qw($VERSION @ISA @EXPORT); # set the version for version checking $VERSION = do { my @v = '$Revision$' =~ /\d+/g; shift(@v) . "." . join( "_", map { sprintf "%03d", $_ } @v ); }; -# used in reciveorder subroutine +# used in receiveorder subroutine # to provide library specific handling my $library_name = C4::Context->preference("LibraryName"); @@ -42,12 +42,12 @@ C4::Acquisition - Koha functions for dealing with orders and acquisitions =head1 SYNOPSIS - use C4::Acquisition; +use C4::Acquisition; =head1 DESCRIPTION The functions in this module deal with acquisitions, managing book -orders, converting money to different currencies, and so forth. +orders, basket and parcels. =head1 FUNCTIONS @@ -57,142 +57,384 @@ orders, converting money to different currencies, and so forth. @ISA = qw(Exporter); @EXPORT = qw( - &getbasket &getbasketcontent &newbasket &closebasket - - &getorders &getallorders &getrecorders - &getorder &neworder &delorder - &ordersearch &histsearch - &modorder &getsingleorder &invoice &receiveorder - &updaterecorder &newordernum - &getsupplierlistwithlateorders - &getlateorders - &getparcels &getparcelinformation - &bookfunds &curconvert &getcurrencies &bookfundbreakdown - &updatecurrencies &getcurrency - &updatesup &insertsup - &bookseller &breakdown + &GetBasket &GetBasketContent &NewBasket &CloseBasket + &GetPendingOrders &GetAllOrders + &GetOrder &GetLateOrders &NewOrder &DelOrder + &SearchOrder &GetHistory + &ModOrder &GetSingleOrder &ModReceiveOrder + &GetParcels &GetParcel ); -# -# -# -# BASKETS -# -# -# +=head2 FUNCTIONS ABOUT BASKETS -=item getbasket +=over 2 + +=cut + +#------------------------------------------------------------# + +=head3 GetBasket - $aqbasket = &getbasket($basketnumber); +=over 4 + +$aqbasket = &GetBasket($basketnumber); get all basket informations in aqbasket for a given basket + +return : +informations for a given basket returned as a hashref. + +=back + +=back + =cut -sub getbasket { +sub GetBasket { my ($basketno) = @_; my $dbh = C4::Context->dbh; - 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=?" - ); + my $query = " + SELECT aqbasket.*, + borrowers.firstname+' '+borrowers.surname AS authorisedbyname, + borrowers.branchcode AS branch + FROM aqbasket + LEFT JOIN borrowers ON aqbasket.authorisedby=borrowers.borrowernumber + WHERE basketno=? + "; + my $sth=$dbh->prepare($query); $sth->execute($basketno); return ( $sth->fetchrow_hashref ); - $sth->finish(); } -=item getbasketcontent +#------------------------------------------------------------# - ($count, @orders) = &getbasketcontent($basketnumber, $booksellerID); +=head3 GetBasketContent + +=over 4 + +@orders = &GetBasketContent($basketnumber, $orderby); Looks up the pending (non-cancelled) orders with the given basket number. If C<$booksellerID> is non-empty, only orders from that seller are returned. +return : C<&basket> returns a two-element array. C<@orders> is an array of references-to-hash, whose keys are the fields from the aqorders, -biblio, and biblioitems tables in the Koha database. C<$count> is the -number of elements in C<@orders>. +biblio, and biblioitems tables in the Koha database. + +=back =cut -#' -sub getbasketcontent { - my ( $basketno, $supplier, $orderby ) = @_; +sub GetBasketContent { + my ( $basketno, $orderby ) = @_; my $dbh = C4::Context->dbh; - my $query = -"SELECT aqorderbreakdown.*,biblio.*,biblioitems.*,aqorders.*,biblio.title FROM aqorders,biblio,biblioitems - LEFT JOIN aqorderbreakdown ON aqorderbreakdown.ordernumber=aqorders.ordernumber - where basketno=? - AND biblio.biblionumber=aqorders.biblionumber AND biblioitems.biblioitemnumber - =aqorders.biblioitemnumber - AND (datecancellationprinted IS NULL OR datecancellationprinted = - '0000-00-00')"; - if ( $supplier ne '' ) { - $query .= " AND aqorders.booksellerid=?"; - } + my $query =" + SELECT aqorderbreakdown.*, + biblio.*,biblioitems.*, + aqorders.*, + biblio.title + FROM aqorders,biblio,biblioitems + LEFT JOIN aqorderbreakdown ON + aqorders.ordernumber=aqorderbreakdown.ordernumber + WHERE basketno=? + AND biblio.biblionumber=aqorders.biblionumber + AND biblioitems.biblioitemnumber=aqorders.biblioitemnumber + AND (datecancellationprinted IS NULL OR datecancellationprinted='0000-00-00') + "; $orderby = "biblioitems.publishercode" unless $orderby; $query .= " ORDER BY $orderby"; my $sth = $dbh->prepare($query); - if ( $supplier ne '' ) { - $sth->execute( $basketno, $supplier ); - } - else { - $sth->execute($basketno); - } + $sth->execute($basketno); my @results; + my $i=0; # print $query; - my $i = 0; while ( my $data = $sth->fetchrow_hashref ) { - $results[$i] = $data; - $i++; + $results[$i++] = $data; } $sth->finish; - return ( $i, @results ); + return @results; } -=item newbasket +#------------------------------------------------------------# + +=head3 NewBasket + +=over 4 - $basket = &newbasket(); +$basket = &NewBasket(); Create a new basket in aqbasket table + +=back + =cut -sub newbasket { +# FIXME : this function seems to be unused. + +sub NewBasket { my ( $booksellerid, $authorisedby ) = @_; my $dbh = C4::Context->dbh; + my $query = " + INSERT INTO aqbasket + (creationdate,booksellerid,authorisedby) + VALUES (now(),'$booksellerid','$authorisedby') + "; my $sth = - $dbh->do( -"insert into aqbasket (creationdate,booksellerid,authorisedby) values(now(),'$booksellerid','$authorisedby')" - ); + $dbh->do($query); #find & return basketno MYSQL dependant, but $dbh->last_insert_id always returns null :-( my $basket = $dbh->{'mysql_insertid'}; - return ($basket); + return $basket; } -=item closebasket +#------------------------------------------------------------# + +=head3 CloseBasket + +=over 4 + +&CloseBasket($basketno); + +close a basket (becomes unmodifiable,except for recieves) - &newbasket($basketno); +=back -close a basket (becomes unmodifiable,except for recieves =cut -sub closebasket { +sub CloseBasket { my ($basketno) = @_; my $dbh = C4::Context->dbh; - my $sth = - $dbh->prepare("update aqbasket set closedate=now() where basketno=?"); + my $query = " + UPDATE aqbasket + SET closedate=now() + WHERE basketno=? + "; + my $sth = $dbh->prepare($query); $sth->execute($basketno); } -=item neworder +#------------------------------------------------------------# + +=back + +=head2 FUNCTIONS ABOUT ORDERS + +=over 2 + +=cut + +#------------------------------------------------------------# + +=head3 GetPendingOrders + +=over 4 + +$orders = &GetPendingOrders($booksellerid); + +Finds pending orders from the bookseller with the given ID. Ignores +completed and cancelled orders. + +C<$orders> is a reference-to-array; each element is a +reference-to-hash with the following fields: + +=over 2 + +=item C + +=item C + +=item C + +These give the value of the corresponding field in the aqorders table +of the Koha database. + +=back + +=back + +Results are ordered from most to least recent. + +=cut + +sub GetPendingOrders { + my $supplierid = @_; + my $dbh = C4::Context->dbh; + my $strsth = " + SELECT count(*),authorisedby,creationdate,aqbasket.basketno, + closedate,surname,firstname,aqorders.title + FROM aqorders + LEFT JOIN aqbasket ON aqbasket.basketno=aqorders.basketno + LEFT JOIN borrowers ON aqbasket.authorisedby=borrowers.borrowernumber + WHERE booksellerid=? + AND (quantity > quantityreceived OR quantityreceived is NULL) + AND datecancellationprinted IS NULL + AND (to_days(now())-to_days(closedate) < 180 OR closedate IS NULL) + "; + if ( C4::Context->preference("IndependantBranches") ) { + my $userenv = C4::Context->userenv; + if ( ($userenv) && ( $userenv->{flags} != 1 ) ) { + $strsth .= + " and (borrowers.branchcode = '" + . $userenv->{branch} + . "' or borrowers.branchcode ='')"; + } + } + $strsth .= " group by basketno order by aqbasket.basketno"; + my $sth = $dbh->prepare($strsth); + $sth->execute($supplierid); + my @results = (); + while ( my $data = $sth->fetchrow_hashref ) { + push( @results, $data ); + } + $sth->finish; + return \@results; +} + +#------------------------------------------------------------# + +=head3 GetOrder + +=over 4 + +($order, $ordernumber) = &GetOrder($biblioitemnumber, $biblionumber); + +Looks up the order with the given biblionumber and biblioitemnumber. + +Returns a two-element array. C<$ordernumber> is the order number. +C<$order> is a reference-to-hash describing the order; its keys are +fields from the biblio, biblioitems, aqorders, and aqorderbreakdown +tables of the Koha database. + +=back + +=cut +# @_ = biblioitemnumber, biblionumber. +sub GetOrder { + my ( $bi, $bib ) = @_; + my $dbh = C4::Context->dbh; + my $query = " + SELECT ordernumber + FROM aqorders + WHERE biblionumber=? + AND biblioitemnumber=? + "; + my $sth = $dbh->prepare($query); + $sth->execute( $bib, $bi ); + + # FIXME - Use fetchrow_array(), since we're only interested in the one + # value. + my $ordnum = $sth->fetchrow_hashref; + $sth->finish; + my $order = GetSingleOrder( $ordnum->{'ordernumber'} ); + return ( $order, $ordnum->{'ordernumber'} ); +} + +#------------------------------------------------------------# + +=head3 GetSingleOrder + +=over 4 + +$order = &GetSingleOrder($ordernumber); + +Looks up an order by order number. + +Returns a reference-to-hash describing the order. The keys of +C<$order> are fields from the biblio, biblioitems, aqorders, and +aqorderbreakdown tables of the Koha database. + +=back + +=cut + +sub GetSingleOrder { + my ($ordnum) = @_; + my $dbh = C4::Context->dbh; + my $query = " + SELECT * + FROM biblio,biblioitems,aqorders + LEFT JOIN aqorderbreakdown ON aqorders.ordernumber=aqorderbreakdown.ordernumber + WHERE aqorders.ordernumber=? + AND biblio.biblionumber=aqorders.biblionumber + AND biblioitems.biblioitemnumber=aqorders.biblioitemnumber + "; + my $sth= $dbh->prepare($query); + $sth->execute($ordnum); + my $data = $sth->fetchrow_hashref; + $sth->finish; + return $data; +} + +#------------------------------------------------------------# + +=head3 GetAllOrders + +=over 4 + +@results = &GetAllOrders($booksellerid); + +Looks up all of the pending orders from the supplier with the given +bookseller ID. Ignores cancelled and completed orders. + +C<@results> is an array of references-to-hash. The keys of each element are fields from +the aqorders, biblio, and biblioitems tables of the Koha database. + +C<@results> is sorted alphabetically by book title. + +=back + +=cut + +sub GetAllOrders { + + #gets all orders from a certain supplier, orders them alphabetically + my ($supplierid) = @_; + my $dbh = C4::Context->dbh; + my @results = (); + my $strsth = " + SELECT count(*),authorisedby,creationdate,aqbasket.basketno, + closedate,surname,firstname,aqorders.biblionumber,aqorders.title, aqorders.ordernumber + FROM aqorders + LEFT JOIN aqbasket ON aqbasket.basketno=aqorders.basketno + LEFT JOIN borrowers ON aqbasket.authorisedby=borrowers.borrowernumber + WHERE booksellerid=? + AND (quantity > quantityreceived OR quantityreceived IS NULL) + AND datecancellationprinted IS NULL + "; + + if ( C4::Context->preference("IndependantBranches") ) { + my $userenv = C4::Context->userenv; + if ( ($userenv) && ( $userenv->{flags} != 1 ) ) { + $strsth .= + " and (borrowers.branchcode = '" + . $userenv->{branch} + . "' or borrowers.branchcode ='')"; + } + } + $strsth .= " group by basketno order by aqbasket.basketno"; + my $sth = $dbh->prepare($strsth); + $sth->execute($supplierid); + while ( my $data = $sth->fetchrow_hashref ) { + push( @results, $data ); + } + $sth->finish; + return @results; +} + +#------------------------------------------------------------# + +=head3 NewOrder - &neworder($basket, $biblionumber, $title, $quantity, $listprice, - $booksellerid, $who, $notes, $bookfund, $biblioitemnumber, $rrp, - $ecost, $gst, $budget, $unitprice, $subscription, - $booksellerinvoicenumber); +=over 4 + + &NewOrder($basket, $biblionumber, $title, $quantity, $listprice, + $booksellerid, $who, $notes, $bookfund, $biblioitemnumber, $rrp, + $ecost, $gst, $budget, $unitprice, $subscription, + $booksellerinvoicenumber); Adds a new order to the database. Any argument that isn't described below is the new value of the field with the same name in the aqorders @@ -208,10 +450,11 @@ C<$budget> is effectively ignored. C<$subscription> may be either "yes", or anything else for "no". +=back + =cut -#' -sub neworder { +sub NewOrder { my ( $basketno, $bibnum, $title, $quantity, $listprice, $booksellerid, $authorisedby, $notes, @@ -248,16 +491,17 @@ sub neworder { # if $basket empty, it's also a new basket, create it unless ($basketno) { - $basketno = newbasket( $booksellerid, $authorisedby ); + $basketno = NewBasket( $booksellerid, $authorisedby ); } my $dbh = C4::Context->dbh; - my $sth = $dbh->prepare( - "insert into aqorders + my $query = " + INSERT INTO aqorders ( biblionumber,title,basketno,quantity,listprice,notes, biblioitemnumber,rrp,ecost,gst,unitprice,subscription,sort1,sort2,budgetdate,entrydate) - values (?,?,?,?,?,?,?,?,?,?,?,?,?,?,$budget,now() )" - ); + VALUES (?,?,?,?,?,?,?,?,?,?,?,?,?,?,$budget,now() ) + "; + my $sth = $dbh->prepare($query); $sth->execute( $bibnum, $title, $basketno, $quantity, $listprice, @@ -268,43 +512,26 @@ sub neworder { #get ordnum MYSQL dependant, but $dbh->last_insert_id returns null my $ordnum = $dbh->{'mysql_insertid'}; - $sth = $dbh->prepare( - "insert into aqorderbreakdown (ordernumber,bookfundid) values - (?,?)" - ); + my $query = " + INSERT INTO aqorderbreakdown (ordernumber,bookfundid) + VALUES (?,?) + "; + $sth = $dbh->prepare($query); $sth->execute( $ordnum, $bookfund ); $sth->finish; return ( $basketno, $ordnum ); } -=item delorder - - &delorder($biblionumber, $ordernumber); +#------------------------------------------------------------# -Cancel the order with the given order and biblio numbers. It does not -delete any entries in the aqorders table, it merely marks them as -cancelled. - -=cut - -#' -sub delorder { - my ( $bibnum, $ordnum ) = @_; - my $dbh = C4::Context->dbh; - my $sth = $dbh->prepare( - "update aqorders set datecancellationprinted=now() - where biblionumber=? and ordernumber=?" - ); - $sth->execute( $bibnum, $ordnum ); - $sth->finish; -} +=head3 ModOrder -=item modorder +=over 4 - &modorder($title, $ordernumber, $quantity, $listprice, - $biblionumber, $basketno, $supplier, $who, $notes, - $bookfundid, $bibitemnum, $rrp, $ecost, $gst, $budget, - $unitprice, $booksellerinvoicenumber); +&ModOrder($title, $ordernumber, $quantity, $listprice, + $biblionumber, $basketno, $supplier, $who, $notes, + $bookfundid, $bibitemnum, $rrp, $ecost, $gst, $budget, + $unitprice, $booksellerinvoicenumber); Modifies an existing order. Updates the order with order number C<$ordernumber> and biblionumber C<$biblionumber>. All other arguments @@ -314,10 +541,11 @@ database. Entries with order number C<$ordernumber> in the aqorderbreakdown table are also updated to the new book fund ID. +=back + =cut -#' -sub modorder { +sub ModOrder { my ( $title, $ordnum, $quantity, $listprice, $bibnum, $basketno, $supplier, $who, $notes, $bookfund, @@ -326,62 +554,50 @@ sub modorder { ) = @_; my $dbh = C4::Context->dbh; - my $sth = $dbh->prepare( - "update aqorders set title=?, - quantity=?,listprice=?,basketno=?, - rrp=?,ecost=?,unitprice=?,booksellerinvoicenumber=?, - notes=?,sort1=?, sort2=? - where - ordernumber=? and biblionumber=?" - ); + my $query = " + UPDATE aqorders + SET title=?, + quantity=?,listprice=?,basketno=?, + rrp=?,ecost=?,unitprice=?,booksellerinvoicenumber=?, + notes=?,sort1=?, sort2=? + WHERE ordernumber=? AND biblionumber=? + "; + my $sth = $dbh->prepare($query); $sth->execute( $title, $quantity, $listprice, $basketno, $rrp, $ecost, $cost, $invoice, $notes, $sort1, $sort2, $ordnum, $bibnum ); $sth->finish; - $sth = $dbh->prepare( - "update aqorderbreakdown set bookfundid=? where - ordernumber=?" - ); + my $query = " + UPDATE aqorderbreakdown + SET bookfundid=? + WHERE ordernumber=? + "; + $sth = $dbh->prepare($query); unless ( $sth->execute( $bookfund, $ordnum ) ) { # zero rows affected [Bug 734] - my $query = - "insert into aqorderbreakdown (ordernumber,bookfundid) values (?,?)"; + my $query =" + INSERT INTO aqorderbreakdown + (ordernumber,bookfundid) + VALUES (?,?) + "; $sth = $dbh->prepare($query); $sth->execute( $ordnum, $bookfund ); } $sth->finish; } -=item newordernum - - $order = &newordernum(); - -Finds the next unused order number in the aqorders table of the Koha -database, and returns it. +#------------------------------------------------------------# -=cut - -#' -# FIXME - Race condition -sub newordernum { - my $dbh = C4::Context->dbh; - my $sth = $dbh->prepare("Select max(ordernumber) from aqorders"); - $sth->execute; - my $data = $sth->fetchrow_arrayref; - my $ordnum = $$data[0]; - $ordnum++; - $sth->finish; - return ($ordnum); -} +=head3 ModReceiveOrder -=item receiveorder +=over 4 - &receiveorder($biblionumber, $ordernumber, $quantityreceived, $user, - $unitprice, $booksellerinvoicenumber, $biblioitemnumber, - $freight, $bookfund, $rrp); +&ModReceiveOrder($biblionumber, $ordernumber, $quantityreceived, $user, + $unitprice, $booksellerinvoicenumber, $biblioitemnumber, + $freight, $bookfund, $rrp); Updates an order, to reflect the fact that it was received, at least in part. All arguments not mentioned below update the fields with the @@ -392,21 +608,25 @@ C<$ordernumber>. Also updates the book fund ID in the aqorderbreakdown table. +=back + =cut -#' -sub receiveorder { + +sub ModReceiveOrder { my ( $biblio, $ordnum, $quantrec, $user, $cost, $invoiceno, $freight, $rrp, $bookfund ) = @_; my $dbh = C4::Context->dbh; - my $sth = $dbh->prepare( -"update aqorders set quantityreceived=?,datereceived=now(),booksellerinvoicenumber=?, - unitprice=?,freight=?,rrp=? - where biblionumber=? and ordernumber=?" - ); + my $query = " + UPDATE aqorders + SET quantityreceived=?,datereceived=now(),booksellerinvoicenumber=?, + unitprice=?,freight=?,rrp=? + WHERE biblionumber=? AND ordernumber=? + "; + my $sth = $dbh->prepare($query); my $suggestionid = GetSuggestionFromBiblionumber( $dbh, $biblio ); if ($suggestionid) { ModStatus( $suggestionid, 'AVAILABLE', '', $biblio ); @@ -418,242 +638,193 @@ sub receiveorder { # Allows libraries to change their bookfund during receiving orders # allows them to adjust budgets if ( C4::Context->preferene("LooseBudgets") ) { - my $sth = $dbh->prepare( - "UPDATE aqorderbreakdown SET bookfundid=? - WHERE ordernumber=?" - ); + my $query = " + UPDATE aqorderbreakdown + SET bookfundid=? + WHERE ordernumber=? + "; + my $sth = $dbh->prepare($query); $sth->execute( $bookfund, $ordnum ); $sth->finish; } } -=item updaterecorder +#------------------------------------------------------------# - &updaterecorder($biblionumber, $ordernumber, $user, $unitprice, - $bookfundid, $rrp); +=head3 SearchOrder -Updates the order with biblionumber C<$biblionumber> and order number -C<$ordernumber>. C<$bookfundid> is the new value for the book fund ID -in the aqorderbreakdown table of the Koha database. All other -arguments update the fields with the same name in the aqorders table. +@results = &SearchOrder($search, $biblionumber, $complete); -C<$user> is ignored. +Searches for orders. -=cut +C<$search> may take one of several forms: if it is an ISBN, +C<&ordersearch> returns orders with that ISBN. If C<$search> is an +order number, C<&ordersearch> returns orders with that order number +and biblionumber C<$biblionumber>. Otherwise, C<$search> is considered +to be a space-separated list of search terms; in this case, all of the +terms must appear in the title (matching the beginning of title +words). -#' -sub updaterecorder { - my ( $biblio, $ordnum, $user, $cost, $bookfund, $rrp ) = @_; - my $dbh = C4::Context->dbh; - my $sth = $dbh->prepare( - "update aqorders set - unitprice=?, rrp=? - where biblionumber=? and ordernumber=? - " - ); - $sth->execute( $cost, $rrp, $biblio, $ordnum ); - $sth->finish; - $sth = - $dbh->prepare( - "update aqorderbreakdown set bookfundid=? where ordernumber=?"); - $sth->execute( $bookfund, $ordnum ); - $sth->finish; -} +If C<$complete> is C, the results will include only completed +orders. In any case, C<&ordersearch> ignores cancelled orders. -# -# -# ORDERS -# -# +C<&ordersearch> returns an array. C<@results> is an array of references-to-hash with the +following keys: -=item getorders +=over 4 - ($count, $orders) = &getorders($booksellerid); +=item C -Finds pending orders from the bookseller with the given ID. Ignores -completed and cancelled orders. - -C<$count> is the number of elements in C<@{$orders}>. - -C<$orders> is a reference-to-array; each element is a -reference-to-hash with the following fields: - -=over 4 - -=item C - -Gives the number of orders in with this basket number. - -=item C - -=item C +=item C -=item C +=item C -These give the value of the corresponding field in the aqorders table -of the Koha database. +=item C =back -Results are ordered from most to least recent. - =cut -#' -sub getorders { - my ($supplierid) = @_; +sub SearchOrder { + my ( $search, $id, $biblio, $catview ) = @_; my $dbh = C4::Context->dbh; - my $strsth = "Select count(*),authorisedby,creationdate,aqbasket.basketno, -closedate,surname,firstname,aqorders.title -from aqorders -left join aqbasket on aqbasket.basketno=aqorders.basketno -left join borrowers on aqbasket.authorisedby=borrowers.borrowernumber -where booksellerid=? and (quantity > quantityreceived or -quantityreceived is NULL) and datecancellationprinted is NULL and (to_days(now())-to_days(closedate) < 180 or closedate is null)"; - if ( C4::Context->preference("IndependantBranches") ) { - my $userenv = C4::Context->userenv; - if ( ($userenv) && ( $userenv->{flags} != 1 ) ) { - $strsth .= - " and (borrowers.branchcode = '" - . $userenv->{branch} - . "' or borrowers.branchcode ='')"; - } + my @data = split( ' ', $search ); + my @searchterms; + if ($id) { + @searchterms = ($id); } - $strsth .= " group by basketno order by aqbasket.basketno"; - my $sth = $dbh->prepare($strsth); - $sth->execute($supplierid); + map { push( @searchterms, "$_%", "% $_%" ) } @data; + push( @searchterms, $search, $search, $biblio ); + my $query; + if ($id) { + $query = + "SELECT *,biblio.title FROM aqorders,biblioitems,biblio,aqbasket + WHERE aqorders.biblioitemnumber = biblioitems.biblioitemnumber AND + aqorders.basketno = aqbasket.basketno + AND aqbasket.booksellerid = ? + AND biblio.biblionumber=aqorders.biblionumber + AND ((datecancellationprinted is NULL) + OR (datecancellationprinted = '0000-00-00')) + AND ((" + . ( + join( " AND ", + map { "(biblio.title like ? or biblio.title like ?)" } @data ) + ) + . ") OR biblioitems.isbn=? OR (aqorders.ordernumber=? AND aqorders.biblionumber=?)) "; + + } + else { + $query = + " SELECT *,biblio.title + FROM aqorders,biblioitems,biblio,aqbasket + WHERE aqorders.biblioitemnumber = biblioitems.biblioitemnumber + AND aqorders.basketno = aqbasket.basketno + AND biblio.biblionumber=aqorders.biblionumber + AND ((datecancellationprinted is NULL) + OR (datecancellationprinted = '0000-00-00')) + AND (aqorders.quantityreceived < aqorders.quantity OR aqorders.quantityreceived is NULL) + AND ((" + . ( + join( " AND ", + map { "(biblio.title like ? OR biblio.title like ?)" } @data ) + ) + . ") or biblioitems.isbn=? OR (aqorders.ordernumber=? AND aqorders.biblionumber=?)) "; + } + $query .= " GROUP BY aqorders.ordernumber"; + my $sth = $dbh->prepare($query); + $sth->execute(@searchterms); my @results = (); + my $query2 = " + SELECT * + FROM biblio + WHERE biblionumber=? + "; + my $sth2 = $dbh->prepare($query2); + my $query3 = " + SELECT * + FROM aqorderbreakdown + WHERE ordernumber=? + "; + my $sth3 = $dbh->prepare($query3); + while ( my $data = $sth->fetchrow_hashref ) { + $sth2->execute( $data->{'biblionumber'} ); + my $data2 = $sth2->fetchrow_hashref; + $data->{'author'} = $data2->{'author'}; + $data->{'seriestitle'} = $data2->{'seriestitle'}; + $sth3->execute( $data->{'ordernumber'} ); + my $data3 = $sth3->fetchrow_hashref; + $data->{'branchcode'} = $data3->{'branchcode'}; + $data->{'bookfundid'} = $data3->{'bookfundid'}; push( @results, $data ); } $sth->finish; - return ( scalar(@results), \@results ); + $sth2->finish; + $sth3->finish; + return @results; } -=item getorder - - ($order, $ordernumber) = &getorder($biblioitemnumber, $biblionumber); - -Looks up the order with the given biblionumber and biblioitemnumber. - -Returns a two-element array. C<$ordernumber> is the order number. -C<$order> is a reference-to-hash describing the order; its keys are -fields from the biblio, biblioitems, aqorders, and aqorderbreakdown -tables of the Koha database. - -=cut - -sub getorder { - my ( $bi, $bib ) = @_; - my $dbh = C4::Context->dbh; - my $sth = - $dbh->prepare( -"Select ordernumber from aqorders where biblionumber=? and biblioitemnumber=?" - ); - $sth->execute( $bib, $bi ); +#------------------------------------------------------------# - # FIXME - Use fetchrow_array(), since we're only interested in the one - # value. - my $ordnum = $sth->fetchrow_hashref; - $sth->finish; - my $order = getsingleorder( $ordnum->{'ordernumber'} ); - return ( $order, $ordnum->{'ordernumber'} ); -} +=head3 DelOrder -=item getsingleorder +=over 4 - $order = &getsingleorder($ordernumber); +&DelOrder($biblionumber, $ordernumber); -Looks up an order by order number. +Cancel the order with the given order and biblio numbers. It does not +delete any entries in the aqorders table, it merely marks them as +cancelled. -Returns a reference-to-hash describing the order. The keys of -C<$order> are fields from the biblio, biblioitems, aqorders, and -aqorderbreakdown tables of the Koha database. +=back =cut -sub getsingleorder { - my ($ordnum) = @_; - my $dbh = C4::Context->dbh; - my $sth = $dbh->prepare( - "Select * from biblio,biblioitems,aqorders left join aqorderbreakdown - on aqorders.ordernumber=aqorderbreakdown.ordernumber - where aqorders.ordernumber=? - and biblio.biblionumber=aqorders.biblionumber and - biblioitems.biblioitemnumber=aqorders.biblioitemnumber" - ); - $sth->execute($ordnum); - my $data = $sth->fetchrow_hashref; +sub DelOrder { + my ( $bibnum, $ordnum ) = @_; + my $dbh = C4::Context->dbh; + my $query = " + UPDATE aqorders + SET datecancellationprinted=now() + WHERE biblionumber=? AND ordernumber=? + "; + my $sth = $dbh->prepare($query); + $sth->execute( $bibnum, $ordnum ); $sth->finish; - return ($data); } -=item getallorders - ($count, @results) = &getallorders($booksellerid); +=back -Looks up all of the pending orders from the supplier with the given -bookseller ID. Ignores cancelled and completed orders. +=back -C<$count> is the number of elements in C<@results>. C<@results> is an -array of references-to-hash. The keys of each element are fields from -the aqorders, biblio, and biblioitems tables of the Koha database. +=head2 FUNCTIONS ABOUT PARCELS -C<@results> is sorted alphabetically by book title. +=over 2 =cut -#' -sub getallorders { +#------------------------------------------------------------# - #gets all orders from a certain supplier, orders them alphabetically - my ($supplierid) = @_; - my $dbh = C4::Context->dbh; - my @results = (); - my $strsth = "Select count(*),authorisedby,creationdate,aqbasket.basketno, -closedate,surname,firstname,aqorders.biblionumber,aqorders.title, aqorders.ordernumber -from aqorders -left join aqbasket on aqbasket.basketno=aqorders.basketno -left join borrowers on aqbasket.authorisedby=borrowers.borrowernumber -where booksellerid=? and (quantity > quantityreceived or -quantityreceived is NULL) and datecancellationprinted is NULL "; - - if ( C4::Context->preference("IndependantBranches") ) { - my $userenv = C4::Context->userenv; - if ( ($userenv) && ( $userenv->{flags} != 1 ) ) { - $strsth .= - " and (borrowers.branchcode = '" - . $userenv->{branch} - . "' or borrowers.branchcode ='')"; - } - } - $strsth .= " group by basketno order by aqbasket.basketno"; - my $sth = $dbh->prepare($strsth); - $sth->execute($supplierid); - while ( my $data = $sth->fetchrow_hashref ) { - push( @results, $data ); - } - $sth->finish; - return ( scalar(@results), @results ); -} +=head3 GetParcel -=item getparcelinformation +=over 4 - ($count, @results) = &getparcelinformation($booksellerid, $code, $date); +@results = &GetParcel($booksellerid, $code, $date); Looks up all of the received items from the supplier with the given bookseller ID at the given date, for the given code. Ignores cancelled and completed orders. -C<$count> is the number of elements in C<@results>. C<@results> is an -array of references-to-hash. The keys of each element are fields from +C<@results> is an array of references-to-hash. The keys of each element are fields from the aqorders, biblio, and biblioitems tables of the Koha database. C<@results> is sorted alphabetically by book title. +=back + =cut -#' -sub getparcelinformation { +sub GetParcel { #gets all orders from a certain supplier, orders them alphabetically my ( $supplierid, $code, $datereceived ) = @_; @@ -661,8 +832,27 @@ sub getparcelinformation { my @results = (); $code .= '%' if $code; # add % if we search on a given code (otherwise, let him empty) - 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\'"; + 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\'"; if ( C4::Context->preference("IndependantBranches") ) { my $userenv = C4::Context->userenv; @@ -680,118 +870,84 @@ sub getparcelinformation { while ( my $data = $sth->fetchrow_hashref ) { push( @results, $data ); } - my $count = scalar(@results); ### countparcelbiblio: $count $sth->finish; - return ( scalar(@results), @results ); + return @results; } -=item getparcelinformation +#------------------------------------------------------------# - ($count, @results) = &getparcelinformation($booksellerid, $code, $date); +=head3 GetParcels -Looks up all of the received items from the supplier with the given -bookseller ID at the given date, for the given code. Ignores cancelled and completed orders. +=over 4 -C<$count> is the number of elements in C<@results>. C<@results> is an -array of references-to-hash. The keys of each element are fields from -the aqorders, biblio, and biblioitems tables of the Koha database. +$results = &GetParcels($bookseller, $order, $code, $datefrom, $dateto, $limit); -C<@results> is sorted alphabetically by book title. +get a lists of parcels +Returns a pointer on a hash list containing parcel informations as such : + Creation date + Last operation + Number of biblio + Number of items + +=back =cut -#' -sub getparcelinformation { +sub GetParcels { + my ($bookseller,$order, $code, $datefrom, $dateto) = @_; + my $dbh = C4::Context->dbh; + 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 + "; - #gets all orders from a certain supplier, orders them alphabetically - my ( $supplierid, $code, $datereceived ) = @_; - my $dbh = C4::Context->dbh; - my @results = (); - $code .= '%' - if $code; # add % if we search on a given code (otherwise, let him empty) - 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\'"; + $strsth .= "and aqorders.booksellerinvoicenumber like \"$code%\" " if ($code); - if ( C4::Context->preference("IndependantBranches") ) { - my $userenv = C4::Context->userenv; - if ( ($userenv) && ( $userenv->{flags} != 1 ) ) { - $strsth .= - " and (borrowers.branchcode = '" - . $userenv->{branch} - . "' or borrowers.branchcode ='')"; - } - } - $strsth .= " order by aqbasket.basketno"; - ### parcelinformation : $strsth - my $sth = $dbh->prepare($strsth); - $sth->execute($supplierid); - while ( my $data = $sth->fetchrow_hashref ) { - push( @results, $data ); - } - my $count = scalar(@results); - ### countparcelbiblio: $count - $sth->finish; + $strsth .= "and datereceived >=" . $dbh->quote($datefrom) . " " if ($datefrom); - return ( scalar(@results), @results ); -} + $strsth .= "and datereceived <=" . $dbh->quote($dateto) . " " if ($dateto); -=item getsupplierlistwithlateorders + $strsth .= "group by aqorders.booksellerinvoicenumber,datereceived "; + $strsth .= "order by $order " if ($order); + my $sth = $dbh->prepare($strsth); - %results = &getsupplierlistwithlateorders; + $sth->execute; + my @results; -Searches for suppliers with late orders. + while ( my $data2 = $sth->fetchrow_hashref ) { + push @results, $data2; + } -=cut + $sth->finish; + return @results; +} -#' -sub getsupplierlistwithlateorders { - my $delay = shift; - my $dbh = C4::Context->dbh; +#------------------------------------------------------------# -#FIXME NOT quite sure that this operation is valid for DBMs different from Mysql, HOPING so -#should be tested with other DBMs +=head3 GetLateOrders - my $strsth; - my $dbdriver = C4::Context->config("db_scheme") || "mysql"; - if ( $dbdriver eq "mysql" ) { - $strsth = "SELECT DISTINCT aqbasket.booksellerid, aqbooksellers.name - FROM aqorders, aqbasket - LEFT JOIN aqbooksellers ON aqbasket.booksellerid = aqbooksellers.id - WHERE aqorders.basketno = aqbasket.basketno AND - (closedate < DATE_SUB(CURDATE( ),INTERVAL $delay DAY) AND (datereceived = '' or datereceived is null)) - "; - } - else { - $strsth = "SELECT DISTINCT aqbasket.booksellerid, aqbooksellers.name - FROM aqorders, aqbasket - LEFT JOIN aqbooksellers ON aqbasket.aqbooksellerid = aqbooksellers.id - WHERE aqorders.basketno = aqbasket.basketno AND - (closedate < (CURDATE( )-(INTERVAL $delay DAY))) AND (datereceived = '' or datereceived is null)) - "; - } +=over 4 - # warn "C4::Acquisition getsupplierlistwithlateorders : ".$strsth; - my $sth = $dbh->prepare($strsth); - $sth->execute; - my %supplierlist; - while ( my ( $id, $name ) = $sth->fetchrow ) { - $supplierlist{$id} = $name; - } - return %supplierlist; -} +@results = &GetLateOrders; -=item getlateorders +Searches for suppliers with late orders. - %results = &getlateorders; +return: +the table of supplier with late issues. This table is full of hashref. -Searches for suppliers with late orders. +=back =cut -#' -sub getlateorders { +sub GetLateOrders { my $delay = shift; my $supplierid = shift; my $branch = shift; @@ -802,22 +958,35 @@ sub getlateorders { my $strsth; my $dbdriver = C4::Context->config("db_scheme") || "mysql"; - # warn " $dbdriver"; + # warn " $dbdriver"; if ( $dbdriver eq "mysql" ) { - $strsth = "SELECT aqbasket.basketno, - DATE(aqbasket.closedate) as orderdate, aqorders.quantity - IFNULL(aqorders.quantityreceived,0) as quantity, aqorders.rrp as unitpricesupplier,aqorders.ecost as unitpricelib, - (aqorders.quantity - IFNULL(aqorders.quantityreceived,0)) * aqorders.rrp as subtotal, aqbookfund.bookfundname as budget, borrowers.branchcode as branch, - aqbooksellers.name as supplier, - aqorders.title, biblio.author, biblioitems.publishercode as publisher, biblioitems.publicationyear, - DATEDIFF(CURDATE( ),closedate) AS latesince - FROM - (( ( - (aqorders LEFT JOIN biblio on biblio.biblionumber = aqorders.biblionumber) LEFT JOIN biblioitems on biblioitems.biblionumber=biblio.biblionumber - ) LEFT JOIN aqorderbreakdown on aqorders.ordernumber = aqorderbreakdown.ordernumber - ) LEFT JOIN aqbookfund on aqorderbreakdown.bookfundid = aqbookfund.bookfundid - ),(aqbasket LEFT JOIN borrowers on aqbasket.authorisedby = borrowers.borrowernumber) LEFT JOIN aqbooksellers ON aqbasket.booksellerid = aqbooksellers.id - WHERE aqorders.basketno = aqbasket.basketno AND (closedate < DATE_SUB(CURDATE( ),INTERVAL $delay DAY)) - AND ((datereceived = '' OR datereceived is null) OR (aqorders.quantityreceived < aqorders.quantity) ) "; + $strsth = " + SELECT aqbasket.basketno, + DATE(aqbasket.closedate) AS orderdate, + aqorders.quantity - IFNULL(aqorders.quantityreceived,0) AS quantity, + aqorders.rrp AS unitpricesupplier, + aqorders.ecost AS unitpricelib, + (aqorders.quantity - IFNULL(aqorders.quantityreceived,0)) * aqorders.rrp AS subtotal, + aqbookfund.bookfundname AS budget, + borrowers.branchcode AS branch, + aqbooksellers.name AS supplier, + aqorders.title, + biblio.author, + biblioitems.publishercode AS publisher, + biblioitems.publicationyear, + DATEDIFF(CURDATE( ),closedate) AS latesince + FROM ((( + (aqorders LEFT JOIN biblio ON biblio.biblionumber = aqorders.biblionumber) + LEFT JOIN biblioitems ON biblioitems.biblionumber=biblio.biblionumber) + LEFT JOIN aqorderbreakdown ON aqorders.ordernumber = aqorderbreakdown.ordernumber) + LEFT JOIN aqbookfund ON aqorderbreakdown.bookfundid = aqbookfund.bookfundid), + (aqbasket LEFT JOIN borrowers ON aqbasket.authorisedby = borrowers.borrowernumber) + LEFT JOIN aqbooksellers ON aqbasket.booksellerid = aqbooksellers.id + WHERE aqorders.basketno = aqbasket.basketno + AND (closedate < DATE_SUB(CURDATE( ),INTERVAL $delay DAY)) + AND ((datereceived = '' OR datereceived is null) + OR (aqorders.quantityreceived < aqorders.quantity) ) + "; $strsth .= " AND aqbasket.booksellerid = $supplierid " if ($supplierid); $strsth .= " AND borrowers.branchcode like \'" . $branch . "\'" if ($branch); @@ -827,37 +996,44 @@ sub getlateorders { if ( C4::Context->preference("IndependantBranches") && C4::Context->userenv && C4::Context->userenv->{flags} != 1 ); - $strsth .= -" HAVING quantity<>0 AND unitpricesupplier<>0 AND unitpricelib<>0 ORDER BY latesince,basketno,borrowers.branchcode, supplier "; + $strsth .=" HAVING quantity<>0 + AND unitpricesupplier<>0 + AND unitpricelib<>0 + ORDER BY latesince,basketno,borrowers.branchcode, supplier + "; } else { - $strsth = "SELECT aqbasket.basketno, - DATE(aqbasket.closedate) as orderdate, - aqorders.quantity, aqorders.rrp as unitpricesupplier,aqorders.ecost as unitpricelib, aqorders.quantity * aqorders.rrp as subtotal - aqbookfund.bookfundname as budget, borrowers.branchcode as branch, - aqbooksellers.name as supplier, - biblio.title, biblio.author, biblioitems.publishercode as publisher, biblioitems.publicationyear, - (CURDATE - closedate) AS latesince - FROM - (( ( - (aqorders LEFT JOIN biblio on biblio.biblionumber = aqorders.biblionumber) LEFT JOIN biblioitems on biblioitems.biblionumber=biblio.biblionumber - ) LEFT JOIN aqorderbreakdown on aqorders.ordernumber = aqorderbreakdown.ordernumber - ) LEFT JOIN aqbookfund on aqorderbreakdown.bookfundid = aqbookfund.bookfundid - ),(aqbasket LEFT JOIN borrowers on aqbasket.authorisedby = borrowers.borrowernumber) LEFT JOIN aqbooksellers ON aqbasket.booksellerid = aqbooksellers.id - WHERE aqorders.basketno = aqbasket.basketno AND (closedate < (CURDATE -(INTERVAL $delay DAY)) - AND ((datereceived = '' OR datereceived is null) OR (aqorders.quantityreceived < aqorders.quantity) ) "; + $strsth = " + SELECT aqbasket.basketno, + DATE(aqbasket.closedate) AS orderdate, + aqorders.quantity, aqorders.rrp AS unitpricesupplier, + aqorders.ecost as unitpricelib, + aqorders.quantity * aqorders.rrp AS subtotal + aqbookfund.bookfundname AS budget, + borrowers.branchcode AS branch, + aqbooksellers.name AS supplier, + biblio.title, + biblio.author, + biblioitems.publishercode AS publisher, + biblioitems.publicationyear, + (CURDATE - closedate) AS latesince + FROM(( ( + (aqorders LEFT JOIN biblio on biblio.biblionumber = aqorders.biblionumber) + LEFT JOIN biblioitems on biblioitems.biblionumber=biblio.biblionumber) + LEFT JOIN aqorderbreakdown on aqorders.ordernumber = aqorderbreakdown.ordernumber) + LEFT JOIN aqbookfund ON aqorderbreakdown.bookfundid = aqbookfund.bookfundid), + (aqbasket LEFT JOIN borrowers on aqbasket.authorisedby = borrowers.borrowernumber) LEFT JOIN aqbooksellers ON aqbasket.booksellerid = aqbooksellers.id + WHERE aqorders.basketno = aqbasket.basketno + AND (closedate < (CURDATE -(INTERVAL $delay DAY)) + AND ((datereceived = '' OR datereceived is null) + OR (aqorders.quantityreceived < aqorders.quantity) ) "; $strsth .= " AND aqbasket.booksellerid = $supplierid " if ($supplierid); - $strsth .= " AND borrowers.branchcode like \'" . $branch . "\'" - if ($branch); - $strsth .= - " AND borrowers.branchcode like \'" - . C4::Context->userenv->{branch} . "\'" - if ( C4::Context->preference("IndependantBranches") - && C4::Context->userenv->{flags} != 1 ); - $strsth .= - " ORDER BY latesince,basketno,borrowers.branchcode, supplier"; + + $strsth .= " AND borrowers.branchcode like \'" . $branch . "\'" if ($branch); + $strsth .=" AND borrowers.branchcode like \'". C4::Context->userenv->{branch} . "\'" + if (C4::Context->preference("IndependantBranches") && C4::Context->userenv->{flags} != 1 ); + $strsth .=" ORDER BY latesince,basketno,borrowers.branchcode, supplier"; } - warn "C4::Acquisition : getlateorders SQL:" . $strsth; my $sth = $dbh->prepare($strsth); $sth->execute; my @results; @@ -869,179 +1045,82 @@ sub getlateorders { $hilighted = -$hilighted; } $sth->finish; - return ( scalar(@results), @results ); + return @results; } -# FIXME - Never used -sub getrecorders { +#------------------------------------------------------------# - #gets all orders from a certain supplier, orders them alphabetically - my ($supid) = @_; - my $dbh = C4::Context->dbh; - my @results = (); - my $sth = $dbh->prepare( - "Select * from aqorders,biblio,biblioitems where booksellerid=? - and (cancelledby is NULL or cancelledby = '') - and biblio.biblionumber=aqorders.biblionumber and biblioitems.biblioitemnumber= - aqorders.biblioitemnumber and - aqorders.quantityreceived>0 - and aqorders.datereceived >=now() - group by aqorders.biblioitemnumber - order by - biblio.title" - ); - $sth->execute($supid); - while ( my $data = $sth->fetchrow_hashref ) { - push( @results, $data ); - } - $sth->finish; - return ( scalar(@results), @results ); -} +=head3 GetHistory -=item ordersearch +=over 4 - ($count, @results) = &ordersearch($search, $biblionumber, $complete); +(\@order_loop, $total_qty, $total_price, $total_qtyreceived)=&GetHistory( $title, $author, $name, $from_placed_on, $to_placed_on ) -Searches for orders. +this function get the search history. -C<$search> may take one of several forms: if it is an ISBN, -C<&ordersearch> returns orders with that ISBN. If C<$search> is an -order number, C<&ordersearch> returns orders with that order number -and biblionumber C<$biblionumber>. Otherwise, C<$search> is considered -to be a space-separated list of search terms; in this case, all of the -terms must appear in the title (matching the beginning of title -words). +=back -If C<$complete> is C, the results will include only completed -orders. In any case, C<&ordersearch> ignores cancelled orders. +=cut -C<&ordersearch> returns an array. C<$count> is the number of elements -in C<@results>. C<@results> is an array of references-to-hash with the -following keys: +sub GetHistory { + my ( $title, $author, $name, $from_placed_on, $to_placed_on ) = @_; + my @order_loop; + my $total_qty = 0; + my $total_qtyreceived = 0; + my $total_price = 0; -=over 4 +# don't run the query if there are no parameters (list would be too long for sure !) + if ( $title || $author || $name || $from_placed_on || $to_placed_on ) { + my $dbh = C4::Context->dbh; + my $query =" + SELECT + biblio.title, + biblio.author, + aqorders.basketno, + name,aqbasket.creationdate, + aqorders.datereceived, + aqorders.quantity, + aqorders.quantityreceived, + aqorders.ecost, + aqorders.ordernumber + FROM aqorders,aqbasket,aqbooksellers,biblio"; -=item C + $query .= ",borrowers " + if ( C4::Context->preference("IndependantBranches") ); -=item C + $query .=" + WHERE aqorders.basketno=aqbasket.basketno + AND aqbasket.booksellerid=aqbooksellers.id + AND biblio.biblionumber=aqorders.biblionumber "; -=item C + $query .= " AND aqbasket.authorisedby=borrowers.borrowernumber" + if ( C4::Context->preference("IndependantBranches") ); -=item C + $query .= " AND biblio.title LIKE " . $dbh->quote( "%" . $title . "%" ) + if $title; -=back - -=cut - -#' -sub ordersearch { - my ( $search, $id, $biblio, $catview ) = @_; - my $dbh = C4::Context->dbh; - my @data = split( ' ', $search ); - my @searchterms; - if ($id) { - @searchterms = ($id); - } - map { push( @searchterms, "$_%", "% $_%" ) } @data; - push( @searchterms, $search, $search, $biblio ); - my $query; - if ($id) { - $query = - "SELECT *,biblio.title FROM aqorders,biblioitems,biblio,aqbasket - WHERE aqorders.biblioitemnumber = biblioitems.biblioitemnumber AND - aqorders.basketno = aqbasket.basketno - AND aqbasket.booksellerid = ? - AND biblio.biblionumber=aqorders.biblionumber - AND ((datecancellationprinted is NULL) - OR (datecancellationprinted = '0000-00-00')) - AND ((" - . ( - join( " AND ", - map { "(biblio.title like ? or biblio.title like ?)" } @data ) - ) - . ") OR biblioitems.isbn=? OR (aqorders.ordernumber=? AND aqorders.biblionumber=?)) "; - - } - else { - $query = - "SELECT *,biblio.title FROM aqorders,biblioitems,biblio,aqbasket - WHERE aqorders.biblioitemnumber = biblioitems.biblioitemnumber AND - aqorders.basketno = aqbasket.basketno - AND biblio.biblionumber=aqorders.biblionumber - AND ((datecancellationprinted is NULL) - OR (datecancellationprinted = '0000-00-00')) - AND (aqorders.quantityreceived < aqorders.quantity OR aqorders.quantityreceived is NULL) - AND ((" - . ( - join( " AND ", - map { "(biblio.title like ? OR biblio.title like ?)" } @data ) - ) - . ") or biblioitems.isbn=? OR (aqorders.ordernumber=? AND aqorders.biblionumber=?)) "; - } - $query .= " GROUP BY aqorders.ordernumber"; - my $sth = $dbh->prepare($query); - $sth->execute(@searchterms); - my @results = (); - my $sth2 = $dbh->prepare("SELECT * FROM biblio WHERE biblionumber=?"); - my $sth3 = - $dbh->prepare("SELECT * FROM aqorderbreakdown WHERE ordernumber=?"); - while ( my $data = $sth->fetchrow_hashref ) { - $sth2->execute( $data->{'biblionumber'} ); - my $data2 = $sth2->fetchrow_hashref; - $data->{'author'} = $data2->{'author'}; - $data->{'seriestitle'} = $data2->{'seriestitle'}; - $sth3->execute( $data->{'ordernumber'} ); - my $data3 = $sth3->fetchrow_hashref; - $data->{'branchcode'} = $data3->{'branchcode'}; - $data->{'bookfundid'} = $data3->{'bookfundid'}; - push( @results, $data ); - } - $sth->finish; - $sth2->finish; - $sth3->finish; - return ( scalar(@results), @results ); -} - -sub histsearch { - my ( $title, $author, $name, $from_placed_on, $to_placed_on ) = @_; - my @order_loop; - my $total_qty = 0; - my $total_qtyreceived = 0; - my $total_price = 0; - -# don't run the query if there are no parameters (list would be too long for sure ! - if ( $title || $author || $name || $from_placed_on || $to_placed_on ) { - my $dbh = C4::Context->dbh; - my $query = -"select biblio.title,biblio.author,aqorders.basketno,name,aqbasket.creationdate,aqorders.datereceived, aqorders.quantity, aqorders.quantityreceived, aqorders.ecost, aqorders.ordernumber from aqorders,aqbasket,aqbooksellers,biblio"; - $query .= ",borrowers " - if ( C4::Context->preference("IndependantBranches") ); - $query .= -" where aqorders.basketno=aqbasket.basketno and aqbasket.booksellerid=aqbooksellers.id and biblio.biblionumber=aqorders.biblionumber "; - $query .= " and aqbasket.authorisedby=borrowers.borrowernumber" - if ( C4::Context->preference("IndependantBranches") ); - $query .= " and biblio.title like " . $dbh->quote( "%" . $title . "%" ) - if $title; $query .= - " and biblio.author like " . $dbh->quote( "%" . $author . "%" ) + " AND biblio.author LIKE " . $dbh->quote( "%" . $author . "%" ) if $author; - $query .= " and name like " . $dbh->quote( "%" . $name . "%" ) if $name; - $query .= " and creationdate >" . $dbh->quote($from_placed_on) + + $query .= " AND name LIKE " . $dbh->quote( "%" . $name . "%" ) if $name; + + $query .= " AND creationdate >" . $dbh->quote($from_placed_on) if $from_placed_on; - $query .= " and creationdate<" . $dbh->quote($to_placed_on) + + $query .= " AND creationdate<" . $dbh->quote($to_placed_on) if $to_placed_on; if ( C4::Context->preference("IndependantBranches") ) { my $userenv = C4::Context->userenv; if ( ($userenv) && ( $userenv->{flags} != 1 ) ) { $query .= - " and (borrowers.branchcode = '" + " AND (borrowers.branchcode = '" . $userenv->{branch} - . "' or borrowers.branchcode ='')"; + . "' OR borrowers.branchcode ='')"; } } - $query .= " order by booksellerid"; - warn "query histearch: " . $query; + $query .= " ORDER BY booksellerid"; my $sth = $dbh->prepare($query); $sth->execute; my $cnt = 1; @@ -1059,510 +1138,10 @@ sub histsearch { return \@order_loop, $total_qty, $total_price, $total_qtyreceived; } -# -# -# MONEY -# -# - -=item invoice - - ($count, @results) = &invoice($booksellerinvoicenumber); - -Looks up orders by invoice number. - -Returns an array. C<$count> is the number of elements in C<@results>. -C<@results> is an array of references-to-hash; the keys of each -elements are fields from the aqorders, biblio, and biblioitems tables -of the Koha database. - -=cut - -#' -sub invoice { - my ($invoice) = @_; - my $dbh = C4::Context->dbh; - my @results = (); - my $sth = $dbh->prepare( - "Select * from aqorders,biblio,biblioitems where - booksellerinvoicenumber=? - and biblio.biblionumber=aqorders.biblionumber and biblioitems.biblioitemnumber= - aqorders.biblioitemnumber group by aqorders.ordernumber,aqorders.biblioitemnumber" - ); - $sth->execute($invoice); - while ( my $data = $sth->fetchrow_hashref ) { - push( @results, $data ); - } - $sth->finish; - return ( scalar(@results), @results ); -} - -=item bookfunds - - ($count, @results) = &bookfunds(); - -Returns a list of all book funds. - -C<$count> is the number of elements in C<@results>. C<@results> is an -array of references-to-hash, whose keys are fields from the aqbookfund -and aqbudget tables of the Koha database. Results are ordered -alphabetically by book fund name. - -=cut - -#' -sub bookfunds { - my ($branch) = @_; - my $dbh = C4::Context->dbh; - my $userenv = C4::Context->userenv; - my $branch = $userenv->{branch}; - my $strsth; - - if ( $branch ne '' ) { - $strsth = "SELECT * FROM aqbookfund,aqbudget WHERE aqbookfund.bookfundid - =aqbudget.bookfundid AND startdatenow() AND (aqbookfund.branchcode is null or aqbookfund.branchcode='' or aqbookfund.branchcode= ? ) - GROUP BY aqbookfund.bookfundid ORDER BY bookfundname"; - } - else { - $strsth = "SELECT * FROM aqbookfund,aqbudget WHERE aqbookfund.bookfundid - =aqbudget.bookfundid AND startdatenow() - GROUP BY aqbookfund.bookfundid ORDER BY bookfundname"; - } - my $sth = $dbh->prepare($strsth); - if ( $branch ne '' ) { - $sth->execute($branch); - } - else { - $sth->execute; - } - my @results = (); - while ( my $data = $sth->fetchrow_hashref ) { - push( @results, $data ); - } - $sth->finish; - return ( scalar(@results), @results ); -} - -=item bookfundbreakdown - - returns the total comtd & spent for a given bookfund, and a given year - used in acqui-home.pl -=cut - -#' - -sub bookfundbreakdown { - my ( $id, $year, $start, $end ) = @_; - my $dbh = C4::Context->dbh; - - # if no start/end dates given defaut to everything - if ( !$start ) { - $start = '0000-00-00'; - $end = 'now()'; - } - - # do a query for spent totals. - my $sth = $dbh->prepare( - "Select quantity,datereceived,freight,unitprice,listprice,ecost, - quantityreceived,subscription - from aqorders left join aqorderbreakdown on - aqorders.ordernumber=aqorderbreakdown.ordernumber - where bookfundid=? and (datecancellationprinted is NULL or - datecancellationprinted='0000-00-00') and - ((datereceived >= ? and datereceived < ?) or - (budgetdate >= ? and budgetdate < ?))" - ); - $sth->execute( $id, $start, $end, $start, $end ); - - my $spent = 0; - while ( my $data = $sth->fetchrow_hashref ) { - if ( $data->{'subscription'} == 1 ) { - $spent += $data->{'quantity'} * $data->{'unitprice'}; - } - else { - - my $leftover = $data->{'quantity'} - $data->{'quantityreceived'}; - $spent += ( $data->{'unitprice'} ) * $data->{'quantityreceived'}; - - } - } - - # then do a seperate query for commited totals, (pervious single query was - # returning incorrect comitted results. - - my $query = "Select quantity,datereceived,freight,unitprice, - listprice,ecost,quantityreceived as qrev, - subscription,title,itemtype,aqorders.biblionumber, - aqorders.booksellerinvoicenumber, - quantity-quantityreceived as tleft, - aqorders.ordernumber as ordnum,entrydate,budgetdate, - booksellerid,aqbasket.basketno - from aqorderbreakdown,aqbasket,aqorders - left join biblioitems on - biblioitems.biblioitemnumber=aqorders.biblioitemnumber - where bookfundid=? and aqorders.ordernumber=aqorderbreakdown.ordernumber and - aqorders.basketno=aqbasket.basketno and - (budgetdate >= ? and budgetdate < ?) and - (datecancellationprinted is NULL or datecancellationprinted='0000-00-00')"; - #warn $query; - my $sth = $dbh->prepare($query); - $sth->execute( $id, $start, $end ); - - my $comtd; - - my $total = 0; - while ( my $data = $sth->fetchrow_hashref ) { - my $left = $data->{'tleft'}; - if ( !$left || $left eq '' ) { - $left = $data->{'quantity'}; - } - if ( $left && $left > 0 ) { - my $subtotal = $left * $data->{'ecost'}; - $data->{subtotal} = $subtotal; - $data->{'left'} = $left; - $comtd += $subtotal; - } - } - - #warn " spent=$spent, comtd=$comtd\n"; - $sth->finish; - return ( $spent, $comtd ); -} - - -=item curconvert - - $foreignprice = &curconvert($currency, $localprice); - -Converts the price C<$localprice> to foreign currency C<$currency> by -dividing by the exchange rate, and returns the result. - -If no exchange rate is found, C<&curconvert> assumes the rate is one -to one. - -=cut - -#' -sub curconvert { - my ( $currency, $price ) = @_; - my $dbh = C4::Context->dbh; - my $sth = $dbh->prepare("Select rate from currency where currency=?"); - $sth->execute($currency); - my $cur = ( $sth->fetchrow_array() )[0]; - $sth->finish; - if ( $cur == 0 ) { - $cur = 1; - } - return ( $price / $cur ); -} - -=item getcurrencies - - ($count, $currencies) = &getcurrencies(); - -Returns the list of all known currencies. - -C<$count> is the number of elements in C<$currencies>. C<$currencies> -is a reference-to-array; its elements are references-to-hash, whose -keys are the fields from the currency table in the Koha database. - -=cut - -#' -sub getcurrencies { - my $dbh = C4::Context->dbh; - my $sth = $dbh->prepare("Select * from currency"); - $sth->execute; - my @results = (); - while ( my $data = $sth->fetchrow_hashref ) { - push( @results, $data ); - } - $sth->finish; - return ( scalar(@results), \@results ); -} - -=item updatecurrencies - - &updatecurrencies($currency, $newrate); - -Sets the exchange rate for C<$currency> to be C<$newrate>. - -=cut - -#' -sub updatecurrencies { - my ( $currency, $rate ) = @_; - my $dbh = C4::Context->dbh; - my $sth = $dbh->prepare("update currency set rate=? where currency=?"); - $sth->execute( $rate, $currency ); - $sth->finish; -} - -# -# -# OTHERS -# -# - -=item bookseller - - ($count, @results) = &bookseller($searchstring); - -Looks up a book seller. C<$searchstring> may be either a book seller -ID, or a string to look for in the book seller's name. - -C<$count> is the number of elements in C<@results>. C<@results> is an -array of references-to-hash, whose keys are the fields of of the -aqbooksellers table in the Koha database. - -=cut - -#' -sub bookseller { - my ($searchstring) = @_; - my $dbh = C4::Context->dbh; - my $sth = - $dbh->prepare("Select * from aqbooksellers where name like ? or id = ?"); - $sth->execute( "$searchstring%", $searchstring ); - my @results; - while ( my $data = $sth->fetchrow_hashref ) { - push( @results, $data ); - } - $sth->finish; - return ( scalar(@results), @results ); -} - -=item breakdown - - ($count, $results) = &breakdown($ordernumber); - -Looks up an order by order ID, and returns its breakdown. - -C<$count> is the number of elements in C<$results>. C<$results> is a -reference-to-array; its elements are references-to-hash, whose keys -are the fields of the aqorderbreakdown table in the Koha database. - -=cut - -#' -sub breakdown { - my ($id) = @_; - my $dbh = C4::Context->dbh; - my $sth = - $dbh->prepare("Select * from aqorderbreakdown where ordernumber=?"); - $sth->execute($id); - my @results = (); - while ( my $data = $sth->fetchrow_hashref ) { - push( @results, $data ); - } - $sth->finish; - return ( scalar(@results), \@results ); -} - -=item branches - - ($count, @results) = &branches(); - -Returns a list of all library branches. - -C<$count> is the number of elements in C<@results>. C<@results> is an -array of references-to-hash, whose keys are the fields of the branches -table of the Koha database. - -=cut - -#' -sub branches { - my $dbh = C4::Context->dbh; - my $sth; - if ( C4::Context->preference("IndependantBranches") - && ( C4::Context->userenv ) - && ( C4::Context->userenv->{flags} != 1 ) ) - { - my $strsth = "Select * from branches "; - $strsth .= - " WHERE branchcode = " - . $dbh->quote( C4::Context->userenv->{branch} ); - $strsth .= " order by branchname"; - warn "C4::Acquisition->branches : " . $strsth; - $sth = $dbh->prepare($strsth); - } - else { - $sth = $dbh->prepare("Select * from branches order by branchname"); - } - my @results = (); - - $sth->execute(); - while ( my $data = $sth->fetchrow_hashref ) { - push( @results, $data ); - } # while - - $sth->finish; - return ( scalar(@results), @results ); -} # sub branches - -=item updatesup - - &updatesup($bookseller); - -Updates the information for a given bookseller. C<$bookseller> is a -reference-to-hash whose keys are the fields of the aqbooksellers table -in the Koha database. It must contain entries for all of the fields. -The entry to modify is determined by C<$bookseller-E{id}>. - -The easiest way to get all of the necessary fields is to look up a -book seller with C<&booksellers>, modify what's necessary, then call -C<&updatesup> with the result. - -=cut - -#' -sub updatesup { - my ($data) = @_; - my $dbh = C4::Context->dbh; - my $sth = $dbh->prepare( - "Update aqbooksellers set - name=?,address1=?,address2=?,address3=?,address4=?,postal=?, - phone=?,fax=?,url=?,contact=?,contpos=?,contphone=?,contfax=?,contaltphone=?, - contemail=?,contnotes=?,active=?, - listprice=?, invoiceprice=?,gstreg=?, listincgst=?, - invoiceincgst=?, specialty=?,discount=?,invoicedisc=?, - nocalc=?, notes=? - where id=?" - ); - $sth->execute( - $data->{'name'}, $data->{'address1'}, - $data->{'address2'}, $data->{'address3'}, - $data->{'address4'}, $data->{'postal'}, - $data->{'phone'}, $data->{'fax'}, - $data->{'url'}, $data->{'contact'}, - $data->{'contpos'}, $data->{'contphone'}, - $data->{'contfax'}, $data->{'contaltphone'}, - $data->{'contemail'}, $data->{'contnotes'}, - $data->{'active'}, $data->{'listprice'}, - $data->{'invoiceprice'}, $data->{'gstreg'}, - $data->{'listincgst'}, $data->{'invoiceincgst'}, - $data->{'specialty'}, $data->{'discount'}, - $data->{'invoicedisc'}, $data->{'nocalc'}, - $data->{'notes'}, $data->{'id'} - ); - $sth->finish; -} - -=item insertsup - - $id = &insertsup($bookseller); - -Creates a new bookseller. C<$bookseller> is a reference-to-hash whose -keys are the fields of the aqbooksellers table in the Koha database. -All fields must be present. - -Returns the ID of the newly-created bookseller. - -=cut - -#' -sub insertsup { - my ($data) = @_; - my $dbh = C4::Context->dbh; - my $sth = $dbh->prepare("Select max(id) from aqbooksellers"); - $sth->execute; - my $data2 = $sth->fetchrow_hashref; - $sth->finish; - $data2->{'max(id)'}++; - $sth = $dbh->prepare("Insert into aqbooksellers (id) values (?)"); - $sth->execute( $data2->{'max(id)'} ); - $sth->finish; - $data->{'id'} = $data2->{'max(id)'}; - updatesup($data); - return ( $data->{'id'} ); -} - -=item getparcels - - ($count, $results) = &getparcels($dbh, $bookseller, $order, $limit); - -get a lists of parcels -Returns the count of parcels returned and a pointer on a hash list containing parcel informations as such : - Creation date - Last operation - Number of biblio - Number of items - - -=cut - -#' -sub getparcels { - my ( $bookseller, $order, $code, $datefrom, $dateto, $limit ) = @_; - my $dbh = C4::Context->dbh; - 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 "; - $strsth .= "and aqorders.booksellerinvoicenumber like \"$code%\" " - if ($code); - $strsth .= "and datereceived >=" . $dbh->quote($datefrom) . " " - if ($datefrom); - $strsth .= "and datereceived <=" . $dbh->quote($dateto) . " " if ($dateto); - $strsth .= "group by aqorders.booksellerinvoicenumber,datereceived "; - $strsth .= "order by $order " if ($order); - $strsth .= " LIMIT 0,$limit" if ($limit); - my $sth = $dbh->prepare($strsth); -### getparcels: $strsth - $sth->execute; - my @results; - - while ( my $data2 = $sth->fetchrow_hashref ) { - push @results, $data2; - } - - $sth->finish; - return ( scalar(@results), @results ); -} - -=item getparcels - - ($count, $results) = &getparcels($dbh, $bookseller, $order, $limit); - -get a lists of parcels -Returns the count of parcels returned and a pointer on a hash list containing parcel informations as such : - Creation date - Last operation - Number of biblio - Number of items - - -=cut - -#' -sub getparcels { - my ( $bookseller, $order, $code, $datefrom, $dateto, $limit ) = @_; - my $dbh = C4::Context->dbh; - 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 "; - $strsth .= "and aqorders.booksellerinvoicenumber like \"$code%\" " - if ($code); - $strsth .= "and datereceived >=" . $dbh->quote($datefrom) . " " - if ($datefrom); - $strsth .= "and datereceived <=" . $dbh->quote($dateto) . " " if ($dateto); - $strsth .= "group by aqorders.booksellerinvoicenumber,datereceived "; - $strsth .= "order by $order " if ($order); - $strsth .= " LIMIT 0,$limit" if ($limit); - my $sth = $dbh->prepare($strsth); -### getparcels: $strsth - $sth->execute; - my @results; - - while ( my $data2 = $sth->fetchrow_hashref ) { - push @results, $data2; - } - - $sth->finish; - return ( scalar(@results), @results ); -} - END { } # module clean-up code here (global destructor) 1; + __END__ =back diff --git a/C4/Bookfund.pm b/C4/Bookfund.pm new file mode 100755 index 0000000000..ba4b322788 --- /dev/null +++ b/C4/Bookfund.pm @@ -0,0 +1,424 @@ +package C4::Bookfund; + +# Copyright 2000-2002 Katipo Communications +# +# This file is part of Koha. +# +# Koha is free software; you can redistribute it and/or modify it under the +# terms of the GNU General Public License as published by the Free Software +# Foundation; either version 2 of the License, or (at your option) any later +# version. +# +# Koha is distributed in the hope that it will be useful, but WITHOUT ANY +# WARRANTY; without even the implied warranty of MERCHANTABILITY or FITNESS FOR +# A PARTICULAR PURPOSE. See the GNU General Public License for more details. +# +# You should have received a copy of the GNU General Public License along with +# Koha; if not, write to the Free Software Foundation, Inc., 59 Temple Place, +# Suite 330, Boston, MA 02111-1307 USA + +# $Id$ + + +use strict; + + +use vars qw($VERSION @ISA @EXPORT); + +# set the version for version checking +$VERSION = do { my @v = '$Revision$' =~ /\d+/g; shift(@v) . "." . join( "_", map { sprintf "%03d", $_ } @v ); }; + +=head1 NAME + +C4::Bookfund - Koha functions for dealing with bookfund, currency & money. + +=head1 SYNOPSIS + +use C4::Bookfund; + +=head1 DESCRIPTION + +the functions in this modules deal with bookfund, currency and money. +They allow to get and/or set some informations for a specific budget or currency. + +=cut + +@ISA = qw(Exporter); +@EXPORT = qw( + &GetBookFund &GetBookFunds &GetBookFundBreakdown &GetCurrencies + &ModBookFund &ModCurrencies + &Countbookfund + &ConvertCurrency +); + +=head1 FUNCTIONS + +=over 2 + +=cut + +#-------------------------------------------------------------# + +=head3 GetBookFund + +=over 4 + +$dataaqbookfund = &GetBookFund($bookfundid); + +this function get the bookfundid, bookfundname, the bookfundgroup, the branchcode +from aqbookfund table for bookfundid given on input arg. +return: +C<$dataaqbookfund> is a hashref full of bookfundid, bookfundname, bookfundgroup, +and branchcode. + +=back + +=cut + +sub GetBookFund { + my $bookfundid = @_; + my $dbh = C4::Context->dbh; + my $query = " + SELECT + bookfundid, + bookfundname, + bookfundgroup, + branchcode + FROM aqbookfund + WHERE bookfundid = ? + "; + my $sth=$dbh->prepare($query); + return $sth->fetchrow_hashref; +} + +#-------------------------------------------------------------# + +=head3 GetBookFunds + +=over 4 + +@results = &GetBookFunds; + +Returns a list of all book funds. + +C<@results> is an array of references-to-hash, whose keys are fields from the aqbookfund and aqbudget tables of the Koha database. Results are ordered +alphabetically by book fund name. + +=back + +=cut + +sub GetBookFunds { + my ($branch) = @_; + my $dbh = C4::Context->dbh; + my $userenv = C4::Context->userenv; + my $branch = $userenv->{branch}; + my $strsth; + + if ( $branch ne '' ) { + $strsth = " + SELECT * + FROM aqbookfund,aqbudget + WHERE aqbookfund.bookfundid=aqbudget.bookfundid + AND startdatenow() + AND (aqbookfund.branchcode IS NULL OR aqbookfund.branchcode='' OR aqbookfund.branchcode= ? ) + GROUP BY aqbookfund.bookfundid ORDER BY bookfundname"; + } + else { + $strsth = " + SELECT * + FROM aqbookfund, + aqbudget + WHERE aqbookfund.bookfundid=aqbudget.bookfundid + AND startdatenow() + GROUP BY aqbookfund.bookfundid ORDER BY bookfundname + "; + } + my $sth = $dbh->prepare($strsth); + if ( $branch ne '' ) { + $sth->execute($branch); + } + else { + $sth->execute; + } + my @results = (); + while ( my $data = $sth->fetchrow_hashref ) { + push( @results, $data ); + } + $sth->finish; + return @results; +} + +#-------------------------------------------------------------# + +=head3 GetCurrencies + +=over 4 + +@currencies = &GetCurrencies; + +Returns the list of all known currencies. + +C<$currencies> is a array; its elements are references-to-hash, whose +keys are the fields from the currency table in the Koha database. + +=back + +=cut + +sub GetCurrencies { + my $dbh = C4::Context->dbh; + my $query = " + SELECT * + FROM currency + "; + my $sth = $dbh->prepare($query); + $sth->execute; + my @results = (); + while ( my $data = $sth->fetchrow_hashref ) { + push( @results, $data ); + } + $sth->finish; + return @results; +} + +#-------------------------------------------------------------# + +=head3 GetBookFundBreakdown + +=over 4 + +( $spent, $comtd ) = &GetBookFundBreakdown( $id, $year, $start, $end ); + +returns the total comtd & spent for a given bookfund, and a given year +used in acqui-home.pl + +=back + +=cut + +sub GetBookFundBreakdown { + my ( $id, $year, $start, $end ) = @_; + my $dbh = C4::Context->dbh; + + # if no start/end dates given defaut to everything + if ( !$start ) { + $start = '0000-00-00'; + $end = 'now()'; + } + + # do a query for spent totals. + my $query = " + SELECT quantity,datereceived,freight,unitprice,listprice,ecost, + quantityreceived,subscription + FROM aqorders + LEFT JOIN aqorderbreakdown ON aqorders.ordernumber=aqorderbreakdown.ordernumber + WHERE bookfundid=? + AND (datecancellationprinted IS NULL OR datecancellationprinted='0000-00-00') + AND ((datereceived >= ? and datereceived < ?) OR (budgetdate >= ? and budgetdate < ?)) + "; + my $sth = $dbh->prepare($query); + $sth->execute( $id, $start, $end, $start, $end ); + + my $spent = 0; + while ( my $data = $sth->fetchrow_hashref ) { + if ( $data->{'subscription'} == 1 ) { + $spent += $data->{'quantity'} * $data->{'unitprice'}; + } + else { + + my $leftover = $data->{'quantity'} - $data->{'quantityreceived'}; + $spent += ( $data->{'unitprice'} ) * $data->{'quantityreceived'}; + + } + } + + # then do a seperate query for commited totals, (pervious single query was + # returning incorrect comitted results. + + my $query = " + SELECT quantity,datereceived,freight,unitprice, + listprice,ecost,quantityreceived AS qrev, + subscription,title,itemtype,aqorders.biblionumber, + aqorders.booksellerinvoicenumber, + quantity-quantityreceived AS tleft, + aqorders.ordernumber AS ordnum,entrydate,budgetdate, + booksellerid,aqbasket.basketno + FROM aqorderbreakdown, + aqbasket, + aqorders + LEFT JOIN biblioitems ON biblioitems.biblioitemnumber=aqorders.biblioitemnumber + WHERE bookfundid=? + AND aqorders.ordernumber=aqorderbreakdown.ordernumber + AND aqorders.basketno=aqbasket.basketno + AND (budgetdate >= ? AND budgetdate < ?) + AND (datecancellationprinted IS NULL OR datecancellationprinted='0000-00-00') + "; + + my $sth = $dbh->prepare($query); + $sth->execute( $id, $start, $end ); + + my $comtd; + + my $total = 0; + while ( my $data = $sth->fetchrow_hashref ) { + my $left = $data->{'tleft'}; + if ( !$left || $left eq '' ) { + $left = $data->{'quantity'}; + } + if ( $left && $left > 0 ) { + my $subtotal = $left * $data->{'ecost'}; + $data->{subtotal} = $subtotal; + $data->{'left'} = $left; + $comtd += $subtotal; + } + } + + $sth->finish; + return ( $spent, $comtd ); +} + +#-------------------------------------------------------------# + +=head3 ModBookFund + +=over 4 + +&ModBookFund($bookfundname,$branchcode,$bookfundid); +this function update the bookfundname and the branchcode on aqbookfund table +on database. + +=back + +=cut + +sub ModBookFund { + my ($bookfundname,$branchcode,$bookfundid) = @_; + my $dbh = C4::Context->dbh; + my $query = " + UPDATE aqbookfund + SET bookfundname = ?, + branchcode = ? + WHERE bookfundid = ? + "; + my $sth=$dbh->prepare($query); + $sth->execute($bookfundname,$branchcode,$bookfundid); +# budgets depending on a bookfund must have the same branchcode +# if the bookfund branchcode is set + if (defined $branchcode) { + $query = " + UPDATE aqbudget + SET branchcode = ? + "; + $sth=$dbh->prepare($query); + $sth->execute($branchcode); + } +} + +#-------------------------------------------------------------# + +=head3 ModCurrencies + +=over 4 + +&ModCurrencies($currency, $newrate); + +Sets the exchange rate for C<$currency> to be C<$newrate>. + +=back + +=cut + +sub ModCurrencies { + my ( $currency, $rate ) = @_; + my $dbh = C4::Context->dbh; + my $query = " + UPDATE currency + SET rate=? + WHERE currency=? + "; + my $sth = $dbh->prepare($query); + $sth->execute( $rate, $currency ); +} + +#-------------------------------------------------------------# + +=head3 Countbookfund + +=over 4 + +$data = Countbookfund($bookfundid); + +this function count the number of bookfund with id given on input arg. +return : +the result of the SQL query as an hashref. + +=back + +=cut + +sub Countbookfund { + my $bookfundid = @_; + my $dbh = C4::Context->dbh; + my $query =" + SELECT COUNT(*) + FROM aqbookfund + WHERE bookfundid = ? + "; + my $sth = $dbh->prepare($query); + $sth->execute($bookfundid); + return $sth->fetchrow_hashref; +} + + +#-------------------------------------------------------------# + +=head3 ConvertCurrency + +=over 4 + +$foreignprice = &ConvertCurrency($currency, $localprice); + +Converts the price C<$localprice> to foreign currency C<$currency> by +dividing by the exchange rate, and returns the result. + +If no exchange rate is found, C<&ConvertCurrency> assumes the rate is one +to one. + +=back + +=cut + +sub ConvertCurrency { + my ( $currency, $price ) = @_; + my $dbh = C4::Context->dbh; + my $query = " + SELECT rate + FROM currency + WHERE currency=? + "; + my $sth = $dbh->prepare($query); + $sth->execute($currency); + my $cur = ( $sth->fetchrow_array() )[0]; + if ( $cur == 0 ) { + $cur = 1; + } + return ( $price / $cur ); +} + + +END { } # module clean-up code here (global destructor) + +1; + +__END__ + +=back + +=head1 AUTHOR + +Koha Developement team + +=cut diff --git a/C4/Bookseller.pm b/C4/Bookseller.pm new file mode 100755 index 0000000000..e5893e58f2 --- /dev/null +++ b/C4/Bookseller.pm @@ -0,0 +1,276 @@ +package C4::Bookseller; + +# Copyright 2000-2002 Katipo Communications +# +# This file is part of Koha. +# +# Koha is free software; you can redistribute it and/or modify it under the +# terms of the GNU General Public License as published by the Free Software +# Foundation; either version 2 of the License, or (at your option) any later +# version. +# +# Koha is distributed in the hope that it will be useful, but WITHOUT ANY +# WARRANTY; without even the implied warranty of MERCHANTABILITY or FITNESS FOR +# A PARTICULAR PURPOSE. See the GNU General Public License for more details. +# +# You should have received a copy of the GNU General Public License along with +# Koha; if not, write to the Free Software Foundation, Inc., 59 Temple Place, +# Suite 330, Boston, MA 02111-1307 USA + +# $Id$ + +use strict; + +use vars qw($VERSION @ISA @EXPORT); + +# set the version for version checking +$VERSION = do { my @v = '$Revision$' =~ /\d+/g; shift(@v) . "." . join( "_", map { sprintf "%03d", $_ } @v ); }; + +@ISA = qw(Exporter); +@EXPORT = qw( + &GetBookSeller &GetBooksellersWithLateOrders + &ModBookseller + &AddBookseller +); + + +=head1 NAME + +C4::Bookseller - Koha functions for dealing with booksellers. + +=head1 SYNOPSIS + +use C4::Bookseller; + +=head1 DESCRIPTION + +The functions in this module deal with booksellers. They allow to +add a new bookseller, to modify it or to get some informations around +a bookseller. + +=head1 FUNCTIONS + +=over 2 + +=cut + +#-------------------------------------------------------------------# + +=head3 GetBookSeller + +=over 4 + +@results = &GetBookSeller($searchstring); + +Looks up a book seller. C<$searchstring> may be either a book seller +ID, or a string to look for in the book seller's name. + +C<@results> is an array of references-to-hash, whose keys are the fields of of the +aqbooksellers table in the Koha database. + +=back + +=cut + +sub GetBookSeller { + my ($searchstring) = @_; + my $dbh = C4::Context->dbh; + my $query = " + SELECT * + FROM aqbooksellers + WHERE name LIKE ? OR id = ? + "; + my $sth =$dbh->prepare($query); + $sth->execute("$searchstring%", $searchstring ); + my @results; + while ( my $data = $sth->fetchrow_hashref ) { + push( @results, $data ); + } + $sth->finish; + return @results ; +} + + +#-----------------------------------------------------------------# + +=head3 GetBooksellersWithLateOrders + +=over 4 + +%results = &GetBooksellersWithLateOrders; + +Searches for suppliers with late orders. + +=back + +=cut + +sub GetBooksellersWithLateOrders { + my $delay = shift; + my $dbh = C4::Context->dbh; + +# FIXME NOT quite sure that this operation is valid for DBMs different from Mysql, HOPING so +# should be tested with other DBMs + + my $strsth; + my $dbdriver = C4::Context->config("db_scheme") || "mysql"; + if ( $dbdriver eq "mysql" ) { + $strsth = " + SELECT DISTINCT aqbasket.booksellerid, aqbooksellers.name + FROM aqorders, aqbasket + LEFT JOIN aqbooksellers ON aqbasket.booksellerid = aqbooksellers.id + WHERE aqorders.basketno = aqbasket.basketno + AND (closedate < DATE_SUB(CURDATE( ),INTERVAL $delay DAY) + AND (datereceived = '' OR datereceived IS NULL)) + "; + } + else { + $strsth = " + SELECT DISTINCT aqbasket.booksellerid, aqbooksellers.name + FROM aqorders, aqbasket + LEFT JOIN aqbooksellers ON aqbasket.aqbooksellerid = aqbooksellers.id + WHERE aqorders.basketno = aqbasket.basketno + AND (closedate < (CURDATE( )-(INTERVAL $delay DAY))) + AND (datereceived = '' OR datereceived IS NULL)) + "; + } + + my $sth = $dbh->prepare($strsth); + $sth->execute; + my %supplierlist; + while ( my ( $id, $name ) = $sth->fetchrow ) { + $supplierlist{$id} = $name; + } + + return %supplierlist; +} + +#--------------------------------------------------------------------# + +=head3 AddBookseller + +=over 4 + +$id = &AddBookseller($bookseller); + +Creates a new bookseller. C<$bookseller> is a reference-to-hash whose +keys are the fields of the aqbooksellers table in the Koha database. +All fields must be present. + +Returns the ID of the newly-created bookseller. + +=back + +=cut + +sub AddBookseller { + my ($data) = @_; + my $dbh = C4::Context->dbh; + my $query = " + INSERT INTO aqbooksellers + ( + name, address1, address2, address3, address4, + postal, phone, fax, url, contact, + contpos, contphone, contfax, contaltphone, contemail, + contnotes, active, listprice, invoiceprice, gstreg, + listincgst,invoiceincgst, specialty, discount, invoicedisc, + nocalc, notes + ) + VALUES (?,?,?,?,?,?,?,?,?,?,?,?,?,?,?,?,?,?,?,?,?,?,?,?,?,?,?) + "; + my $sth = $dbh->prepare($query); + $sth->execute( + $data->{'name'}, $data->{'address1'}, + $data->{'address2'}, $data->{'address3'}, + $data->{'address4'}, $data->{'postal'}, + $data->{'phone'}, $data->{'fax'}, + $data->{'url'}, $data->{'contact'}, + $data->{'contpos'}, $data->{'contphone'}, + $data->{'contfax'}, $data->{'contaltphone'}, + $data->{'contemail'}, $data->{'contnotes'}, + $data->{'active'}, $data->{'listprice'}, + $data->{'invoiceprice'}, $data->{'gstreg'}, + $data->{'listincgst'}, $data->{'invoiceincgst'}, + $data->{'specialty'}, $data->{'discount'}, + $data->{'invoicedisc'}, $data->{'nocalc'}, + $data->{'notes'} + ); + + # return the id of this new supplier + my $query = " + SELECT max(id) + FROM aqbooksellers + "; + my $sth = $dbh->prepare($query); + $sth->execute; + return scalar($sth->fetchrow); +} + +#-----------------------------------------------------------------# + +=head3 ModSupplier + +=over 4 + +&ModSupplier($bookseller); + +Updates the information for a given bookseller. C<$bookseller> is a +reference-to-hash whose keys are the fields of the aqbooksellers table +in the Koha database. It must contain entries for all of the fields. +The entry to modify is determined by C<$bookseller-E{id}>. + +The easiest way to get all of the necessary fields is to look up a +book seller with C<&booksellers>, modify what's necessary, then call +C<&ModSupplier> with the result. + +=back + +=cut + +sub ModBookseller { + my ($data) = @_; + my $dbh = C4::Context->dbh; + my $query = " + UPDATE aqbooksellers + SET name=?,address1=?,address2=?,address3=?,address4=?, + postal=?,phone=?,fax=?,url=?,contact=?,contpos=?, + contphone=?,contfax=?,contaltphone=?,contemail=?, + contnotes=?,active=?,listprice=?, invoiceprice=?, + gstreg=?, listincgst=?,invoiceincgst=?, + specialty=?,discount=?,invoicedisc=?,nocalc=?, notes=? + WHERE id=? + "; + my $sth = $dbh->prepare($query); + $sth->execute( + $data->{'name'}, $data->{'address1'}, + $data->{'address2'}, $data->{'address3'}, + $data->{'address4'}, $data->{'postal'}, + $data->{'phone'}, $data->{'fax'}, + $data->{'url'}, $data->{'contact'}, + $data->{'contpos'}, $data->{'contphone'}, + $data->{'contfax'}, $data->{'contaltphone'}, + $data->{'contemail'}, $data->{'contnotes'}, + $data->{'active'}, $data->{'listprice'}, + $data->{'invoiceprice'}, $data->{'gstreg'}, + $data->{'listincgst'}, $data->{'invoiceincgst'}, + $data->{'specialty'}, $data->{'discount'}, + $data->{'invoicedisc'}, $data->{'nocalc'}, + $data->{'notes'}, $data->{'id'} + ); + $sth->finish; +} + + +END { } # module clean-up code here (global destructor) + +1; + +__END__ + +=back + +=head1 AUTHOR + +Koha Developement team + +=cut -- 2.39.2