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