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 C4::Date;
  24 use MARC::Record;
  25 # use C4::Biblio;
  26
  27 use vars qw($VERSION @ISA @EXPORT);
  28
  29 # set the version for version checking
  30 $VERSION = 0.01;
  31
  32 =head1 NAME
  33
  34 C4::Acquisition - Koha functions for dealing with orders and acquisitions
  35
  36 =head1 SYNOPSIS
  37
  38   use C4::Acquisition;
  39
  40 =head1 DESCRIPTION
  41
  42 The functions in this module deal with acquisitions, managing book
  43 orders, converting money to different currencies, and so forth.
  44
  45 =head1 FUNCTIONS
  46
  47 =over 2
  48
  49 =cut
  50
  51 @ISA = qw(Exporter);
  52 @EXPORT = qw(
  53                 &getbasket &getbasketcontent &newbasket &closebasket
  54
  55                 &getorders &getallorders &getrecorders
  56                 &getorder &neworder &delorder
  57                 &ordersearch &histsearch
  58                 &modorder &getsingleorder &invoice &receiveorder
  59                 &updaterecorder &newordernum
  60                 &getsupplierlistwithlateorders
  61                 &getlateorders
  62
  63                 &bookfunds &curconvert &getcurrencies &bookfundbreakdown
  64                 &updatecurrencies &getcurrency
  65
  66                 &updatesup &insertsup
  67                 &bookseller &breakdown
  68 );
  69
  70 #
  71 #
  72 #
  73 # BASKETS
  74 #
  75 #
  76 #
  77 =item getbasket
  78
  79   $aqbasket = &getbasket($basketnumber);
  80
  81 get all basket informations in aqbasket for a given basket
  82 =cut
  83
  84 sub getbasket {
  85         my ($basketno)=@_;
  86         my $dbh=C4::Context->dbh;
  87         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=?");
  88         $sth->execute($basketno);
  89         return($sth->fetchrow_hashref);
  90 }
  91
  92 =item getbasketcontent
  93
  94   ($count, @orders) = &getbasketcontent($basketnumber, $booksellerID);
  95
  96 Looks up the pending (non-cancelled) orders with the given basket
  97 number. If C<$booksellerID> is non-empty, only orders from that seller
  98 are returned.
  99
 100 C<&basket> returns a two-element array. C<@orders> is an array of
 101 references-to-hash, whose keys are the fields from the aqorders,
 102 biblio, and biblioitems tables in the Koha database. C<$count> is the
 103 number of elements in C<@orders>.
 104
 105 =cut
 106 #'
 107 sub getbasketcontent {
 108         my ($basketno,$supplier,$orderby)=@_;
 109         my $dbh = C4::Context->dbh;
 110         my $query="Select biblio.*,biblioitems.*,aqorders.*,aqorderbreakdown.*,biblio.title from aqorders,biblio,biblioitems
 111         left join aqorderbreakdown on aqorderbreakdown.ordernumber=aqorders.ordernumber
 112         where basketno='$basketno'
 113         and biblio.biblionumber=aqorders.biblionumber and biblioitems.biblioitemnumber
 114         =aqorders.biblioitemnumber
 115         and (datecancellationprinted is NULL or datecancellationprinted =
 116         '0000-00-00')";
 117         if ($supplier ne ''){
 118                 $query.=" and aqorders.booksellerid='$supplier'";
 119         }
 120
 121         $orderby="biblioitems.publishercode" unless $orderby;
 122         $query.=" order by $orderby";
 123         my $sth=$dbh->prepare($query);
 124         $sth->execute;
 125         my @results;
 126         #  print $query;
 127         my $i=0;
 128         while (my $data=$sth->fetchrow_hashref){
 129                 $results[$i]=$data;
 130                 $i++;
 131         }
 132         $sth->finish;
 133         return($i,@results);
 134 }
 135
 136 =item newbasket
 137
 138   $basket = &newbasket();
 139
 140 Create a new basket in aqbasket table
 141 =cut
 142
 143 sub newbasket {
 144         my ($booksellerid,$authorisedby) = @_;
 145         my $dbh = C4::Context->dbh;
 146         my $sth=$dbh->do("insert into aqbasket (creationdate,booksellerid,authorisedby) values(now(),'$booksellerid','$authorisedby')");
 147         #find & return basketno MYSQL dependant, but $dbh->last_insert_id always returns null :-(
 148         my $basket = $dbh->{'mysql_insertid'};
 149         return($basket);
 150 }
 151
 152 =item closebasket
 153
 154   &newbasket($basketno);
 155
 156 close a basket (becomes unmodifiable,except for recieves
 157 =cut
 158
 159 sub closebasket {
 160         my ($basketno) = @_;
 161         my $dbh = C4::Context->dbh;
 162         my $sth=$dbh->prepare("update aqbasket set closedate=now() where basketno=?");
 163         $sth->execute($basketno);
 164 }
 165
 166 =item neworder
 167
 168   &neworder($basket, $biblionumber, $title, $quantity, $listprice,
 169         $booksellerid, $who, $notes, $bookfund, $biblioitemnumber, $rrp,
 170         $ecost, $gst, $budget, $unitprice, $subscription,
 171         $booksellerinvoicenumber);
 172
 173 Adds a new order to the database. Any argument that isn't described
 174 below is the new value of the field with the same name in the aqorders
 175 table of the Koha database.
 176
 177 C<$ordnum> is a "minimum order number." After adding the new entry to
 178 the aqorders table, C<&neworder> finds the first entry in aqorders
 179 with order number greater than or equal to C<$ordnum>, and adds an
 180 entry to the aqorderbreakdown table, with the order number just found,
 181 and the book fund ID of the newly-added order.
 182
 183 C<$budget> is effectively ignored.
 184
 185 C<$subscription> may be either "yes", or anything else for "no".
 186
 187 =cut
 188 #'
 189 sub neworder {
 190         my ($basketno,$bibnum,$title,$quantity,$listprice,$booksellerid,$authorisedby,$notes,$bookfund,$bibitemnum,$rrp,$ecost,$gst,$budget,$cost,$sub,$invoice,$sort1,$sort2)=@_;
 191         if ($budget eq 'now'){
 192                 $budget="now()";
 193         } else {
 194                 $budget="'2001-07-01'";
 195         }
 196         if ($sub eq 'yes'){
 197                 $sub=1;
 198         } else {
 199                 $sub=0;
 200         }
 201         # if $basket empty, it's also a new basket, create it
 202         unless ($basketno) {
 203                 $basketno=newbasket($booksellerid,$authorisedby);
 204         }
 205         my $dbh = C4::Context->dbh;
 206         my $sth=$dbh->prepare("insert into aqorders
 207                                                                 (biblionumber,title,basketno,quantity,listprice,notes,
 208                                                                 biblioitemnumber,rrp,ecost,gst,unitprice,subscription,sort1,sort2)
 209                                                                 values (?,?,?,?,?,?,?,?,?,?,?,?,?,?)");
 210         $sth->execute($bibnum,$title,$basketno,$quantity,$listprice,$notes,
 211                                         $bibitemnum,$rrp,$ecost,$gst,$cost,$sub,$sort1,$sort2);
 212         $sth->finish;
 213         #get ordnum MYSQL dependant, but $dbh->last_insert_id returns null
 214         my $ordnum = $dbh->{'mysql_insertid'};
 215         $sth=$dbh->prepare("insert into aqorderbreakdown (ordernumber,bookfundid) values
 216         (?,?)");
 217         $sth->execute($ordnum,$bookfund);
 218         $sth->finish;
 219         return $basketno;
 220 }
 221
 222 =item delorder
 223
 224   &delorder($biblionumber, $ordernumber);
 225
 226 Cancel the order with the given order and biblio numbers. It does not
 227 delete any entries in the aqorders table, it merely marks them as
 228 cancelled.
 229
 230 =cut
 231 #'
 232 sub delorder {
 233   my ($bibnum,$ordnum)=@_;
 234   my $dbh = C4::Context->dbh;
 235   my $sth=$dbh->prepare("update aqorders set datecancellationprinted=now()
 236   where biblionumber=? and ordernumber=?");
 237   $sth->execute($bibnum,$ordnum);
 238   $sth->finish;
 239 }
 240
 241 =item modorder
 242
 243   &modorder($title, $ordernumber, $quantity, $listprice,
 244         $biblionumber, $basketno, $supplier, $who, $notes,
 245         $bookfundid, $bibitemnum, $rrp, $ecost, $gst, $budget,
 246         $unitprice, $booksellerinvoicenumber);
 247
 248 Modifies an existing order. Updates the order with order number
 249 C<$ordernumber> and biblionumber C<$biblionumber>. All other arguments
 250 update the fields with the same name in the aqorders table of the Koha
 251 database.
 252
 253 Entries with order number C<$ordernumber> in the aqorderbreakdown
 254 table are also updated to the new book fund ID.
 255
 256 =cut
 257 #'
 258 sub modorder {
 259   my ($title,$ordnum,$quantity,$listprice,$bibnum,$basketno,$supplier,$who,$notes,$bookfund,$bibitemnum,$rrp,$ecost,$gst,$budget,$cost,$invoice,$sort1,$sort2)=@_;
 260   my $dbh = C4::Context->dbh;
 261   my $sth=$dbh->prepare("update aqorders set title=?,
 262   quantity=?,listprice=?,basketno=?,
 263   rrp=?,ecost=?,unitprice=?,booksellerinvoicenumber=?,
 264   notes=?,sort1=?, sort2=?
 265   where
 266   ordernumber=? and biblionumber=?");
 267   $sth->execute($title,$quantity,$listprice,$basketno,$rrp,$ecost,$cost,$invoice,$notes,$sort1,$sort2,$ordnum,$bibnum);
 268   $sth->finish;
 269   $sth=$dbh->prepare("update aqorderbreakdown set bookfundid=? where
 270   ordernumber=?");
 271   unless ($sth->execute($bookfund,$ordnum)) { # zero rows affected [Bug 734]
 272     my $query="insert into aqorderbreakdown (ordernumber,bookfundid) values (?,?)";
 273     $sth=$dbh->prepare($query);
 274     $sth->execute($ordnum,$bookfund);
 275   }
 276   $sth->finish;
 277 }
 278
 279 =item newordernum
 280
 281   $order = &newordernum();
 282
 283 Finds the next unused order number in the aqorders table of the Koha
 284 database, and returns it.
 285
 286 =cut
 287 #'
 288 # FIXME - Race condition
 289 sub newordernum {
 290   my $dbh = C4::Context->dbh;
 291   my $sth=$dbh->prepare("Select max(ordernumber) from aqorders");
 292   $sth->execute;
 293   my $data=$sth->fetchrow_arrayref;
 294   my $ordnum=$$data[0];
 295   $ordnum++;
 296   $sth->finish;
 297   return($ordnum);
 298 }
 299
 300 =item receiveorder
 301
 302   &receiveorder($biblionumber, $ordernumber, $quantityreceived, $user,
 303         $unitprice, $booksellerinvoicenumber, $biblioitemnumber,
 304         $freight, $bookfund, $rrp);
 305
 306 Updates an order, to reflect the fact that it was received, at least
 307 in part. All arguments not mentioned below update the fields with the
 308 same name in the aqorders table of the Koha database.
 309
 310 Updates the order with bibilionumber C<$biblionumber> and ordernumber
 311 C<$ordernumber>.
 312
 313 Also updates the book fund ID in the aqorderbreakdown table.
 314
 315 =cut
 316 #'
 317 sub receiveorder {
 318         my ($biblio,$ordnum,$quantrec,$user,$cost,$invoiceno,$freight,$rrp)=@_;
 319         my $dbh = C4::Context->dbh;
 320         my $sth=$dbh->prepare("update aqorders set quantityreceived=?,datereceived=now(),booksellerinvoicenumber=?,
 321                                                                                         unitprice=?,freight=?,rrp=?
 322                                                         where biblionumber=? and ordernumber=?");
 323         $sth->execute($quantrec,$invoiceno,$cost,$freight,$rrp,$biblio,$ordnum);
 324         $sth->finish;
 325 }
 326
 327 =item updaterecorder
 328
 329   &updaterecorder($biblionumber, $ordernumber, $user, $unitprice,
 330         $bookfundid, $rrp);
 331
 332 Updates the order with biblionumber C<$biblionumber> and order number
 333 C<$ordernumber>. C<$bookfundid> is the new value for the book fund ID
 334 in the aqorderbreakdown table of the Koha database. All other
 335 arguments update the fields with the same name in the aqorders table.
 336
 337 C<$user> is ignored.
 338
 339 =cut
 340 #'
 341 sub updaterecorder{
 342   my($biblio,$ordnum,$user,$cost,$bookfund,$rrp)=@_;
 343   my $dbh = C4::Context->dbh;
 344   my $sth=$dbh->prepare("update aqorders set
 345   unitprice=?, rrp=?
 346   where biblionumber=? and ordernumber=?
 347   ");
 348   $sth->execute($cost,$rrp,$biblio,$ordnum);
 349   $sth->finish;
 350   $sth=$dbh->prepare("update aqorderbreakdown set bookfundid=? where ordernumber=?");
 351   $sth->execute($bookfund,$ordnum);
 352   $sth->finish;
 353 }
 354
 355 #
 356 #
 357 # ORDERS
 358 #
 359 #
 360
 361 =item getorders
 362
 363   ($count, $orders) = &getorders($booksellerid);
 364
 365 Finds pending orders from the bookseller with the given ID. Ignores
 366 completed and cancelled orders.
 367
 368 C<$count> is the number of elements in C<@{$orders}>.
 369
 370 C<$orders> is a reference-to-array; each element is a
 371 reference-to-hash with the following fields:
 372
 373 =over 4
 374
 375 =item C<count(*)>
 376
 377 Gives the number of orders in with this basket number.
 378
 379 =item C<authorizedby>
 380
 381 =item C<entrydate>
 382
 383 =item C<basketno>
 384
 385 These give the value of the corresponding field in the aqorders table
 386 of the Koha database.
 387
 388 =back
 389
 390 Results are ordered from most to least recent.
 391
 392 =cut
 393 #'
 394 sub getorders {
 395         my ($supplierid)=@_;
 396         my $dbh = C4::Context->dbh;
 397         my $strsth ="Select count(*),authorisedby,creationdate,aqbasket.basketno,
 398 closedate,surname,firstname,aqorders.title
 399 from aqorders
 400 left join aqbasket on aqbasket.basketno=aqorders.basketno
 401 left join borrowers on aqbasket.authorisedby=borrowers.borrowernumber
 402 where booksellerid=? and (quantity > quantityreceived or
 403 quantityreceived is NULL) and datecancellationprinted is NULL ";
 404
 405         if (C4::Context->preference("IndependantBranches")) {
 406                 my $userenv = C4::Context->userenv;
 407                 unless ($userenv->{flags} == 1){
 408                         $strsth .= " and (borrowers.branchcode = '".$userenv->{branch}."' or borrowers.branchcode ='')";
 409                 }
 410         }
 411         $strsth.=" group by basketno order by aqbasket.basketno";
 412         my $sth=$dbh->prepare($strsth);
 413         $sth->execute($supplierid);
 414         my @results = ();
 415         while (my $data=$sth->fetchrow_hashref){
 416                 push(@results,$data);
 417         }
 418         $sth->finish;
 419         return (scalar(@results),\@results);
 420 }
 421
 422 =item getorder
 423
 424   ($order, $ordernumber) = &getorder($biblioitemnumber, $biblionumber);
 425
 426 Looks up the order with the given biblionumber and biblioitemnumber.
 427
 428 Returns a two-element array. C<$ordernumber> is the order number.
 429 C<$order> is a reference-to-hash describing the order; its keys are
 430 fields from the biblio, biblioitems, aqorders, and aqorderbreakdown
 431 tables of the Koha database.
 432
 433 =cut
 434
 435 sub getorder{
 436   my ($bi,$bib)=@_;
 437   my $dbh = C4::Context->dbh;
 438   my $sth=$dbh->prepare("Select ordernumber from aqorders where biblionumber=? and biblioitemnumber=?");
 439   $sth->execute($bib,$bi);
 440   # FIXME - Use fetchrow_array(), since we're only interested in the one
 441   # value.
 442   my $ordnum=$sth->fetchrow_hashref;
 443   $sth->finish;
 444   my $order=getsingleorder($ordnum->{'ordernumber'});
 445   return ($order,$ordnum->{'ordernumber'});
 446 }
 447
 448 =item getsingleorder
 449
 450   $order = &getsingleorder($ordernumber);
 451
 452 Looks up an order by order number.
 453
 454 Returns a reference-to-hash describing the order. The keys of
 455 C<$order> are fields from the biblio, biblioitems, aqorders, and
 456 aqorderbreakdown tables of the Koha database.
 457
 458 =cut
 459
 460 sub getsingleorder {
 461   my ($ordnum)=@_;
 462   my $dbh = C4::Context->dbh;
 463   my $sth=$dbh->prepare("Select * from biblio,biblioitems,aqorders left join aqorderbreakdown
 464   on aqorders.ordernumber=aqorderbreakdown.ordernumber
 465   where aqorders.ordernumber=?
 466   and biblio.biblionumber=aqorders.biblionumber and
 467   biblioitems.biblioitemnumber=aqorders.biblioitemnumber");
 468   $sth->execute($ordnum);
 469   my $data=$sth->fetchrow_hashref;
 470   $sth->finish;
 471   return($data);
 472 }
 473
 474 =item getallorders
 475
 476   ($count, @results) = &getallorders($booksellerid);
 477
 478 Looks up all of the pending orders from the supplier with the given
 479 bookseller ID. Ignores cancelled and completed orders.
 480
 481 C<$count> is the number of elements in C<@results>. C<@results> is an
 482 array of references-to-hash. The keys of each element are fields from
 483 the aqorders, biblio, and biblioitems tables of the Koha database.
 484
 485 C<@results> is sorted alphabetically by book title.
 486
 487 =cut
 488 #'
 489 sub getallorders {
 490   #gets all orders from a certain supplier, orders them alphabetically
 491   my ($supplierid)=@_;
 492   my $dbh = C4::Context->dbh;
 493   my @results = ();
 494   my $strsth="Select *,aqorders.title as suggestedtitle,biblio.title as truetitle from aqorders,biblio,biblioitems,aqbasket,aqbooksellers ";
 495         $strsth .= ",borrowers " if (C4::Context->preference("IndependantBranches"));
 496         $strsth .=" where aqorders.basketno=aqbasket.basketno and aqbasket.booksellerid=aqbooksellers.id and biblio.biblionumber=aqorders.biblionumber ";
 497         $strsth .= " and aqbasket.authorisedby=borrowers.borrowernumber" if (C4::Context->preference("IndependantBranches"));
 498         $strsth.=" and booksellerid=? and (cancelledby is NULL or cancelledby = '')
 499   and (quantityreceived < quantity or quantityreceived is NULL)
 500   and biblio.biblionumber=aqorders.biblionumber and biblioitems.biblioitemnumber=
 501   aqorders.biblioitemnumber ";
 502         if (C4::Context->preference("IndependantBranches")) {
 503                 my $userenv = C4::Context->userenv;
 504                 unless ($userenv->{flags} == 1){
 505                         $strsth .= " and (borrowers.branchcode = '".$userenv->{branch}."' or borrowers.branchcode ='')";
 506                 }
 507         }
 508         $strsth .= " group by aqorders.biblioitemnumber order by biblio.title";
 509   my $sth=$dbh->prepare($strsth);
 510   $sth->execute($supplierid);
 511   while (my $data=$sth->fetchrow_hashref){
 512     push(@results,$data);
 513   }
 514   $sth->finish;
 515   return(scalar(@results),@results);
 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 && 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 @order_loop;
 732         my $total_qty=0;
 733         my $total_price=0;
 734         # don't run the query if there are no parameters (list would be too long for sure !
 735         if ($title || $author || $name || $from_placed_on || $to_placed_on) {
 736                 my $dbh= C4::Context->dbh;
 737                 my $query = "select biblio.title,biblio.author,aqorders.basketno,name,aqbasket.creationdate,aqorders.datereceived, aqorders.quantity, aqorders.ecost from aqorders,aqbasket,aqbooksellers,biblio";
 738
 739                 $query .= ",borrowers " if (C4::Context->preference("IndependantBranches"));
 740                 $query .=" where aqorders.basketno=aqbasket.basketno and aqbasket.booksellerid=aqbooksellers.id and biblio.biblionumber=aqorders.biblionumber ";
 741                 $query .= " and aqbasket.authorisedby=borrowers.borrowernumber" if (C4::Context->preference("IndependantBranches"));
 742                 $query .= " and biblio.title like ".$dbh->quote("%".$title."%") if $title;
 743                 $query .= " and biblio.author like ".$dbh->quote("%".$author."%") if $author;
 744                 $query .= " and name like ".$dbh->quote("%".$name."%") if $name;
 745                 $query .= " and creationdate >" .$dbh->quote($from_placed_on) if $from_placed_on;
 746                 $query .= " and creationdate<".$dbh->quote($to_placed_on) if $to_placed_on;
 747                 if (C4::Context->preference("IndependantBranches")) {
 748                         my $userenv = C4::Context->userenv;
 749                         if (($userenv) &&($userenv->{flags} != 1)){
 750                                 $query .= " and (borrowers.branchcode = '".$userenv->{branch}."' or borrowers.branchcode ='')";
 751                         }
 752                 }
 753                 $query .=" order by booksellerid";
 754                 my $sth = $dbh->prepare($query);
 755                 $sth->execute;
 756                 my $cnt=1;
 757                 while (my $line = $sth->fetchrow_hashref) {
 758                         $line->{count}=$cnt++;
 759                         $line->{toggle}=1 if $cnt %2;
 760                         push @order_loop, $line;
 761                         $line->{creationdate} = format_date($line->{creationdate});
 762                         $line->{datereceived} = format_date($line->{datereceived});
 763                         $total_qty += $line->{'quantity'};
 764                         $total_price += $line->{'quantity'}*$line->{'ecost'};
 765                 }
 766         }
 767         return \@order_loop,$total_qty,$total_price;;
 768 }
 769
 770 #
 771 #
 772 # MONEY
 773 #
 774 #
 775 =item invoice
 776
 777   ($count, @results) = &invoice($booksellerinvoicenumber);
 778
 779 Looks up orders by invoice number.
 780
 781 Returns an array. C<$count> is the number of elements in C<@results>.
 782 C<@results> is an array of references-to-hash; the keys of each
 783 elements are fields from the aqorders, biblio, and biblioitems tables
 784 of the Koha database.
 785
 786 =cut
 787 #'
 788 sub invoice {
 789   my ($invoice)=@_;
 790   my $dbh = C4::Context->dbh;
 791   my @results = ();
 792   my $sth=$dbh->prepare("Select * from aqorders,biblio,biblioitems where
 793   booksellerinvoicenumber=?
 794   and biblio.biblionumber=aqorders.biblionumber and biblioitems.biblioitemnumber=
 795   aqorders.biblioitemnumber group by aqorders.ordernumber,aqorders.biblioitemnumber");
 796   $sth->execute($invoice);
 797   while (my $data=$sth->fetchrow_hashref){
 798     push(@results,$data);
 799   }
 800   $sth->finish;
 801   return(scalar(@results),@results);
 802 }
 803
 804 =item bookfunds
 805
 806   ($count, @results) = &bookfunds();
 807
 808 Returns a list of all book funds.
 809
 810 C<$count> is the number of elements in C<@results>. C<@results> is an
 811 array of references-to-hash, whose keys are fields from the aqbookfund
 812 and aqbudget tables of the Koha database. Results are ordered
 813 alphabetically by book fund name.
 814
 815 =cut
 816 #'
 817 sub bookfunds {
 818   my ($branch)=@_;
 819   my $dbh = C4::Context->dbh;
 820   my $strsth;
 821
 822   if ($branch) {
 823       $strsth="Select * from aqbookfund,aqbudget where aqbookfund.bookfundid
 824       =aqbudget.bookfundid and (aqbookfund.branchcode is null or aqbookfund.branchcode='' or aqbookfund.branchcode= ? )
 825       group by aqbookfund.bookfundid order by bookfundname";
 826   } else {
 827       $strsth="Select * from aqbookfund,aqbudget where aqbookfund.bookfundid
 828       =aqbudget.bookfundid
 829       group by aqbookfund.bookfundid order by bookfundname";
 830   }
 831   my $sth=$dbh->prepare($strsth);
 832   if ($branch){
 833       $sth->execute($branch);
 834   } else {
 835       $sth->execute;
 836   }
 837   my @results = ();
 838   while (my $data=$sth->fetchrow_hashref){
 839     push(@results,$data);
 840   }
 841   $sth->finish;
 842   return(scalar(@results),@results);
 843 }
 844
 845 =item bookfundbreakdown
 846
 847         returns the total comtd & spent for a given bookfund
 848         used in acqui-home.pl
 849 =cut
 850 #'
 851
 852 sub bookfundbreakdown {
 853   my ($id)=@_;
 854   my $dbh = C4::Context->dbh;
 855   my $sth=$dbh->prepare("Select quantity,datereceived,freight,unitprice,listprice,ecost,quantityreceived,subscription
 856   from aqorders,aqorderbreakdown where bookfundid=? and
 857   aqorders.ordernumber=aqorderbreakdown.ordernumber
 858   and (datecancellationprinted is NULL or
 859   datecancellationprinted='0000-00-00')");
 860   $sth->execute($id);
 861   my $comtd=0;
 862   my $spent=0;
 863   while (my $data=$sth->fetchrow_hashref){
 864     if ($data->{'subscription'} == 1){
 865       $spent+=$data->{'quantity'}*$data->{'unitprice'};
 866     } else {
 867       my $leftover=$data->{'quantity'}-$data->{'quantityreceived'};
 868       $comtd+=($data->{'ecost'})*$leftover;
 869       $spent+=($data->{'unitprice'})*$data->{'quantityreceived'};
 870     }
 871   }
 872   $sth->finish;
 873   return($spent,$comtd);
 874 }
 875
 876
 877
 878 =item curconvert
 879
 880   $foreignprice = &curconvert($currency, $localprice);
 881
 882 Converts the price C<$localprice> to foreign currency C<$currency> by
 883 dividing by the exchange rate, and returns the result.
 884
 885 If no exchange rate is found, C<&curconvert> assumes the rate is one
 886 to one.
 887
 888 =cut
 889 #'
 890 sub curconvert {
 891   my ($currency,$price)=@_;
 892   my $dbh = C4::Context->dbh;
 893   my $sth=$dbh->prepare("Select rate from currency where currency=?");
 894   $sth->execute($currency);
 895   my $cur=($sth->fetchrow_array())[0];
 896   $sth->finish;
 897   if ($cur==0){
 898     $cur=1;
 899   }
 900   return($price / $cur);
 901 }
 902
 903 =item getcurrencies
 904
 905   ($count, $currencies) = &getcurrencies();
 906
 907 Returns the list of all known currencies.
 908
 909 C<$count> is the number of elements in C<$currencies>. C<$currencies>
 910 is a reference-to-array; its elements are references-to-hash, whose
 911 keys are the fields from the currency table in the Koha database.
 912
 913 =cut
 914 #'
 915 sub getcurrencies {
 916   my $dbh = C4::Context->dbh;
 917   my $sth=$dbh->prepare("Select * from currency");
 918   $sth->execute;
 919   my @results = ();
 920   while (my $data=$sth->fetchrow_hashref){
 921     push(@results,$data);
 922   }
 923   $sth->finish;
 924   return(scalar(@results),\@results);
 925 }
 926
 927 =item updatecurrencies
 928
 929   &updatecurrencies($currency, $newrate);
 930
 931 Sets the exchange rate for C<$currency> to be C<$newrate>.
 932
 933 =cut
 934 #'
 935 sub updatecurrencies {
 936   my ($currency,$rate)=@_;
 937   my $dbh = C4::Context->dbh;
 938   my $sth=$dbh->prepare("update currency set rate=? where currency=?");
 939   $sth->execute($rate,$currency);
 940   $sth->finish;
 941 }
 942
 943 #
 944 #
 945 # OTHERS
 946 #
 947 #
 948
 949 =item bookseller
 950
 951   ($count, @results) = &bookseller($searchstring);
 952
 953 Looks up a book seller. C<$searchstring> may be either a book seller
 954 ID, or a string to look for in the book seller's name.
 955
 956 C<$count> is the number of elements in C<@results>. C<@results> is an
 957 array of references-to-hash, whose keys are the fields of of the
 958 aqbooksellers table in the Koha database.
 959
 960 =cut
 961 #'
 962 sub bookseller {
 963   my ($searchstring)=@_;
 964   my $dbh = C4::Context->dbh;
 965   my $sth=$dbh->prepare("Select * from aqbooksellers where name like ? or id = ?");
 966   $sth->execute("$searchstring%",$searchstring);
 967   my @results;
 968   while (my $data=$sth->fetchrow_hashref){
 969     push(@results,$data);
 970   }
 971   $sth->finish;
 972   return(scalar(@results),@results);
 973 }
 974
 975 =item breakdown
 976
 977   ($count, $results) = &breakdown($ordernumber);
 978
 979 Looks up an order by order ID, and returns its breakdown.
 980
 981 C<$count> is the number of elements in C<$results>. C<$results> is a
 982 reference-to-array; its elements are references-to-hash, whose keys
 983 are the fields of the aqorderbreakdown table in the Koha database.
 984
 985 =cut
 986 #'
 987 sub breakdown {
 988   my ($id)=@_;
 989   my $dbh = C4::Context->dbh;
 990   my $sth=$dbh->prepare("Select * from aqorderbreakdown where ordernumber=?");
 991   $sth->execute($id);
 992   my @results = ();
 993   while (my $data=$sth->fetchrow_hashref){
 994     push(@results,$data);
 995   }
 996   $sth->finish;
 997   return(scalar(@results),\@results);
 998 }
 999
1000 =item updatesup
1001
1002   &updatesup($bookseller);
1003
1004 Updates the information for a given bookseller. C<$bookseller> is a
1005 reference-to-hash whose keys are the fields of the aqbooksellers table
1006 in the Koha database. It must contain entries for all of the fields.
1007 The entry to modify is determined by C<$bookseller-E<gt>{id}>.
1008
1009 The easiest way to get all of the necessary fields is to look up a
1010 book seller with C<&booksellers>, modify what's necessary, then call
1011 C<&updatesup> with the result.
1012
1013 =cut
1014 #'
1015 sub updatesup {
1016    my ($data)=@_;
1017    my $dbh = C4::Context->dbh;
1018    my $sth=$dbh->prepare("Update aqbooksellers set
1019    name=?,address1=?,address2=?,address3=?,address4=?,postal=?,
1020    phone=?,fax=?,url=?,contact=?,contpos=?,contphone=?,contfax=?,contaltphone=?,
1021    contemail=?,contnotes=?,active=?,
1022    listprice=?, invoiceprice=?,gstreg=?, listincgst=?,
1023    invoiceincgst=?, specialty=?,discount=?,invoicedisc=?,
1024    nocalc=?
1025    where id=?");
1026    $sth->execute($data->{'name'},$data->{'address1'},$data->{'address2'},
1027    $data->{'address3'},$data->{'address4'},$data->{'postal'},$data->{'phone'},
1028    $data->{'fax'},$data->{'url'},$data->{'contact'},$data->{'contpos'},
1029    $data->{'contphone'},$data->{'contfax'},$data->{'contaltphone'},
1030    $data->{'contemail'},
1031    $data->{'contnote'},$data->{'active'},$data->{'listprice'},
1032    $data->{'invoiceprice'},$data->{'gstreg'},$data->{'listincgst'},
1033    $data->{'invoiceincgst'},$data->{'specialty'},$data->{'discount'},
1034    $data->{'invoicedisc'},$data->{'nocalc'},$data->{'id'});
1035    $sth->finish;
1036 }
1037
1038 =item insertsup
1039
1040   $id = &insertsup($bookseller);
1041
1042 Creates a new bookseller. C<$bookseller> is a reference-to-hash whose
1043 keys are the fields of the aqbooksellers table in the Koha database.
1044 All fields must be present.
1045
1046 Returns the ID of the newly-created bookseller.
1047
1048 =cut
1049 #'
1050 sub insertsup {
1051   my ($data)=@_;
1052   my $dbh = C4::Context->dbh;
1053   my $sth=$dbh->prepare("Select max(id) from aqbooksellers");
1054   $sth->execute;
1055   my $data2=$sth->fetchrow_hashref;
1056   $sth->finish;
1057   $data2->{'max(id)'}++;
1058   $sth=$dbh->prepare("Insert into aqbooksellers (id) values (?)");
1059   $sth->execute($data2->{'max(id)'});
1060   $sth->finish;
1061   $data->{'id'}=$data2->{'max(id)'};
1062   updatesup($data);
1063   return($data->{'id'});
1064 }
1065
1066 END { }       # module clean-up code here (global destructor)
1067
1068 1;
1069 __END__
1070
1071 =back
1072
1073 =head1 AUTHOR
1074
1075 Koha Developement team <info@koha.org>
1076
1077 =cut