C4/Acquisition.pm

   1 package C4::Acquisition;
   2
   3 # Copyright 2000-2002 Katipo Communications
   4 #
   5 # This file is part of Koha.
   6 #
   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
  10 # version.
  11 #
  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.
  15 #
  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
  19
  20 use strict;
  21 require Exporter;
  22 use C4::Context;
  23 use MARC::Record;
  24 # use C4::Biblio;
  25
  26 use vars qw($VERSION @ISA @EXPORT);
  27
  28 # set the version for version checking
  29 $VERSION = 0.01;
  30
  31 =head1 NAME
  32
  33 C4::Acquisition - Koha functions for dealing with orders and acquisitions
  34
  35 =head1 SYNOPSIS
  36
  37   use C4::Acquisition;
  38
  39 =head1 DESCRIPTION
  40
  41 The functions in this module deal with acquisitions, managing book
  42 orders, converting money to different currencies, and so forth.
  43
  44 =head1 FUNCTIONS
  45
  46 =over 2
  47
  48 =cut
  49
  50 @ISA = qw(Exporter);
  51 @EXPORT = qw(
  52                 &getbasket &getbasketcontent &newbasket &closebasket
  53
  54                 &getorders &getallorders &getrecorders
  55                 &getorder &neworder &delorder
  56                 &ordersearch &histsearch
  57                 &modorder &getsingleorder &invoice &receiveorder
  58                 &updaterecorder &newordernum
  59                 &getsupplierlistwithlateorders
  60                 &getlateorders
  61
  62                 &bookfunds &curconvert &getcurrencies &bookfundbreakdown
  63                 &updatecurrencies &getcurrency
  64
  65                 &branches &updatesup &insertsup
  66                 &bookseller &breakdown
  67 );
  68
  69 #
  70 #
  71 #
  72 # BASKETS
  73 #
  74 #
  75 #
  76 =item getbasket
  77
  78   $aqbasket = &getbasket($basketnumber);
  79
  80 get all basket informations in aqbasket for a given basket
  81 =cut
  82
  83 sub getbasket {
  84         my ($basketno)=@_;
  85         my $dbh=C4::Context->dbh;
  86         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=?");
  87         $sth->execute($basketno);
  88         return($sth->fetchrow_hashref);
  89 }
  90
  91 =item getbasketcontent
  92
  93   ($count, @orders) = &getbasketcontent($basketnumber, $booksellerID);
  94
  95 Looks up the pending (non-cancelled) orders with the given basket
  96 number. If C<$booksellerID> is non-empty, only orders from that seller
  97 are returned.
  98
  99 C<&basket> returns a two-element array. C<@orders> is an array of
 100 references-to-hash, whose keys are the fields from the aqorders,
 101 biblio, and biblioitems tables in the Koha database. C<$count> is the
 102 number of elements in C<@orders>.
 103
 104 =cut
 105 #'
 106 sub getbasketcontent {
 107         my ($basketno,$supplier,$orderby)=@_;
 108         my $dbh = C4::Context->dbh;
 109         my $query="Select biblio.*,biblioitems.*,aqorders.*,aqorderbreakdown.*,biblio.title from aqorders,biblio,biblioitems
 110         left join aqorderbreakdown on aqorderbreakdown.ordernumber=aqorders.ordernumber
 111         where basketno='$basketno'
 112         and biblio.biblionumber=aqorders.biblionumber and biblioitems.biblioitemnumber
 113         =aqorders.biblioitemnumber
 114         and (datecancellationprinted is NULL or datecancellationprinted =
 115         '0000-00-00')";
 116         if ($supplier ne ''){
 117                 $query.=" and aqorders.booksellerid='$supplier'";
 118         }
 119
 120         $orderby="biblioitems.publishercode" unless $orderby;
 121         $query.=" order by $orderby";
 122         my $sth=$dbh->prepare($query);
 123         $sth->execute;
 124         my @results;
 125         #  print $query;
 126         my $i=0;
 127         while (my $data=$sth->fetchrow_hashref){
 128                 $results[$i]=$data;
 129                 $i++;
 130         }
 131         $sth->finish;
 132         return($i,@results);
 133 }
 134
 135 =item newbasket
 136
 137   $basket = &newbasket();
 138
 139 Create a new basket in aqbasket table
 140 =cut
 141
 142 sub newbasket {
 143         my ($booksellerid,$authorisedby) = @_;
 144         my $dbh = C4::Context->dbh;
 145         my $sth=$dbh->do("insert into aqbasket (creationdate,booksellerid,authorisedby) values(now(),'$booksellerid','$authorisedby')");
 146         #find & return basketno MYSQL dependant, but $dbh->last_insert_id always returns null :-(
 147         my $basket = $dbh->{'mysql_insertid'};
 148         return($basket);
 149 }
 150
 151 =item closebasket
 152
 153   &newbasket($basketno);
 154
 155 close a basket (becomes unmodifiable,except for recieves
 156 =cut
 157
 158 sub closebasket {
 159         my ($basketno) = @_;
 160         my $dbh = C4::Context->dbh;
 161         my $sth=$dbh->prepare("update aqbasket set closedate=now() where basketno=?");
 162         $sth->execute($basketno);
 163 }
 164
 165 =item neworder
 166
 167   &neworder($basket, $biblionumber, $title, $quantity, $listprice,
 168         $booksellerid, $who, $notes, $bookfund, $biblioitemnumber, $rrp,
 169         $ecost, $gst, $budget, $unitprice, $subscription,
 170         $booksellerinvoicenumber);
 171
 172 Adds a new order to the database. Any argument that isn't described
 173 below is the new value of the field with the same name in the aqorders
 174 table of the Koha database.
 175
 176 C<$ordnum> is a "minimum order number." After adding the new entry to
 177 the aqorders table, C<&neworder> finds the first entry in aqorders
 178 with order number greater than or equal to C<$ordnum>, and adds an
 179 entry to the aqorderbreakdown table, with the order number just found,
 180 and the book fund ID of the newly-added order.
 181
 182 C<$budget> is effectively ignored.
 183
 184 C<$subscription> may be either "yes", or anything else for "no".
 185
 186 =cut
 187 #'
 188 sub neworder {
 189         my ($basketno,$bibnum,$title,$quantity,$listprice,$booksellerid,$authorisedby,$notes,$bookfund,$bibitemnum,$rrp,$ecost,$gst,$budget,$cost,$sub,$invoice,$sort1,$sort2)=@_;
 190         if ($budget eq 'now'){
 191                 $budget="now()";
 192         } else {
 193                 $budget="'2001-07-01'";
 194         }
 195         if ($sub eq 'yes'){
 196                 $sub=1;
 197         } else {
 198                 $sub=0;
 199         }
 200         # if $basket empty, it's also a new basket, create it
 201         unless ($basketno) {
 202                 $basketno=newbasket($booksellerid,$authorisedby);
 203         }
 204         my $dbh = C4::Context->dbh;
 205         my $sth=$dbh->prepare("insert into aqorders
 206                                                                 (biblionumber,title,basketno,quantity,listprice,notes,
 207                                                                 biblioitemnumber,rrp,ecost,gst,unitprice,subscription,sort1,sort2)
 208                                                                 values (?,?,?,?,?,?,?,?,?,?,?,?,?,?)");
 209         $sth->execute($bibnum,$title,$basketno,$quantity,$listprice,$notes,
 210                                         $bibitemnum,$rrp,$ecost,$gst,$cost,$sub,$sort1,$sort2);
 211         $sth->finish;
 212         #get ordnum MYSQL dependant, but $dbh->last_insert_id returns null
 213         my $ordnum = $dbh->{'mysql_insertid'};
 214         $sth=$dbh->prepare("insert into aqorderbreakdown (ordernumber,bookfundid) values
 215         (?,?)");
 216         $sth->execute($ordnum,$bookfund);
 217         $sth->finish;
 218         return $basketno;
 219 }
 220
 221 =item delorder
 222
 223   &delorder($biblionumber, $ordernumber);
 224
 225 Cancel the order with the given order and biblio numbers. It does not
 226 delete any entries in the aqorders table, it merely marks them as
 227 cancelled.
 228
 229 =cut
 230 #'
 231 sub delorder {
 232   my ($bibnum,$ordnum)=@_;
 233   my $dbh = C4::Context->dbh;
 234   my $sth=$dbh->prepare("update aqorders set datecancellationprinted=now()
 235   where biblionumber=? and ordernumber=?");
 236   $sth->execute($bibnum,$ordnum);
 237   $sth->finish;
 238 }
 239
 240 =item modorder
 241
 242   &modorder($title, $ordernumber, $quantity, $listprice,
 243         $biblionumber, $basketno, $supplier, $who, $notes,
 244         $bookfundid, $bibitemnum, $rrp, $ecost, $gst, $budget,
 245         $unitprice, $booksellerinvoicenumber);
 246
 247 Modifies an existing order. Updates the order with order number
 248 C<$ordernumber> and biblionumber C<$biblionumber>. All other arguments
 249 update the fields with the same name in the aqorders table of the Koha
 250 database.
 251
 252 Entries with order number C<$ordernumber> in the aqorderbreakdown
 253 table are also updated to the new book fund ID.
 254
 255 =cut
 256 #'
 257 sub modorder {
 258   my ($title,$ordnum,$quantity,$listprice,$bibnum,$basketno,$supplier,$who,$notes,$bookfund,$bibitemnum,$rrp,$ecost,$gst,$budget,$cost,$invoice,$sort1,$sort2)=@_;
 259   my $dbh = C4::Context->dbh;
 260   my $sth=$dbh->prepare("update aqorders set title=?,
 261   quantity=?,listprice=?,basketno=?,
 262   rrp=?,ecost=?,unitprice=?,booksellerinvoicenumber=?,
 263   notes=?,sort1=?, sort2=?
 264   where
 265   ordernumber=? and biblionumber=?");
 266   $sth->execute($title,$quantity,$listprice,$basketno,$rrp,$ecost,$cost,$invoice,$notes,$sort1,$sort2,$ordnum,$bibnum);
 267   $sth->finish;
 268   $sth=$dbh->prepare("update aqorderbreakdown set bookfundid=? where
 269   ordernumber=?");
 270   unless ($sth->execute($bookfund,$ordnum)) { # zero rows affected [Bug 734]
 271     my $query="insert into aqorderbreakdown (ordernumber,bookfundid) values (?,?)";
 272     $sth=$dbh->prepare($query);
 273     $sth->execute($ordnum,$bookfund);
 274   }
 275   $sth->finish;
 276 }
 277
 278 =item newordernum
 279
 280   $order = &newordernum();
 281
 282 Finds the next unused order number in the aqorders table of the Koha
 283 database, and returns it.
 284
 285 =cut
 286 #'
 287 # FIXME - Race condition
 288 sub newordernum {
 289   my $dbh = C4::Context->dbh;
 290   my $sth=$dbh->prepare("Select max(ordernumber) from aqorders");
 291   $sth->execute;
 292   my $data=$sth->fetchrow_arrayref;
 293   my $ordnum=$$data[0];
 294   $ordnum++;
 295   $sth->finish;
 296   return($ordnum);
 297 }
 298
 299 =item receiveorder
 300
 301   &receiveorder($biblionumber, $ordernumber, $quantityreceived, $user,
 302         $unitprice, $booksellerinvoicenumber, $biblioitemnumber,
 303         $freight, $bookfund, $rrp);
 304
 305 Updates an order, to reflect the fact that it was received, at least
 306 in part. All arguments not mentioned below update the fields with the
 307 same name in the aqorders table of the Koha database.
 308
 309 Updates the order with bibilionumber C<$biblionumber> and ordernumber
 310 C<$ordernumber>.
 311
 312 Also updates the book fund ID in the aqorderbreakdown table.
 313
 314 =cut
 315 #'
 316 sub receiveorder {
 317         my ($biblio,$ordnum,$quantrec,$user,$cost,$invoiceno,$freight,$rrp)=@_;
 318         my $dbh = C4::Context->dbh;
 319         my $sth=$dbh->prepare("update aqorders set quantityreceived=?,datereceived=now(),booksellerinvoicenumber=?,
 320                                                                                         unitprice=?,freight=?,rrp=?
 321                                                         where biblionumber=? and ordernumber=?");
 322         $sth->execute($quantrec,$invoiceno,$cost,$freight,$rrp,$biblio,$ordnum);
 323         $sth->finish;
 324 }
 325
 326 =item updaterecorder
 327
 328   &updaterecorder($biblionumber, $ordernumber, $user, $unitprice,
 329         $bookfundid, $rrp);
 330
 331 Updates the order with biblionumber C<$biblionumber> and order number
 332 C<$ordernumber>. C<$bookfundid> is the new value for the book fund ID
 333 in the aqorderbreakdown table of the Koha database. All other
 334 arguments update the fields with the same name in the aqorders table.
 335
 336 C<$user> is ignored.
 337
 338 =cut
 339 #'
 340 sub updaterecorder{
 341   my($biblio,$ordnum,$user,$cost,$bookfund,$rrp)=@_;
 342   my $dbh = C4::Context->dbh;
 343   my $sth=$dbh->prepare("update aqorders set
 344   unitprice=?, rrp=?
 345   where biblionumber=? and ordernumber=?
 346   ");
 347   $sth->execute($cost,$rrp,$biblio,$ordnum);
 348   $sth->finish;
 349   $sth=$dbh->prepare("update aqorderbreakdown set bookfundid=? where ordernumber=?");
 350   $sth->execute($bookfund,$ordnum);
 351   $sth->finish;
 352 }
 353
 354 #
 355 #
 356 # ORDERS
 357 #
 358 #
 359
 360 =item getorders
 361
 362   ($count, $orders) = &getorders($booksellerid);
 363
 364 Finds pending orders from the bookseller with the given ID. Ignores
 365 completed and cancelled orders.
 366
 367 C<$count> is the number of elements in C<@{$orders}>.
 368
 369 C<$orders> is a reference-to-array; each element is a
 370 reference-to-hash with the following fields:
 371
 372 =over 4
 373
 374 =item C<count(*)>
 375
 376 Gives the number of orders in with this basket number.
 377
 378 =item C<authorizedby>
 379
 380 =item C<entrydate>
 381
 382 =item C<basketno>
 383
 384 These give the value of the corresponding field in the aqorders table
 385 of the Koha database.
 386
 387 =back
 388
 389 Results are ordered from most to least recent.
 390
 391 =cut
 392 #'
 393 sub getorders {
 394         my ($supplierid)=@_;
 395         my $dbh = C4::Context->dbh;
 396         my $strsth ="Select count(*),authorisedby,creationdate,aqbasket.basketno,
 397 closedate,surname,firstname,aqorders.title
 398 from aqorders
 399 left join aqbasket on aqbasket.basketno=aqorders.basketno
 400 left join borrowers on aqbasket.authorisedby=borrowers.borrowernumber
 401 where booksellerid=? and (quantity > quantityreceived or
 402 quantityreceived is NULL) and datecancellationprinted is NULL ";
 403
 404         if (C4::Context->preference("IndependantBranches")) {
 405                 my $userenv = C4::Context->userenv;
 406                 unless ($userenv->{flags} == 1){
 407                         $strsth .= " and (borrowers.branchcode = '".$userenv->{branch}."' or borrowers.branchcode ='')";
 408                 }
 409         }
 410         $strsth.=" group by basketno order by aqbasket.basketno";
 411         my $sth=$dbh->prepare($strsth);
 412         $sth->execute($supplierid);
 413         my @results = ();
 414         while (my $data=$sth->fetchrow_hashref){
 415                 push(@results,$data);
 416         }
 417         $sth->finish;
 418         return (scalar(@results),\@results);
 419 }
 420
 421 =item getorder
 422
 423   ($order, $ordernumber) = &getorder($biblioitemnumber, $biblionumber);
 424
 425 Looks up the order with the given biblionumber and biblioitemnumber.
 426
 427 Returns a two-element array. C<$ordernumber> is the order number.
 428 C<$order> is a reference-to-hash describing the order; its keys are
 429 fields from the biblio, biblioitems, aqorders, and aqorderbreakdown
 430 tables of the Koha database.
 431
 432 =cut
 433
 434 sub getorder{
 435   my ($bi,$bib)=@_;
 436   my $dbh = C4::Context->dbh;
 437   my $sth=$dbh->prepare("Select ordernumber from aqorders where biblionumber=? and biblioitemnumber=?");
 438   $sth->execute($bib,$bi);
 439   # FIXME - Use fetchrow_array(), since we're only interested in the one
 440   # value.
 441   my $ordnum=$sth->fetchrow_hashref;
 442   $sth->finish;
 443   my $order=getsingleorder($ordnum->{'ordernumber'});
 444   return ($order,$ordnum->{'ordernumber'});
 445 }
 446
 447 =item getsingleorder
 448
 449   $order = &getsingleorder($ordernumber);
 450
 451 Looks up an order by order number.
 452
 453 Returns a reference-to-hash describing the order. The keys of
 454 C<$order> are fields from the biblio, biblioitems, aqorders, and
 455 aqorderbreakdown tables of the Koha database.
 456
 457 =cut
 458
 459 sub getsingleorder {
 460   my ($ordnum)=@_;
 461   my $dbh = C4::Context->dbh;
 462   my $sth=$dbh->prepare("Select * from biblio,biblioitems,aqorders left join aqorderbreakdown
 463   on aqorders.ordernumber=aqorderbreakdown.ordernumber
 464   where aqorders.ordernumber=?
 465   and biblio.biblionumber=aqorders.biblionumber and
 466   biblioitems.biblioitemnumber=aqorders.biblioitemnumber");
 467   $sth->execute($ordnum);
 468   my $data=$sth->fetchrow_hashref;
 469   $sth->finish;
 470   return($data);
 471 }
 472
 473 =item getallorders
 474
 475   ($count, @results) = &getallorders($booksellerid);
 476
 477 Looks up all of the pending orders from the supplier with the given
 478 bookseller ID. Ignores cancelled and completed orders.
 479
 480 C<$count> is the number of elements in C<@results>. C<@results> is an
 481 array of references-to-hash. The keys of each element are fields from
 482 the aqorders, biblio, and biblioitems tables of the Koha database.
 483
 484 C<@results> is sorted alphabetically by book title.
 485
 486 =cut
 487 #'
 488 sub getallorders {
 489   #gets all orders from a certain supplier, orders them alphabetically
 490   my ($supid)=@_;
 491   my $dbh = C4::Context->dbh;
 492   my @results = ();
 493   my $strsth="Select *,aqorders.title as suggestedtitle,biblio.title as truetitle from aqorders,biblio,biblioitems,aqbasket,aqbooksellers ";
 494         $strsth .= ",borrowers " if (C4::Context->preference("IndependantBranches"));
 495         $strsth .=" where aqorders.basketno=aqbasket.basketno and aqbasket.booksellerid=aqbooksellers.id and biblio.biblionumber=aqorders.biblionumber ";
 496         $strsth .= " and aqbasket.authorisedby=borrowers.borrowernumber" if (C4::Context->preference("IndependantBranches"));
 497         $strsth.=" and booksellerid=? and (cancelledby is NULL or cancelledby = '')
 498   and (quantityreceived < quantity or quantityreceived is NULL)
 499   and biblio.biblionumber=aqorders.biblionumber and biblioitems.biblioitemnumber=
 500   aqorders.biblioitemnumber ";
 501         if (C4::Context->preference("IndependantBranches")) {
 502                 my $userenv = C4::Context->userenv;
 503                 unless ($userenv->{flags} == 1){
 504                         $strsth .= " and (borrowers.branchcode = '".$userenv->{branch}."' or borrowers.branchcode ='')";
 505                 }
 506         }
 507         $strsth .= " group by aqorders.biblioitemnumber order by biblio.title";
 508   my $sth=$dbh->prepare($strsth);
 509   $sth->execute($supid);
 510   while (my $data=$sth->fetchrow_hashref){
 511     push(@results,$data);
 512   }
 513   $sth->finish;
 514   return(scalar(@results),@results);
 515 }
 516
 517 =item getsupplierlistwithlateorders
 518
 519   %results = &getsupplierlistwithlateorders;
 520
 521 Searches for suppliers with late orders.
 522
 523 =cut
 524 #'
 525 sub getsupplierlistwithlateorders {
 526         my $delay=shift;
 527         my $dbh = C4::Context->dbh;
 528 #FIXME NOT quite sure that this operation is valid for DBMs different from Mysql, HOPING so
 529 #should be tested with other DBMs
 530
 531         my $strsth;
 532         my $dbdriver = C4::Context->config("db_scheme")||"mysql";
 533         if ($dbdriver eq "mysql"){
 534                 $strsth="SELECT DISTINCT aqbasket.booksellerid, aqbooksellers.name
 535                                         FROM aqorders, aqbasket
 536                                         LEFT JOIN aqbooksellers ON aqbasket.booksellerid = aqbooksellers.id
 537                                         WHERE aqorders.basketno = aqbasket.basketno AND
 538                                         (closedate < DATE_SUB(CURDATE( ),INTERVAL $delay DAY) AND (datereceived = '' or datereceived is null))
 539                                         ";
 540         }else {
 541                 $strsth="SELECT DISTINCT aqbasket.booksellerid, aqbooksellers.name
 542                         FROM aqorders, aqbasket
 543                         LEFT JOIN aqbooksellers ON aqbasket.aqbooksellerid = aqbooksellers.id
 544                         WHERE aqorders.basketno = aqbasket.basketno AND
 545                         (closedate < (CURDATE( )-(INTERVAL $delay DAY))) AND (datereceived = '' or datereceived is null))
 546                         ";
 547         }
 548 #       warn "C4::Acquisition getsupplierlistwithlateorders : ".$strsth;
 549         my $sth = $dbh->prepare($strsth);
 550         $sth->execute;
 551         my %supplierlist;
 552         while (my ($id,$name) = $sth->fetchrow) {
 553                 $supplierlist{$id} = $name;
 554         }
 555         return %supplierlist;
 556 }
 557
 558 =item getlateorders
 559
 560   %results = &getlateorders;
 561
 562 Searches for suppliers with late orders.
 563
 564 =cut
 565 #'
 566 sub getlateorders {
 567         my $delay=shift;
 568         my $supplierid = shift;
 569         my $branch = shift;
 570
 571         my $dbh = C4::Context->dbh;
 572 #BEWARE, order of parenthesis and LEFT JOIN is important for speed
 573         my $strsth;
 574         my $dbdriver = C4::Context->config("db_scheme")||"mysql";
 575 #       warn " $dbdriver";
 576         if ($dbdriver eq "mysql"){
 577                 $strsth ="SELECT aqbasket.basketno,
 578                                         DATE(aqbasket.closedate) as orderdate, aqorders.quantity, aqorders.rrp as unitpricesupplier,aqorders.ecost as unitpricelib,
 579                                         aqorders.quantity * aqorders.rrp as subtotal, aqbookfund.bookfundname as budget, borrowers.branchcode as branch,
 580                                         aqbooksellers.name as supplier,
 581                                         biblio.title, biblio.author, biblioitems.publishercode as publisher, biblioitems.publicationyear,
 582                                         DATEDIFF(CURDATE( ),closedate) AS latesince
 583                                         FROM
 584                                                 ((      (
 585                                                                 (aqorders LEFT JOIN biblio on biblio.biblionumber = aqorders.biblionumber) LEFT JOIN biblioitems on  biblioitems.biblionumber=biblio.biblionumber
 586                                                         )  LEFT JOIN aqorderbreakdown on aqorders.ordernumber = aqorderbreakdown.ordernumber
 587                                                 ) LEFT JOIN aqbookfund on aqorderbreakdown.bookfundid = aqbookfund.bookfundid
 588                                                 ),(aqbasket LEFT JOIN borrowers on aqbasket.authorisedby = borrowers.borrowernumber) LEFT JOIN aqbooksellers ON aqbasket.booksellerid = aqbooksellers.id
 589                                         WHERE aqorders.basketno = aqbasket.basketno AND (closedate < DATE_SUB(CURDATE( ),INTERVAL $delay DAY))
 590                                         AND ((datereceived = '' OR datereceived is null) OR (aqorders.quantityreceived < aqorders.quantity) ) ";
 591                 $strsth .= " AND aqbasket.booksellerid = $supplierid " if ($supplierid);
 592                 $strsth .= " AND borrowers.branchcode like \'".$branch."\'" if ($branch);
 593                 $strsth .= " AND borrowers.branchcode like \'".C4::Context->userenv->{branch}."\'" if (C4::Context->preference("IndependantBranches") && C4::Context->userenv->{flags}!=1);
 594                 $strsth .= " ORDER BY latesince,basketno,borrowers.branchcode, supplier";
 595         } else {
 596                 $strsth ="SELECT aqbasket.basketno,
 597                                         DATE(aqbasket.closedate) as orderdate,
 598                                         aqorders.quantity, aqorders.rrp as unitpricesupplier,aqorders.ecost as unitpricelib, aqorders.quantity * aqorders.rrp as subtotal
 599                                         aqbookfund.bookfundname as budget, borrowers.branchcode as branch,
 600                                         aqbooksellers.name as supplier,
 601                                         biblio.title, biblio.author, biblioitems.publishercode as publisher, biblioitems.publicationyear,
 602                                         (CURDATE -  closedate) AS latesince
 603                                         FROM
 604                                                 ((      (
 605                                                                 (aqorders LEFT JOIN biblio on biblio.biblionumber = aqorders.biblionumber) LEFT JOIN biblioitems on  biblioitems.biblionumber=biblio.biblionumber
 606                                                         )  LEFT JOIN aqorderbreakdown on aqorders.ordernumber = aqorderbreakdown.ordernumber
 607                                                 ) LEFT JOIN aqbookfund on aqorderbreakdown.bookfundid = aqbookfund.bookfundid
 608                                                 ),(aqbasket LEFT JOIN borrowers on aqbasket.authorisedby = borrowers.borrowernumber) LEFT JOIN aqbooksellers ON aqbasket.booksellerid = aqbooksellers.id
 609                                         WHERE aqorders.basketno = aqbasket.basketno AND (closedate < (CURDATE -(INTERVAL $delay DAY))
 610                                         AND ((datereceived = '' OR datereceived is null) OR (aqorders.quantityreceived < aqorders.quantity) ) ";
 611                 $strsth .= " AND aqbasket.booksellerid = $supplierid " if ($supplierid);
 612                 $strsth .= " AND borrowers.branchcode like \'".$branch."\'" if ($branch);
 613                 $strsth .= " AND borrowers.branchcode like \'".C4::Context->userenv->{branch}."\'" if (C4::Context->preference("IndependantBranches") && C4::Context->userenv->{flags}!=1);
 614                 $strsth .= " ORDER BY latesince,basketno,borrowers.branchcode, supplier";
 615         }
 616 #       warn "C4::Acquisition : getlateorders SQL:".$strsth;
 617         my $sth = $dbh->prepare($strsth);
 618         $sth->execute;
 619         my @results;
 620         my $hilighted = 1;
 621         while (my $data = $sth->fetchrow_hashref) {
 622                 $data->{hilighted}=$hilighted if ($hilighted>0);
 623                 push @results, $data;
 624                 $hilighted= -$hilighted;
 625         }
 626         $sth->finish;
 627         return(scalar(@results),@results);
 628 }
 629
 630 # FIXME - Never used
 631 sub getrecorders {
 632   #gets all orders from a certain supplier, orders them alphabetically
 633   my ($supid)=@_;
 634   my $dbh = C4::Context->dbh;
 635   my @results= ();
 636   my $sth=$dbh->prepare("Select * from aqorders,biblio,biblioitems where booksellerid=?
 637   and (cancelledby is NULL or cancelledby = '')
 638   and biblio.biblionumber=aqorders.biblionumber and biblioitems.biblioitemnumber=
 639   aqorders.biblioitemnumber and
 640   aqorders.quantityreceived>0
 641   and aqorders.datereceived >=now()
 642   group by aqorders.biblioitemnumber
 643   order by
 644   biblio.title");
 645   $sth->execute($supid);
 646   while (my $data=$sth->fetchrow_hashref){
 647     push(@results,$data);
 648   }
 649   $sth->finish;
 650   return(scalar(@results),@results);
 651 }
 652
 653 =item ordersearch
 654
 655   ($count, @results) = &ordersearch($search, $biblionumber, $complete);
 656
 657 Searches for orders.
 658
 659 C<$search> may take one of several forms: if it is an ISBN,
 660 C<&ordersearch> returns orders with that ISBN. If C<$search> is an
 661 order number, C<&ordersearch> returns orders with that order number
 662 and biblionumber C<$biblionumber>. Otherwise, C<$search> is considered
 663 to be a space-separated list of search terms; in this case, all of the
 664 terms must appear in the title (matching the beginning of title
 665 words).
 666
 667 If C<$complete> is C<yes>, the results will include only completed
 668 orders. In any case, C<&ordersearch> ignores cancelled orders.
 669
 670 C<&ordersearch> returns an array. C<$count> is the number of elements
 671 in C<@results>. C<@results> is an array of references-to-hash with the
 672 following keys:
 673
 674 =over 4
 675
 676 =item C<author>
 677
 678 =item C<seriestitle>
 679
 680 =item C<branchcode>
 681
 682 =item C<bookfundid>
 683
 684 =back
 685
 686 =cut
 687 #'
 688 sub ordersearch {
 689         my ($search,$id,$biblio,$catview) = @_;
 690         my $dbh   = C4::Context->dbh;
 691         my @data  = split(' ',$search);
 692         my @searchterms = ($id);
 693         map { push(@searchterms,"$_%","% $_%") } @data;
 694         push(@searchterms,$search,$search,$biblio);
 695         my $sth=$dbh->prepare("Select biblio.*,biblioitems.*,aqorders.*,aqbasket.*,biblio.title from aqorders,biblioitems,biblio,aqbasket
 696                 where aqorders.biblioitemnumber = biblioitems.biblioitemnumber and
 697                 aqorders.basketno = aqbasket.basketno
 698                 and aqbasket.booksellerid = ?
 699                 and biblio.biblionumber=aqorders.biblionumber
 700                 and ((datecancellationprinted is NULL)
 701                 or (datecancellationprinted = '0000-00-00'))
 702                 and (("
 703                 .(join(" and ",map { "(biblio.title like ? or biblio.title like ?)" } @data))
 704                 .") or biblioitems.isbn=? or (aqorders.ordernumber=? and aqorders.biblionumber=?)) "
 705                 .(($catview ne 'yes')?" and (quantityreceived < quantity or quantityreceived is NULL)":"")
 706                 ." group by aqorders.ordernumber");
 707         $sth->execute(@searchterms);
 708         my @results = ();
 709         my $sth2=$dbh->prepare("Select * from biblio where biblionumber=?");
 710         my $sth3=$dbh->prepare("Select * from aqorderbreakdown where ordernumber=?");
 711         while (my $data=$sth->fetchrow_hashref){
 712                 $sth2->execute($data->{'biblionumber'});
 713                 my $data2=$sth2->fetchrow_hashref;
 714                 $data->{'author'}=$data2->{'author'};
 715                 $data->{'seriestitle'}=$data2->{'seriestitle'};
 716                 $sth3->execute($data->{'ordernumber'});
 717                 my $data3=$sth3->fetchrow_hashref;
 718                 $data->{'branchcode'}=$data3->{'branchcode'};
 719                 $data->{'bookfundid'}=$data3->{'bookfundid'};
 720                 push(@results,$data);
 721         }
 722         $sth->finish;
 723         $sth2->finish;
 724         $sth3->finish;
 725         return(scalar(@results),@results);
 726 }
 727
 728
 729 sub histsearch {
 730         my ($title,$author,$name,$from_placed_on,$to_placed_on)=@_;
 731         my $dbh= C4::Context->dbh;
 732         my $query = "select biblio.title,aqorders.basketno,name,aqbasket.creationdate,aqorders.datereceived, aqorders.quantity, aqorders.ecost from aqorders,aqbasket,aqbooksellers,biblio";
 733
 734         $query .= ",borrowers " if (C4::Context->preference("IndependantBranches"));
 735         $query .=" where aqorders.basketno=aqbasket.basketno and aqbasket.booksellerid=aqbooksellers.id and biblio.biblionumber=aqorders.biblionumber ";
 736         $query .= " and aqbasket.authorisedby=borrowers.borrowernumber" if (C4::Context->preference("IndependantBranches"));
 737         $query .= " and biblio.title like ".$dbh->quote("%".$title."%") if $title;
 738         $query .= " and biblio.author like ".$dbh->quote("%".$author."%") if $author;
 739         $query .= " and name like ".$dbh->quote("%".$name."%") if $name;
 740         $query .= " and creationdate >" .$dbh->quote($from_placed_on) if $from_placed_on;
 741         $query .= " and creationdate<".$dbh->quote($to_placed_on) if $to_placed_on;
 742         if (C4::Context->preference("IndependantBranches")) {
 743                 my $userenv = C4::Context->userenv;
 744                 unless ($userenv->{flags} == 1){
 745                         $query .= " and (borrowers.branchcode = '".$userenv->{branch}."' or borrowers.branchcode ='')";
 746                 }
 747         }
 748         warn "C4:Acquisition : ".$query;
 749         my $sth = $dbh->prepare($query);
 750         $sth->execute;
 751         my @order_loop;
 752         my $cnt=1;
 753         while (my $line = $sth->fetchrow_hashref) {
 754                 $line->{count}=$cnt++;
 755                 push @order_loop, $line;
 756         }
 757         return \@order_loop;
 758 }
 759
 760 #
 761 #
 762 # MONEY
 763 #
 764 #
 765 =item invoice
 766
 767   ($count, @results) = &invoice($booksellerinvoicenumber);
 768
 769 Looks up orders by invoice number.
 770
 771 Returns an array. C<$count> is the number of elements in C<@results>.
 772 C<@results> is an array of references-to-hash; the keys of each
 773 elements are fields from the aqorders, biblio, and biblioitems tables
 774 of the Koha database.
 775
 776 =cut
 777 #'
 778 sub invoice {
 779   my ($invoice)=@_;
 780   my $dbh = C4::Context->dbh;
 781   my @results = ();
 782   my $sth=$dbh->prepare("Select * from aqorders,biblio,biblioitems where
 783   booksellerinvoicenumber=?
 784   and biblio.biblionumber=aqorders.biblionumber and biblioitems.biblioitemnumber=
 785   aqorders.biblioitemnumber group by aqorders.ordernumber,aqorders.biblioitemnumber");
 786   $sth->execute($invoice);
 787   while (my $data=$sth->fetchrow_hashref){
 788     push(@results,$data);
 789   }
 790   $sth->finish;
 791   return(scalar(@results),@results);
 792 }
 793
 794 =item bookfunds
 795
 796   ($count, @results) = &bookfunds();
 797
 798 Returns a list of all book funds.
 799
 800 C<$count> is the number of elements in C<@results>. C<@results> is an
 801 array of references-to-hash, whose keys are fields from the aqbookfund
 802 and aqbudget tables of the Koha database. Results are ordered
 803 alphabetically by book fund name.
 804
 805 =cut
 806 #'
 807 sub bookfunds {
 808   my ($branch)=@_;
 809   my $dbh = C4::Context->dbh;
 810   my $strsth;
 811
 812   if ($branch eq '') {
 813       $strsth="Select * from aqbookfund,aqbudget where aqbookfund.bookfundid
 814       =aqbudget.bookfundid
 815       group by aqbookfund.bookfundid order by bookfundname";
 816   } else {
 817       $strsth="Select * from aqbookfund,aqbudget where aqbookfund.bookfundid
 818       =aqbudget.bookfundid and (aqbookfund.branchcode is null or aqbookfund.branchcode='' or aqbookfund.branchcode= ? )
 819       group by aqbookfund.bookfundid order by bookfundname";
 820   }
 821   my $sth=$dbh->prepare($strsth);
 822   if ($branch){
 823       $sth->execute($branch);
 824   } else {
 825       $sth->execute;
 826   }
 827   my @results = ();
 828   while (my $data=$sth->fetchrow_hashref){
 829     push(@results,$data);
 830   }
 831   $sth->finish;
 832   return(scalar(@results),@results);
 833 }
 834
 835 =item bookfundbreakdown
 836
 837         returns the total comtd & spent for a given bookfund
 838         used in acqui-home.pl
 839 =cut
 840 #'
 841
 842 sub bookfundbreakdown {
 843   my ($id)=@_;
 844   my $dbh = C4::Context->dbh;
 845   my $sth=$dbh->prepare("Select quantity,datereceived,freight,unitprice,listprice,ecost,quantityreceived,subscription
 846   from aqorders,aqorderbreakdown where bookfundid=? and
 847   aqorders.ordernumber=aqorderbreakdown.ordernumber
 848   and (datecancellationprinted is NULL or
 849   datecancellationprinted='0000-00-00')");
 850   $sth->execute($id);
 851   my $comtd=0;
 852   my $spent=0;
 853   while (my $data=$sth->fetchrow_hashref){
 854     if ($data->{'subscription'} == 1){
 855       $spent+=$data->{'quantity'}*$data->{'unitprice'};
 856     } else {
 857       my $leftover=$data->{'quantity'}-$data->{'quantityreceived'};
 858       $comtd+=($data->{'ecost'})*$leftover;
 859       $spent+=($data->{'unitprice'})*$data->{'quantityreceived'};
 860     }
 861   }
 862   $sth->finish;
 863   return($spent,$comtd);
 864 }
 865
 866
 867
 868 =item curconvert
 869
 870   $foreignprice = &curconvert($currency, $localprice);
 871
 872 Converts the price C<$localprice> to foreign currency C<$currency> by
 873 dividing by the exchange rate, and returns the result.
 874
 875 If no exchange rate is found, C<&curconvert> assumes the rate is one
 876 to one.
 877
 878 =cut
 879 #'
 880 sub curconvert {
 881   my ($currency,$price)=@_;
 882   my $dbh = C4::Context->dbh;
 883   my $sth=$dbh->prepare("Select rate from currency where currency=?");
 884   $sth->execute($currency);
 885   my $cur=($sth->fetchrow_array())[0];
 886   $sth->finish;
 887   if ($cur==0){
 888     $cur=1;
 889   }
 890   return($price / $cur);
 891 }
 892
 893 =item getcurrencies
 894
 895   ($count, $currencies) = &getcurrencies();
 896
 897 Returns the list of all known currencies.
 898
 899 C<$count> is the number of elements in C<$currencies>. C<$currencies>
 900 is a reference-to-array; its elements are references-to-hash, whose
 901 keys are the fields from the currency table in the Koha database.
 902
 903 =cut
 904 #'
 905 sub getcurrencies {
 906   my $dbh = C4::Context->dbh;
 907   my $sth=$dbh->prepare("Select * from currency");
 908   $sth->execute;
 909   my @results = ();
 910   while (my $data=$sth->fetchrow_hashref){
 911     push(@results,$data);
 912   }
 913   $sth->finish;
 914   return(scalar(@results),\@results);
 915 }
 916
 917 =item updatecurrencies
 918
 919   &updatecurrencies($currency, $newrate);
 920
 921 Sets the exchange rate for C<$currency> to be C<$newrate>.
 922
 923 =cut
 924 #'
 925 sub updatecurrencies {
 926   my ($currency,$rate)=@_;
 927   my $dbh = C4::Context->dbh;
 928   my $sth=$dbh->prepare("update currency set rate=? where currency=?");
 929   $sth->execute($rate,$currency);
 930   $sth->finish;
 931 }
 932
 933 #
 934 #
 935 # OTHERS
 936 #
 937 #
 938
 939 =item bookseller
 940
 941   ($count, @results) = &bookseller($searchstring);
 942
 943 Looks up a book seller. C<$searchstring> may be either a book seller
 944 ID, or a string to look for in the book seller's name.
 945
 946 C<$count> is the number of elements in C<@results>. C<@results> is an
 947 array of references-to-hash, whose keys are the fields of of the
 948 aqbooksellers table in the Koha database.
 949
 950 =cut
 951 #'
 952 sub bookseller {
 953   my ($searchstring)=@_;
 954   my $dbh = C4::Context->dbh;
 955   my $sth=$dbh->prepare("Select * from aqbooksellers where name like ? or id = ?");
 956   $sth->execute("$searchstring%",$searchstring);
 957   my @results;
 958   while (my $data=$sth->fetchrow_hashref){
 959     push(@results,$data);
 960   }
 961   $sth->finish;
 962   return(scalar(@results),@results);
 963 }
 964
 965 =item breakdown
 966
 967   ($count, $results) = &breakdown($ordernumber);
 968
 969 Looks up an order by order ID, and returns its breakdown.
 970
 971 C<$count> is the number of elements in C<$results>. C<$results> is a
 972 reference-to-array; its elements are references-to-hash, whose keys
 973 are the fields of the aqorderbreakdown table in the Koha database.
 974
 975 =cut
 976 #'
 977 sub breakdown {
 978   my ($id)=@_;
 979   my $dbh = C4::Context->dbh;
 980   my $sth=$dbh->prepare("Select * from aqorderbreakdown where ordernumber=?");
 981   $sth->execute($id);
 982   my @results = ();
 983   while (my $data=$sth->fetchrow_hashref){
 984     push(@results,$data);
 985   }
 986   $sth->finish;
 987   return(scalar(@results),\@results);
 988 }
 989
 990 =item branches
 991
 992   ($count, @results) = &branches();
 993
 994 Returns a list of all library branches.
 995
 996 C<$count> is the number of elements in C<@results>. C<@results> is an
 997 array of references-to-hash, whose keys are the fields of the branches
 998 table of the Koha database.
 999
1000 =cut
1001 #'
1002 sub branches {
1003     my $dbh   = C4::Context->dbh;
1004         my $sth;
1005         if (C4::Context->preference("IndependantBranches") && (C4::Context->userenv->{flags}!=1)){
1006                 my $strsth ="Select * from branches ";
1007                 $strsth.= " WHERE branchcode = ".$dbh->quote(C4::Context->userenv->{branch});
1008                 $strsth.= " order by branchname";
1009                 warn "C4::Acquisition->branches : ".$strsth;
1010                 $sth=$dbh->prepare($strsth);
1011         } else {
1012         $sth = $dbh->prepare("Select * from branches order by branchname");
1013         }
1014     my @results = ();
1015
1016     $sth->execute();
1017     while (my $data = $sth->fetchrow_hashref) {
1018         push(@results,$data);
1019     } # while
1020
1021     $sth->finish;
1022     return(scalar(@results), @results);
1023 } # sub branches
1024
1025 =item updatesup
1026
1027   &updatesup($bookseller);
1028
1029 Updates the information for a given bookseller. C<$bookseller> is a
1030 reference-to-hash whose keys are the fields of the aqbooksellers table
1031 in the Koha database. It must contain entries for all of the fields.
1032 The entry to modify is determined by C<$bookseller-E<gt>{id}>.
1033
1034 The easiest way to get all of the necessary fields is to look up a
1035 book seller with C<&booksellers>, modify what's necessary, then call
1036 C<&updatesup> with the result.
1037
1038 =cut
1039 #'
1040 sub updatesup {
1041    my ($data)=@_;
1042    my $dbh = C4::Context->dbh;
1043    my $sth=$dbh->prepare("Update aqbooksellers set
1044    name=?,address1=?,address2=?,address3=?,address4=?,postal=?,
1045    phone=?,fax=?,url=?,contact=?,contpos=?,contphone=?,contfax=?,contaltphone=?,
1046    contemail=?,contnotes=?,active=?,
1047    listprice=?, invoiceprice=?,gstreg=?, listincgst=?,
1048    invoiceincgst=?, specialty=?,discount=?,invoicedisc=?,
1049    nocalc=?
1050    where id=?");
1051    $sth->execute($data->{'name'},$data->{'address1'},$data->{'address2'},
1052    $data->{'address3'},$data->{'address4'},$data->{'postal'},$data->{'phone'},
1053    $data->{'fax'},$data->{'url'},$data->{'contact'},$data->{'contpos'},
1054    $data->{'contphone'},$data->{'contfax'},$data->{'contaltphone'},
1055    $data->{'contemail'},
1056    $data->{'contnote'},$data->{'active'},$data->{'listprice'},
1057    $data->{'invoiceprice'},$data->{'gstreg'},$data->{'listincgst'},
1058    $data->{'invoiceincgst'},$data->{'specialty'},$data->{'discount'},
1059    $data->{'invoicedisc'},$data->{'nocalc'},$data->{'id'});
1060    $sth->finish;
1061 }
1062
1063 =item insertsup
1064
1065   $id = &insertsup($bookseller);
1066
1067 Creates a new bookseller. C<$bookseller> is a reference-to-hash whose
1068 keys are the fields of the aqbooksellers table in the Koha database.
1069 All fields must be present.
1070
1071 Returns the ID of the newly-created bookseller.
1072
1073 =cut
1074 #'
1075 sub insertsup {
1076   my ($data)=@_;
1077   my $dbh = C4::Context->dbh;
1078   my $sth=$dbh->prepare("Select max(id) from aqbooksellers");
1079   $sth->execute;
1080   my $data2=$sth->fetchrow_hashref;
1081   $sth->finish;
1082   $data2->{'max(id)'}++;
1083   $sth=$dbh->prepare("Insert into aqbooksellers (id) values (?)");
1084   $sth->execute($data2->{'max(id)'});
1085   $sth->finish;
1086   $data->{'id'}=$data2->{'max(id)'};
1087   updatesup($data);
1088   return($data->{'id'});
1089 }
1090
1091 END { }       # module clean-up code here (global destructor)
1092
1093 1;
1094 __END__
1095
1096 =back
1097
1098 =head1 AUTHOR
1099
1100 Koha Developement team <info@koha.org>
1101
1102 =cut