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
  27 # use C4::Biblio;
  28
  29 use vars qw($VERSION @ISA @EXPORT);
  30
  31 # set the version for version checking
  32 $VERSION = do { my @v = '$Revision$' =~ /\d+/g; shift(@v) . "." . join( "_", map { sprintf "%03d", $_ } @v ); };
  33
  34 # used in reciveorder subroutine
  35 # to provide library specific handling
  36 my $library_name = C4::Context->preference("LibraryName");
  37
  38 =head1 NAME
  39
  40 C4::Acquisition - Koha functions for dealing with orders and acquisitions
  41
  42 =head1 SYNOPSIS
  43
  44   use C4::Acquisition;
  45
  46 =head1 DESCRIPTION
  47
  48 The functions in this module deal with acquisitions, managing book
  49 orders, converting money to different currencies, and so forth.
  50
  51 =head1 FUNCTIONS
  52
  53 =over 2
  54
  55 =cut
  56
  57 @ISA    = qw(Exporter);
  58 @EXPORT = qw(
  59   &getbasket &getbasketcontent &newbasket &closebasket
  60
  61   &getorders &getallorders &getrecorders
  62   &getorder &neworder &delorder
  63   &ordersearch &histsearch
  64   &modorder &getsingleorder &invoice &receiveorder
  65   &updaterecorder &newordernum
  66   &getsupplierlistwithlateorders
  67   &getlateorders
  68   &getparcels &getparcelinformation
  69   &bookfunds &curconvert &getcurrencies &bookfundbreakdown
  70   &updatecurrencies &getcurrency
  71   &updatesup &insertsup
  72   &bookseller &breakdown
  73 );
  74
  75 #
  76 #
  77 #
  78 # BASKETS
  79 #
  80 #
  81 #
  82
  83 =item getbasket
  84
  85   $aqbasket = &getbasket($basketnumber);
  86
  87 get all basket informations in aqbasket for a given basket
  88 =cut
  89
  90 sub getbasket {
  91     my ($basketno) = @_;
  92     my $dbh        = C4::Context->dbh;
  93     my $sth        =
  94       $dbh->prepare(
  95 "select aqbasket.*,borrowers.firstname+' '+borrowers.surname as authorisedbyname, borrowers.branchcode as branch from aqbasket left join borrowers on aqbasket.authorisedby=borrowers.borrowernumber where basketno=?"
  96       );
  97     $sth->execute($basketno);
  98     return ( $sth->fetchrow_hashref );
  99     $sth->finish();
 100 }
 101
 102 =item getbasketcontent
 103
 104   ($count, @orders) = &getbasketcontent($basketnumber, $booksellerID);
 105
 106 Looks up the pending (non-cancelled) orders with the given basket
 107 number. If C<$booksellerID> is non-empty, only orders from that seller
 108 are returned.
 109
 110 C<&basket> returns a two-element array. C<@orders> is an array of
 111 references-to-hash, whose keys are the fields from the aqorders,
 112 biblio, and biblioitems tables in the Koha database. C<$count> is the
 113 number of elements in C<@orders>.
 114
 115 =cut
 116
 117 #'
 118 sub getbasketcontent {
 119     my ( $basketno, $supplier, $orderby ) = @_;
 120     my $dbh   = C4::Context->dbh;
 121     my $query =
 122 "SELECT aqorderbreakdown.*,biblio.*,biblioitems.*,aqorders.*,biblio.title FROM aqorders,biblio,biblioitems
 123         LEFT JOIN aqorderbreakdown ON aqorderbreakdown.ordernumber=aqorders.ordernumber
 124         where basketno=?
 125         AND biblio.biblionumber=aqorders.biblionumber AND biblioitems.biblioitemnumber
 126         =aqorders.biblioitemnumber
 127         AND (datecancellationprinted IS NULL OR datecancellationprinted =
 128         '0000-00-00')";
 129     if ( $supplier ne '' ) {
 130         $query .= " AND aqorders.booksellerid=?";
 131     }
 132
 133     $orderby = "biblioitems.publishercode" unless $orderby;
 134     $query .= " ORDER BY $orderby";
 135     my $sth = $dbh->prepare($query);
 136     if ( $supplier ne '' ) {
 137         $sth->execute( $basketno, $supplier );
 138     }
 139     else {
 140         $sth->execute($basketno);
 141     }
 142     my @results;
 143
 144     #  print $query;
 145     my $i = 0;
 146     while ( my $data = $sth->fetchrow_hashref ) {
 147         $results[$i] = $data;
 148         $i++;
 149     }
 150     $sth->finish;
 151     return ( $i, @results );
 152 }
 153
 154 =item newbasket
 155
 156   $basket = &newbasket();
 157
 158 Create a new basket in aqbasket table
 159 =cut
 160
 161 sub newbasket {
 162     my ( $booksellerid, $authorisedby ) = @_;
 163     my $dbh = C4::Context->dbh;
 164     my $sth =
 165       $dbh->do(
 166 "insert into aqbasket (creationdate,booksellerid,authorisedby) values(now(),'$booksellerid','$authorisedby')"
 167       );
 168
 169 #find & return basketno MYSQL dependant, but $dbh->last_insert_id always returns null :-(
 170     my $basket = $dbh->{'mysql_insertid'};
 171     return ($basket);
 172 }
 173
 174 =item closebasket
 175
 176   &newbasket($basketno);
 177
 178 close a basket (becomes unmodifiable,except for recieves
 179 =cut
 180
 181 sub closebasket {
 182     my ($basketno) = @_;
 183     my $dbh        = C4::Context->dbh;
 184     my $sth        =
 185       $dbh->prepare("update aqbasket set closedate=now() where basketno=?");
 186     $sth->execute($basketno);
 187 }
 188
 189 =item neworder
 190
 191   &neworder($basket, $biblionumber, $title, $quantity, $listprice,
 192         $booksellerid, $who, $notes, $bookfund, $biblioitemnumber, $rrp,
 193         $ecost, $gst, $budget, $unitprice, $subscription,
 194         $booksellerinvoicenumber);
 195
 196 Adds a new order to the database. Any argument that isn't described
 197 below is the new value of the field with the same name in the aqorders
 198 table of the Koha database.
 199
 200 C<$ordnum> is a "minimum order number." After adding the new entry to
 201 the aqorders table, C<&neworder> finds the first entry in aqorders
 202 with order number greater than or equal to C<$ordnum>, and adds an
 203 entry to the aqorderbreakdown table, with the order number just found,
 204 and the book fund ID of the newly-added order.
 205
 206 C<$budget> is effectively ignored.
 207
 208 C<$subscription> may be either "yes", or anything else for "no".
 209
 210 =cut
 211
 212 #'
 213 sub neworder {
 214     my (
 215         $basketno,  $bibnum,       $title,        $quantity,
 216         $listprice, $booksellerid, $authorisedby, $notes,
 217         $bookfund,  $bibitemnum,   $rrp,          $ecost,
 218         $gst,       $budget,       $cost,         $sub,
 219         $invoice,   $sort1,        $sort2
 220       )
 221       = @_;
 222     my $sth;
 223     my $dbh;
 224     if ( !$budget || $budget eq 'now' ) {
 225         $sth = $dbh->prepare(
 226             "INSERT INTO aqorders
 227   (biblionumber,title,basketno,quantity,listprice,notes,
 228       biblioitemnumber,rrp,ecost,gst,unitprice,subscription,sort1,sort2,budgetdate,entrydate)
 229   VALUES ( ?,?,?,?,?,?,?,?,?,?,?,?,?,?,now(),now() )"
 230         );
 231         $sth->execute(
 232             $bibnum, $title,      $basketno, $quantity, $listprice,
 233             $notes,  $bibitemnum, $rrp,      $ecost,    $gst,
 234             $cost,   $sub,        $sort1,    $sort2
 235         );
 236     }
 237     else {
 238
 239         ##FIXME HARDCODED DATE.
 240         $budget = "'2006-07-01'";
 241         $sth    = $dbh->prepare(
 242             "INSERT INTO aqorders
 243   (biblionumber,title,basketno,quantity,listprice,notes,
 244       biblioitemnumber,rrp,ecost,gst,unitprice,subscription,sort1,sort2,budgetdate,entrydate)
 245   VALUES ( ?,?,?,?,?,?,?,?,?,?,?,?,?,?,?,now() )"
 246         );
 247         $sth->execute(
 248             $bibnum, $title,      $basketno, $quantity, $listprice,
 249             $notes,  $bibitemnum, $rrp,      $ecost,    $gst,
 250             $cost,   $sub,        $sort1,    $sort2,    $budget
 251         );
 252
 253     }
 254     $sth->finish;
 255
 256     #get ordnum MYSQL dependant, but $dbh->last_insert_id returns null
 257     my $ordnum = $dbh->{'mysql_insertid'};
 258     $sth = $dbh->prepare(
 259         "INSERT INTO aqorderbreakdown (ordernumber,bookfundid) VALUES
 260         (?,?)"
 261     );
 262     $sth->execute( $ordnum, $bookfund );
 263     $sth->finish;
 264     return $basketno;
 265 }
 266
 267 =item delorder
 268
 269   &delorder($biblionumber, $ordernumber);
 270
 271 Cancel the order with the given order and biblio numbers. It does not
 272 delete any entries in the aqorders table, it merely marks them as
 273 cancelled.
 274
 275 =cut
 276
 277 #'
 278 sub delorder {
 279     my ( $bibnum, $ordnum ) = @_;
 280     my $dbh = C4::Context->dbh;
 281     my $sth = $dbh->prepare(
 282         "update aqorders set datecancellationprinted=now()
 283   where biblionumber=? and ordernumber=?"
 284     );
 285     $sth->execute( $bibnum, $ordnum );
 286     $sth->finish;
 287 }
 288
 289 =item modorder
 290
 291   &modorder($title, $ordernumber, $quantity, $listprice,
 292         $biblionumber, $basketno, $supplier, $who, $notes,
 293         $bookfundid, $bibitemnum, $rrp, $ecost, $gst, $budget,
 294         $unitprice, $booksellerinvoicenumber);
 295
 296 Modifies an existing order. Updates the order with order number
 297 C<$ordernumber> and biblionumber C<$biblionumber>. All other arguments
 298 update the fields with the same name in the aqorders table of the Koha
 299 database.
 300
 301 Entries with order number C<$ordernumber> in the aqorderbreakdown
 302 table are also updated to the new book fund ID.
 303
 304 =cut
 305
 306 #'
 307 sub modorder {
 308     my (
 309         $title,      $ordnum,   $quantity, $listprice, $bibnum,
 310         $basketno,   $supplier, $who,      $notes,     $bookfund,
 311         $bibitemnum, $rrp,      $ecost,    $gst,       $budget,
 312         $cost,       $invoice,  $sort1,    $sort2
 313       )
 314       = @_;
 315     my $dbh = C4::Context->dbh;
 316     my $sth = $dbh->prepare(
 317         "update aqorders set title=?,
 318   quantity=?,listprice=?,basketno=?,
 319   rrp=?,ecost=?,unitprice=?,booksellerinvoicenumber=?,
 320   notes=?,sort1=?, sort2=?
 321   where
 322   ordernumber=? and biblionumber=?"
 323     );
 324     $sth->execute(
 325         $title, $quantity, $listprice, $basketno, $rrp,
 326         $ecost, $cost,     $invoice,   $notes,    $sort1,
 327         $sort2, $ordnum,   $bibnum
 328     );
 329     $sth->finish;
 330     $sth = $dbh->prepare(
 331         "update aqorderbreakdown set bookfundid=? where
 332   ordernumber=?"
 333     );
 334
 335     unless ( $sth->execute( $bookfund, $ordnum ) )
 336     {    # zero rows affected [Bug 734]
 337         my $query =
 338           "insert into aqorderbreakdown (ordernumber,bookfundid) values (?,?)";
 339         $sth = $dbh->prepare($query);
 340         $sth->execute( $ordnum, $bookfund );
 341     }
 342     $sth->finish;
 343 }
 344
 345 =item newordernum
 346
 347   $order = &newordernum();
 348
 349 Finds the next unused order number in the aqorders table of the Koha
 350 database, and returns it.
 351
 352 =cut
 353
 354 #'
 355 # FIXME - Race condition
 356 sub newordernum {
 357     my $dbh = C4::Context->dbh;
 358     my $sth = $dbh->prepare("Select max(ordernumber) from aqorders");
 359     $sth->execute;
 360     my $data   = $sth->fetchrow_arrayref;
 361     my $ordnum = $$data[0];
 362     $ordnum++;
 363     $sth->finish;
 364     return ($ordnum);
 365 }
 366
 367 =item receiveorder
 368
 369   &receiveorder($biblionumber, $ordernumber, $quantityreceived, $user,
 370         $unitprice, $booksellerinvoicenumber, $biblioitemnumber,
 371         $freight, $bookfund, $rrp);
 372
 373 Updates an order, to reflect the fact that it was received, at least
 374 in part. All arguments not mentioned below update the fields with the
 375 same name in the aqorders table of the Koha database.
 376
 377 Updates the order with bibilionumber C<$biblionumber> and ordernumber
 378 C<$ordernumber>.
 379
 380 Also updates the book fund ID in the aqorderbreakdown table.
 381
 382 =cut
 383
 384 #'
 385 sub receiveorder {
 386     my (
 387         $biblio,    $ordnum,  $quantrec, $user, $cost,
 388         $invoiceno, $freight, $rrp,      $bookfund
 389       )
 390       = @_;
 391     my $dbh = C4::Context->dbh;
 392     my $sth = $dbh->prepare(
 393 "update aqorders set quantityreceived=?,datereceived=now(),booksellerinvoicenumber=?,
 394                                                                                         unitprice=?,freight=?,rrp=?
 395                                                         where biblionumber=? and ordernumber=?"
 396     );
 397     my $suggestionid = GetSuggestionFromBiblionumber( $dbh, $biblio );
 398     if ($suggestionid) {
 399         ModStatus( $suggestionid, 'AVAILABLE', '', $biblio );
 400     }
 401     $sth->execute( $quantrec, $invoiceno, $cost, $freight, $rrp, $biblio,
 402         $ordnum );
 403     $sth->finish;
 404
 405     # Allows libraries to change their bookfund during receiving orders
 406     # allows them to adjust budgets
 407     if ( C4::Context->preferene("LooseBudgets") ) {
 408         my $sth = $dbh->prepare(
 409             "UPDATE aqorderbreakdown SET bookfundid=?
 410                            WHERE ordernumber=?"
 411         );
 412         $sth->execute( $bookfund, $ordnum );
 413         $sth->finish;
 414     }
 415 }
 416
 417 =item updaterecorder
 418
 419   &updaterecorder($biblionumber, $ordernumber, $user, $unitprice,
 420         $bookfundid, $rrp);
 421
 422 Updates the order with biblionumber C<$biblionumber> and order number
 423 C<$ordernumber>. C<$bookfundid> is the new value for the book fund ID
 424 in the aqorderbreakdown table of the Koha database. All other
 425 arguments update the fields with the same name in the aqorders table.
 426
 427 C<$user> is ignored.
 428
 429 =cut
 430
 431 #'
 432 sub updaterecorder {
 433     my ( $biblio, $ordnum, $user, $cost, $bookfund, $rrp ) = @_;
 434     my $dbh = C4::Context->dbh;
 435     my $sth = $dbh->prepare(
 436         "update aqorders set
 437   unitprice=?, rrp=?
 438   where biblionumber=? and ordernumber=?
 439   "
 440     );
 441     $sth->execute( $cost, $rrp, $biblio, $ordnum );
 442     $sth->finish;
 443     $sth =
 444       $dbh->prepare(
 445         "update aqorderbreakdown set bookfundid=? where ordernumber=?");
 446     $sth->execute( $bookfund, $ordnum );
 447     $sth->finish;
 448 }
 449
 450 #
 451 #
 452 # ORDERS
 453 #
 454 #
 455
 456 =item getorders
 457
 458   ($count, $orders) = &getorders($booksellerid);
 459
 460 Finds pending orders from the bookseller with the given ID. Ignores
 461 completed and cancelled orders.
 462
 463 C<$count> is the number of elements in C<@{$orders}>.
 464
 465 C<$orders> is a reference-to-array; each element is a
 466 reference-to-hash with the following fields:
 467
 468 =over 4
 469
 470 =item C<count(*)>
 471
 472 Gives the number of orders in with this basket number.
 473
 474 =item C<authorizedby>
 475
 476 =item C<entrydate>
 477
 478 =item C<basketno>
 479
 480 These give the value of the corresponding field in the aqorders table
 481 of the Koha database.
 482
 483 =back
 484
 485 Results are ordered from most to least recent.
 486
 487 =cut
 488
 489 #'
 490 sub getorders {
 491     my ($supplierid) = @_;
 492     my $dbh = C4::Context->dbh;
 493     my $strsth = "Select count(*),authorisedby,creationdate,aqbasket.basketno,
 494 closedate,surname,firstname,aqorders.title
 495 from aqorders
 496 left join aqbasket on aqbasket.basketno=aqorders.basketno
 497 left join borrowers on aqbasket.authorisedby=borrowers.borrowernumber
 498 where booksellerid=? and (quantity > quantityreceived or
 499 quantityreceived is NULL) and datecancellationprinted is NULL and (to_days(now())-to_days(closedate) < 180 or closedate is null)";
 500     if ( C4::Context->preference("IndependantBranches") ) {
 501         my $userenv = C4::Context->userenv;
 502         if ( ($userenv) && ( $userenv->{flags} != 1 ) ) {
 503             $strsth .=
 504                 " and (borrowers.branchcode = '"
 505               . $userenv->{branch}
 506               . "' or borrowers.branchcode ='')";
 507         }
 508     }
 509     $strsth .= " group by basketno order by aqbasket.basketno";
 510     my $sth = $dbh->prepare($strsth);
 511     $sth->execute($supplierid);
 512     my @results = ();
 513     while ( my $data = $sth->fetchrow_hashref ) {
 514         push( @results, $data );
 515     }
 516     $sth->finish;
 517     return ( scalar(@results), \@results );
 518 }
 519
 520 =item getorder
 521
 522   ($order, $ordernumber) = &getorder($biblioitemnumber, $biblionumber);
 523
 524 Looks up the order with the given biblionumber and biblioitemnumber.
 525
 526 Returns a two-element array. C<$ordernumber> is the order number.
 527 C<$order> is a reference-to-hash describing the order; its keys are
 528 fields from the biblio, biblioitems, aqorders, and aqorderbreakdown
 529 tables of the Koha database.
 530
 531 =cut
 532
 533 sub getorder {
 534     my ( $bi, $bib ) = @_;
 535     my $dbh = C4::Context->dbh;
 536     my $sth =
 537       $dbh->prepare(
 538 "Select ordernumber from aqorders where biblionumber=? and biblioitemnumber=?"
 539       );
 540     $sth->execute( $bib, $bi );
 541
 542     # FIXME - Use fetchrow_array(), since we're only interested in the one
 543     # value.
 544     my $ordnum = $sth->fetchrow_hashref;
 545     $sth->finish;
 546     my $order = getsingleorder( $ordnum->{'ordernumber'} );
 547     return ( $order, $ordnum->{'ordernumber'} );
 548 }
 549
 550 =item getsingleorder
 551
 552   $order = &getsingleorder($ordernumber);
 553
 554 Looks up an order by order number.
 555
 556 Returns a reference-to-hash describing the order. The keys of
 557 C<$order> are fields from the biblio, biblioitems, aqorders, and
 558 aqorderbreakdown tables of the Koha database.
 559
 560 =cut
 561
 562 sub getsingleorder {
 563     my ($ordnum) = @_;
 564     my $dbh      = C4::Context->dbh;
 565     my $sth      = $dbh->prepare(
 566         "Select * from biblio,biblioitems,aqorders left join aqorderbreakdown
 567   on aqorders.ordernumber=aqorderbreakdown.ordernumber
 568   where aqorders.ordernumber=?
 569   and biblio.biblionumber=aqorders.biblionumber and
 570   biblioitems.biblioitemnumber=aqorders.biblioitemnumber"
 571     );
 572     $sth->execute($ordnum);
 573     my $data = $sth->fetchrow_hashref;
 574     $sth->finish;
 575     return ($data);
 576 }
 577
 578 =item getallorders
 579
 580   ($count, @results) = &getallorders($booksellerid);
 581
 582 Looks up all of the pending orders from the supplier with the given
 583 bookseller ID. Ignores cancelled and completed orders.
 584
 585 C<$count> is the number of elements in C<@results>. C<@results> is an
 586 array of references-to-hash. The keys of each element are fields from
 587 the aqorders, biblio, and biblioitems tables of the Koha database.
 588
 589 C<@results> is sorted alphabetically by book title.
 590
 591 =cut
 592
 593 #'
 594 sub getallorders {
 595
 596     #gets all orders from a certain supplier, orders them alphabetically
 597     my ($supplierid) = @_;
 598     my $dbh          = C4::Context->dbh;
 599     my @results      = ();
 600     my $strsth = "Select count(*),authorisedby,creationdate,aqbasket.basketno,
 601 closedate,surname,firstname,aqorders.biblionumber,aqorders.title, aqorders.ordernumber
 602 from aqorders
 603 left join aqbasket on aqbasket.basketno=aqorders.basketno
 604 left join borrowers on aqbasket.authorisedby=borrowers.borrowernumber
 605 where booksellerid=? and (quantity > quantityreceived or
 606 quantityreceived is NULL) and datecancellationprinted is NULL ";
 607
 608     if ( C4::Context->preference("IndependantBranches") ) {
 609         my $userenv = C4::Context->userenv;
 610         if ( ($userenv) && ( $userenv->{flags} != 1 ) ) {
 611             $strsth .=
 612                 " and (borrowers.branchcode = '"
 613               . $userenv->{branch}
 614               . "' or borrowers.branchcode ='')";
 615         }
 616     }
 617     $strsth .= " group by basketno order by aqbasket.basketno";
 618     my $sth = $dbh->prepare($strsth);
 619     $sth->execute($supplierid);
 620     while ( my $data = $sth->fetchrow_hashref ) {
 621         push( @results, $data );
 622     }
 623     $sth->finish;
 624     return ( scalar(@results), @results );
 625 }
 626
 627 =item getparcelinformation
 628
 629   ($count, @results) = &getparcelinformation($booksellerid, $code, $date);
 630
 631 Looks up all of the received items from the supplier with the given
 632 bookseller ID at the given date, for the given code. Ignores cancelled and completed orders.
 633
 634 C<$count> is the number of elements in C<@results>. C<@results> is an
 635 array of references-to-hash. The keys of each element are fields from
 636 the aqorders, biblio, and biblioitems tables of the Koha database.
 637
 638 C<@results> is sorted alphabetically by book title.
 639
 640 =cut
 641
 642 #'
 643 sub getparcelinformation {
 644
 645     #gets all orders from a certain supplier, orders them alphabetically
 646     my ( $supplierid, $code, $datereceived ) = @_;
 647     my $dbh     = C4::Context->dbh;
 648     my @results = ();
 649     $code .= '%'
 650       if $code;  # add % if we search on a given code (otherwise, let him empty)
 651     my $strsth =
 652 "Select authorisedby,creationdate,aqbasket.basketno,closedate,surname,firstname,aqorders.biblionumber,aqorders.title,aqorders.ordernumber, aqorders.quantity, aqorders.quantityreceived, aqorders.unitprice, aqorders.listprice, aqorders.rrp, aqorders.ecost from aqorders,aqbasket left join borrowers on aqbasket.authorisedby=borrowers.borrowernumber where aqbasket.basketno=aqorders.basketno and aqbasket.booksellerid=? and aqorders.booksellerinvoicenumber like  \"$code\" and aqorders.datereceived= \'$datereceived\'";
 653
 654     if ( C4::Context->preference("IndependantBranches") ) {
 655         my $userenv = C4::Context->userenv;
 656         if ( ($userenv) && ( $userenv->{flags} != 1 ) ) {
 657             $strsth .=
 658                 " and (borrowers.branchcode = '"
 659               . $userenv->{branch}
 660               . "' or borrowers.branchcode ='')";
 661         }
 662     }
 663     $strsth .= " order by aqbasket.basketno";
 664     ### parcelinformation : $strsth
 665     my $sth = $dbh->prepare($strsth);
 666     $sth->execute($supplierid);
 667     while ( my $data = $sth->fetchrow_hashref ) {
 668         push( @results, $data );
 669     }
 670     my $count = scalar(@results);
 671     ### countparcelbiblio: $count
 672     $sth->finish;
 673
 674     return ( scalar(@results), @results );
 675 }
 676
 677 =item getparcelinformation
 678
 679   ($count, @results) = &getparcelinformation($booksellerid, $code, $date);
 680
 681 Looks up all of the received items from the supplier with the given
 682 bookseller ID at the given date, for the given code. Ignores cancelled and completed orders.
 683
 684 C<$count> is the number of elements in C<@results>. C<@results> is an
 685 array of references-to-hash. The keys of each element are fields from
 686 the aqorders, biblio, and biblioitems tables of the Koha database.
 687
 688 C<@results> is sorted alphabetically by book title.
 689
 690 =cut
 691
 692 #'
 693 sub getparcelinformation {
 694
 695     #gets all orders from a certain supplier, orders them alphabetically
 696     my ( $supplierid, $code, $datereceived ) = @_;
 697     my $dbh     = C4::Context->dbh;
 698     my @results = ();
 699     $code .= '%'
 700       if $code;  # add % if we search on a given code (otherwise, let him empty)
 701     my $strsth =
 702 "Select authorisedby,creationdate,aqbasket.basketno,closedate,surname,firstname,aqorders.biblionumber,aqorders.title,aqorders.ordernumber, aqorders.quantity, aqorders.quantityreceived, aqorders.unitprice, aqorders.listprice, aqorders.rrp, aqorders.ecost from aqorders,aqbasket left join borrowers on aqbasket.authorisedby=borrowers.borrowernumber where aqbasket.basketno=aqorders.basketno and aqbasket.booksellerid=? and aqorders.booksellerinvoicenumber like  \"$code\" and aqorders.datereceived= \'$datereceived\'";
 703
 704     if ( C4::Context->preference("IndependantBranches") ) {
 705         my $userenv = C4::Context->userenv;
 706         if ( ($userenv) && ( $userenv->{flags} != 1 ) ) {
 707             $strsth .=
 708                 " and (borrowers.branchcode = '"
 709               . $userenv->{branch}
 710               . "' or borrowers.branchcode ='')";
 711         }
 712     }
 713     $strsth .= " order by aqbasket.basketno";
 714     ### parcelinformation : $strsth
 715     my $sth = $dbh->prepare($strsth);
 716     $sth->execute($supplierid);
 717     while ( my $data = $sth->fetchrow_hashref ) {
 718         push( @results, $data );
 719     }
 720     my $count = scalar(@results);
 721     ### countparcelbiblio: $count
 722     $sth->finish;
 723
 724     return ( scalar(@results), @results );
 725 }
 726
 727 =item getsupplierlistwithlateorders
 728
 729   %results = &getsupplierlistwithlateorders;
 730
 731 Searches for suppliers with late orders.
 732
 733 =cut
 734
 735 #'
 736 sub getsupplierlistwithlateorders {
 737     my $delay = shift;
 738     my $dbh   = C4::Context->dbh;
 739
 740 #FIXME NOT quite sure that this operation is valid for DBMs different from Mysql, HOPING so
 741 #should be tested with other DBMs
 742
 743     my $strsth;
 744     my $dbdriver = C4::Context->config("db_scheme") || "mysql";
 745     if ( $dbdriver eq "mysql" ) {
 746         $strsth = "SELECT DISTINCT aqbasket.booksellerid, aqbooksellers.name
 747                                         FROM aqorders, aqbasket
 748                                         LEFT JOIN aqbooksellers ON aqbasket.booksellerid = aqbooksellers.id
 749                                         WHERE aqorders.basketno = aqbasket.basketno AND
 750                                         (closedate < DATE_SUB(CURDATE( ),INTERVAL $delay DAY) AND (datereceived = '' or datereceived is null))
 751                                         ";
 752     }
 753     else {
 754         $strsth = "SELECT DISTINCT aqbasket.booksellerid, aqbooksellers.name
 755                         FROM aqorders, aqbasket
 756                         LEFT JOIN aqbooksellers ON aqbasket.aqbooksellerid = aqbooksellers.id
 757                         WHERE aqorders.basketno = aqbasket.basketno AND
 758                         (closedate < (CURDATE( )-(INTERVAL $delay DAY))) AND (datereceived = '' or datereceived is null))
 759                         ";
 760     }
 761
 762     #   warn "C4::Acquisition getsupplierlistwithlateorders : ".$strsth;
 763     my $sth = $dbh->prepare($strsth);
 764     $sth->execute;
 765     my %supplierlist;
 766     while ( my ( $id, $name ) = $sth->fetchrow ) {
 767         $supplierlist{$id} = $name;
 768     }
 769     return %supplierlist;
 770 }
 771
 772 =item getlateorders
 773
 774   %results = &getlateorders;
 775
 776 Searches for suppliers with late orders.
 777
 778 =cut
 779
 780 #'
 781 sub getlateorders {
 782     my $delay      = shift;
 783     my $supplierid = shift;
 784     my $branch     = shift;
 785
 786     my $dbh = C4::Context->dbh;
 787
 788     #BEWARE, order of parenthesis and LEFT JOIN is important for speed
 789     my $strsth;
 790     my $dbdriver = C4::Context->config("db_scheme") || "mysql";
 791
 792     #   warn " $dbdriver";
 793     if ( $dbdriver eq "mysql" ) {
 794         $strsth = "SELECT aqbasket.basketno,
 795                                         DATE(aqbasket.closedate) as orderdate, aqorders.quantity - IFNULL(aqorders.quantityreceived,0) as quantity, aqorders.rrp as unitpricesupplier,aqorders.ecost as unitpricelib,
 796                                         (aqorders.quantity - IFNULL(aqorders.quantityreceived,0)) * aqorders.rrp as subtotal, aqbookfund.bookfundname as budget, borrowers.branchcode as branch,
 797                                         aqbooksellers.name as supplier,
 798                                         aqorders.title, biblio.author, biblioitems.publishercode as publisher, biblioitems.publicationyear,
 799                                         DATEDIFF(CURDATE( ),closedate) AS latesince
 800                                         FROM
 801                                                 ((      (
 802                                                                 (aqorders LEFT JOIN biblio on biblio.biblionumber = aqorders.biblionumber) LEFT JOIN biblioitems on  biblioitems.biblionumber=biblio.biblionumber
 803                                                         )  LEFT JOIN aqorderbreakdown on aqorders.ordernumber = aqorderbreakdown.ordernumber
 804                                                 ) LEFT JOIN aqbookfund on aqorderbreakdown.bookfundid = aqbookfund.bookfundid
 805                                                 ),(aqbasket LEFT JOIN borrowers on aqbasket.authorisedby = borrowers.borrowernumber) LEFT JOIN aqbooksellers ON aqbasket.booksellerid = aqbooksellers.id
 806                                         WHERE aqorders.basketno = aqbasket.basketno AND (closedate < DATE_SUB(CURDATE( ),INTERVAL $delay DAY))
 807                                         AND ((datereceived = '' OR datereceived is null) OR (aqorders.quantityreceived < aqorders.quantity) ) ";
 808         $strsth .= " AND aqbasket.booksellerid = $supplierid " if ($supplierid);
 809         $strsth .= " AND borrowers.branchcode like \'" . $branch . "\'"
 810           if ($branch);
 811         $strsth .=
 812           " AND borrowers.branchcode like \'"
 813           . C4::Context->userenv->{branch} . "\'"
 814           if ( C4::Context->preference("IndependantBranches")
 815             && C4::Context->userenv
 816             && C4::Context->userenv->{flags} != 1 );
 817         $strsth .=
 818 " HAVING quantity<>0 AND unitpricesupplier<>0 AND unitpricelib<>0 ORDER BY latesince,basketno,borrowers.branchcode, supplier ";
 819     }
 820     else {
 821         $strsth = "SELECT aqbasket.basketno,
 822                                         DATE(aqbasket.closedate) as orderdate,
 823                                         aqorders.quantity, aqorders.rrp as unitpricesupplier,aqorders.ecost as unitpricelib, aqorders.quantity * aqorders.rrp as subtotal
 824                                         aqbookfund.bookfundname as budget, borrowers.branchcode as branch,
 825                                         aqbooksellers.name as supplier,
 826                                         biblio.title, biblio.author, biblioitems.publishercode as publisher, biblioitems.publicationyear,
 827                                         (CURDATE -  closedate) AS latesince
 828                                         FROM
 829                                                 ((      (
 830                                                                 (aqorders LEFT JOIN biblio on biblio.biblionumber = aqorders.biblionumber) LEFT JOIN biblioitems on  biblioitems.biblionumber=biblio.biblionumber
 831                                                         )  LEFT JOIN aqorderbreakdown on aqorders.ordernumber = aqorderbreakdown.ordernumber
 832                                                 ) LEFT JOIN aqbookfund on aqorderbreakdown.bookfundid = aqbookfund.bookfundid
 833                                                 ),(aqbasket LEFT JOIN borrowers on aqbasket.authorisedby = borrowers.borrowernumber) LEFT JOIN aqbooksellers ON aqbasket.booksellerid = aqbooksellers.id
 834                                         WHERE aqorders.basketno = aqbasket.basketno AND (closedate < (CURDATE -(INTERVAL $delay DAY))
 835                                         AND ((datereceived = '' OR datereceived is null) OR (aqorders.quantityreceived < aqorders.quantity) ) ";
 836         $strsth .= " AND aqbasket.booksellerid = $supplierid " if ($supplierid);
 837         $strsth .= " AND borrowers.branchcode like \'" . $branch . "\'"
 838           if ($branch);
 839         $strsth .=
 840           " AND borrowers.branchcode like \'"
 841           . C4::Context->userenv->{branch} . "\'"
 842           if ( C4::Context->preference("IndependantBranches")
 843             && C4::Context->userenv->{flags} != 1 );
 844         $strsth .=
 845           " ORDER BY latesince,basketno,borrowers.branchcode, supplier";
 846     }
 847     warn "C4::Acquisition : getlateorders SQL:" . $strsth;
 848     my $sth = $dbh->prepare($strsth);
 849     $sth->execute;
 850     my @results;
 851     my $hilighted = 1;
 852     while ( my $data = $sth->fetchrow_hashref ) {
 853         $data->{hilighted} = $hilighted if ( $hilighted > 0 );
 854         $data->{orderdate} = format_date( $data->{orderdate} );
 855         push @results, $data;
 856         $hilighted = -$hilighted;
 857     }
 858     $sth->finish;
 859     return ( scalar(@results), @results );
 860 }
 861
 862 # FIXME - Never used
 863 sub getrecorders {
 864
 865     #gets all orders from a certain supplier, orders them alphabetically
 866     my ($supid) = @_;
 867     my $dbh     = C4::Context->dbh;
 868     my @results = ();
 869     my $sth     = $dbh->prepare(
 870         "Select * from aqorders,biblio,biblioitems where booksellerid=?
 871   and (cancelledby is NULL or cancelledby = '')
 872   and biblio.biblionumber=aqorders.biblionumber and biblioitems.biblioitemnumber=
 873   aqorders.biblioitemnumber and
 874   aqorders.quantityreceived>0
 875   and aqorders.datereceived >=now()
 876   group by aqorders.biblioitemnumber
 877   order by
 878   biblio.title"
 879     );
 880     $sth->execute($supid);
 881     while ( my $data = $sth->fetchrow_hashref ) {
 882         push( @results, $data );
 883     }
 884     $sth->finish;
 885     return ( scalar(@results), @results );
 886 }
 887
 888 =item ordersearch
 889
 890   ($count, @results) = &ordersearch($search, $biblionumber, $complete);
 891
 892 Searches for orders.
 893
 894 C<$search> may take one of several forms: if it is an ISBN,
 895 C<&ordersearch> returns orders with that ISBN. If C<$search> is an
 896 order number, C<&ordersearch> returns orders with that order number
 897 and biblionumber C<$biblionumber>. Otherwise, C<$search> is considered
 898 to be a space-separated list of search terms; in this case, all of the
 899 terms must appear in the title (matching the beginning of title
 900 words).
 901
 902 If C<$complete> is C<yes>, the results will include only completed
 903 orders. In any case, C<&ordersearch> ignores cancelled orders.
 904
 905 C<&ordersearch> returns an array. C<$count> is the number of elements
 906 in C<@results>. C<@results> is an array of references-to-hash with the
 907 following keys:
 908
 909 =over 4
 910
 911 =item C<author>
 912
 913 =item C<seriestitle>
 914
 915 =item C<branchcode>
 916
 917 =item C<bookfundid>
 918
 919 =back
 920
 921 =cut
 922
 923 #'
 924 sub ordersearch {
 925     my ( $search, $id, $biblio, $catview ) = @_;
 926     my $dbh = C4::Context->dbh;
 927     my @data = split( ' ', $search );
 928     my @searchterms;
 929     if ($id) {
 930         @searchterms = ($id);
 931     }
 932     map { push( @searchterms, "$_%", "% $_%" ) } @data;
 933     push( @searchterms, $search, $search, $biblio );
 934     my $query;
 935     if ($id) {
 936         $query =
 937           "SELECT *,biblio.title FROM aqorders,biblioitems,biblio,aqbasket
 938   WHERE aqorders.biblioitemnumber = biblioitems.biblioitemnumber AND
 939   aqorders.basketno = aqbasket.basketno
 940   AND aqbasket.booksellerid = ?
 941   AND biblio.biblionumber=aqorders.biblionumber
 942   AND ((datecancellationprinted is NULL)
 943       OR (datecancellationprinted = '0000-00-00'))
 944   AND (("
 945           . (
 946             join( " AND ",
 947                 map { "(biblio.title like ? or biblio.title like ?)" } @data )
 948           )
 949           . ") OR biblioitems.isbn=? OR (aqorders.ordernumber=? AND aqorders.biblionumber=?)) ";
 950
 951     }
 952     else {
 953         $query =
 954           "SELECT *,biblio.title FROM aqorders,biblioitems,biblio,aqbasket
 955   WHERE aqorders.biblioitemnumber = biblioitems.biblioitemnumber AND
 956   aqorders.basketno = aqbasket.basketno
 957   AND biblio.biblionumber=aqorders.biblionumber
 958   AND ((datecancellationprinted is NULL)
 959       OR (datecancellationprinted = '0000-00-00'))
 960   AND (aqorders.quantityreceived < aqorders.quantity OR aqorders.quantityreceived is NULL)
 961   AND (("
 962           . (
 963             join( " AND ",
 964                 map { "(biblio.title like ? OR biblio.title like ?)" } @data )
 965           )
 966           . ") or biblioitems.isbn=? OR (aqorders.ordernumber=? AND aqorders.biblionumber=?)) ";
 967     }
 968     $query .= " GROUP BY aqorders.ordernumber";
 969     my $sth = $dbh->prepare($query);
 970     $sth->execute(@searchterms);
 971     my @results = ();
 972     my $sth2    = $dbh->prepare("SELECT * FROM biblio WHERE biblionumber=?");
 973     my $sth3    =
 974       $dbh->prepare("SELECT * FROM aqorderbreakdown WHERE ordernumber=?");
 975     while ( my $data = $sth->fetchrow_hashref ) {
 976         $sth2->execute( $data->{'biblionumber'} );
 977         my $data2 = $sth2->fetchrow_hashref;
 978         $data->{'author'}      = $data2->{'author'};
 979         $data->{'seriestitle'} = $data2->{'seriestitle'};
 980         $sth3->execute( $data->{'ordernumber'} );
 981         my $data3 = $sth3->fetchrow_hashref;
 982         $data->{'branchcode'} = $data3->{'branchcode'};
 983         $data->{'bookfundid'} = $data3->{'bookfundid'};
 984         push( @results, $data );
 985     }
 986     $sth->finish;
 987     $sth2->finish;
 988     $sth3->finish;
 989     return ( scalar(@results), @results );
 990 }
 991
 992 sub histsearch {
 993     my ( $title, $author, $name, $from_placed_on, $to_placed_on ) = @_;
 994     my @order_loop;
 995     my $total_qty         = 0;
 996     my $total_qtyreceived = 0;
 997     my $total_price       = 0;
 998
 999 # don't run the query if there are no parameters (list would be too long for sure !
1000     if ( $title || $author || $name || $from_placed_on || $to_placed_on ) {
1001         my $dbh   = C4::Context->dbh;
1002         my $query =
1003 "select biblio.title,biblio.author,aqorders.basketno,name,aqbasket.creationdate,aqorders.datereceived, aqorders.quantity, aqorders.quantityreceived, aqorders.ecost from aqorders,aqbasket,aqbooksellers,biblio";
1004         $query .= ",borrowers "
1005           if ( C4::Context->preference("IndependantBranches") );
1006         $query .=
1007 " where aqorders.basketno=aqbasket.basketno and aqbasket.booksellerid=aqbooksellers.id and biblio.biblionumber=aqorders.biblionumber ";
1008         $query .= " and aqbasket.authorisedby=borrowers.borrowernumber"
1009           if ( C4::Context->preference("IndependantBranches") );
1010         $query .= " and biblio.title like " . $dbh->quote( "%" . $title . "%" )
1011           if $title;
1012         $query .=
1013           " and biblio.author like " . $dbh->quote( "%" . $author . "%" )
1014           if $author;
1015         $query .= " and name like " . $dbh->quote( "%" . $name . "%" ) if $name;
1016         $query .= " and creationdate >" . $dbh->quote($from_placed_on)
1017           if $from_placed_on;
1018         $query .= " and creationdate<" . $dbh->quote($to_placed_on)
1019           if $to_placed_on;
1020
1021         if ( C4::Context->preference("IndependantBranches") ) {
1022             my $userenv = C4::Context->userenv;
1023             if ( ($userenv) && ( $userenv->{flags} != 1 ) ) {
1024                 $query .=
1025                     " and (borrowers.branchcode = '"
1026                   . $userenv->{branch}
1027                   . "' or borrowers.branchcode ='')";
1028             }
1029         }
1030         $query .= " order by booksellerid";
1031         warn "query histearch: " . $query;
1032         my $sth = $dbh->prepare($query);
1033         $sth->execute;
1034         my $cnt = 1;
1035         while ( my $line = $sth->fetchrow_hashref ) {
1036             $line->{count} = $cnt++;
1037             $line->{toggle} = 1 if $cnt % 2;
1038             push @order_loop, $line;
1039             $line->{creationdate} = format_date( $line->{creationdate} );
1040             $line->{datereceived} = format_date( $line->{datereceived} );
1041             $total_qty         += $line->{'quantity'};
1042             $total_qtyreceived += $line->{'quantityreceived'};
1043             $total_price       += $line->{'quantity'} * $line->{'ecost'};
1044         }
1045     }
1046     return \@order_loop, $total_qty, $total_price, $total_qtyreceived;
1047 }
1048
1049 #
1050 #
1051 # MONEY
1052 #
1053 #
1054
1055 =item invoice
1056
1057   ($count, @results) = &invoice($booksellerinvoicenumber);
1058
1059 Looks up orders by invoice number.
1060
1061 Returns an array. C<$count> is the number of elements in C<@results>.
1062 C<@results> is an array of references-to-hash; the keys of each
1063 elements are fields from the aqorders, biblio, and biblioitems tables
1064 of the Koha database.
1065
1066 =cut
1067
1068 #'
1069 sub invoice {
1070     my ($invoice) = @_;
1071     my $dbh       = C4::Context->dbh;
1072     my @results   = ();
1073     my $sth       = $dbh->prepare(
1074         "Select * from aqorders,biblio,biblioitems where
1075   booksellerinvoicenumber=?
1076   and biblio.biblionumber=aqorders.biblionumber and biblioitems.biblioitemnumber=
1077   aqorders.biblioitemnumber group by aqorders.ordernumber,aqorders.biblioitemnumber"
1078     );
1079     $sth->execute($invoice);
1080     while ( my $data = $sth->fetchrow_hashref ) {
1081         push( @results, $data );
1082     }
1083     $sth->finish;
1084     return ( scalar(@results), @results );
1085 }
1086
1087 =item bookfunds
1088
1089   ($count, @results) = &bookfunds();
1090
1091 Returns a list of all book funds.
1092
1093 C<$count> is the number of elements in C<@results>. C<@results> is an
1094 array of references-to-hash, whose keys are fields from the aqbookfund
1095 and aqbudget tables of the Koha database. Results are ordered
1096 alphabetically by book fund name.
1097
1098 =cut
1099
1100 #'
1101 sub bookfunds {
1102     my ($branch) = @_;
1103     my $dbh      = C4::Context->dbh;
1104     my $userenv  = C4::Context->userenv;
1105     my $branch   = $userenv->{branch};
1106     my $strsth;
1107
1108     if ( $branch ne '' ) {
1109         $strsth = "SELECT * FROM aqbookfund,aqbudget WHERE aqbookfund.bookfundid
1110       =aqbudget.bookfundid AND startdate<now() AND enddate>now() AND (aqbookfund.branchcode is null or aqbookfund.branchcode='' or aqbookfund.branchcode= ? )
1111       GROUP BY aqbookfund.bookfundid ORDER BY bookfundname";
1112     }
1113     else {
1114         $strsth = "SELECT * FROM aqbookfund,aqbudget WHERE aqbookfund.bookfundid
1115       =aqbudget.bookfundid AND startdate<now() AND enddate>now()
1116       GROUP BY aqbookfund.bookfundid ORDER BY bookfundname";
1117     }
1118     my $sth = $dbh->prepare($strsth);
1119     if ( $branch ne '' ) {
1120         $sth->execute($branch);
1121     }
1122     else {
1123         $sth->execute;
1124     }
1125     my @results = ();
1126     while ( my $data = $sth->fetchrow_hashref ) {
1127         push( @results, $data );
1128     }
1129     $sth->finish;
1130     return ( scalar(@results), @results );
1131 }
1132
1133 =item bookfundbreakdown
1134
1135         returns the total comtd & spent for a given bookfund, and a given year
1136         used in acqui-home.pl
1137 =cut
1138
1139 #'
1140
1141 sub bookfundbreakdown {
1142     my ( $id, $year, $start, $end ) = @_;
1143     my $dbh = C4::Context->dbh;
1144
1145     # if no start/end dates given defaut to everything
1146     if ( !$start ) {
1147         $start = '0000-00-00';
1148         $end   = 'now()';
1149     }
1150
1151     # do a query for spent totals.
1152     my $sth = $dbh->prepare(
1153         "Select quantity,datereceived,freight,unitprice,listprice,ecost,
1154                 quantityreceived,subscription
1155          from aqorders left join aqorderbreakdown on
1156                 aqorders.ordernumber=aqorderbreakdown.ordernumber
1157          where bookfundid=? and (datecancellationprinted is NULL or
1158                 datecancellationprinted='0000-00-00') and
1159                 ((datereceived >= ? and datereceived < ?) or
1160                 (budgetdate >= ? and budgetdate < ?))"
1161     );
1162     $sth->execute( $id, $start, $end, $start, $end );
1163
1164     my $spent = 0;
1165     while ( my $data = $sth->fetchrow_hashref ) {
1166         if ( $data->{'subscription'} == 1 ) {
1167             $spent += $data->{'quantity'} * $data->{'unitprice'};
1168         }
1169         else {
1170
1171             my $leftover = $data->{'quantity'} - $data->{'quantityreceived'};
1172             $spent += ( $data->{'unitprice'} ) * $data->{'quantityreceived'};
1173
1174         }
1175     }
1176
1177     # then do a seperate query for commited totals, (pervious single query was
1178     # returning incorrect comitted results.
1179
1180     my $query = "Select quantity,datereceived,freight,unitprice,
1181                 listprice,ecost,quantityreceived as qrev,
1182                 subscription,title,itemtype,aqorders.biblionumber,
1183                 aqorders.booksellerinvoicenumber,
1184                 quantity-quantityreceived as tleft,
1185                 aqorders.ordernumber as ordnum,entrydate,budgetdate,
1186                 booksellerid,aqbasket.basketno
1187         from aqorderbreakdown,aqbasket,aqorders
1188                 left join biblioitems on
1189                 biblioitems.biblioitemnumber=aqorders.biblioitemnumber
1190         where bookfundid=? and aqorders.ordernumber=aqorderbreakdown.ordernumber and
1191                 aqorders.basketno=aqbasket.basketno and
1192                 (budgetdate >= ? and budgetdate < ?) and
1193                 (datecancellationprinted is NULL or datecancellationprinted='0000-00-00')";
1194     #warn $query;
1195     my $sth = $dbh->prepare($query);
1196     $sth->execute( $id, $start, $end );
1197
1198     my $comtd;
1199
1200     my $total = 0;
1201     while ( my $data = $sth->fetchrow_hashref ) {
1202         my $left = $data->{'tleft'};
1203         if ( !$left || $left eq '' ) {
1204             $left = $data->{'quantity'};
1205         }
1206         if ( $left && $left > 0 ) {
1207             my $subtotal = $left * $data->{'ecost'};
1208             $data->{subtotal} = $subtotal;
1209             $data->{'left'} = $left;
1210             $comtd += $subtotal;
1211         }
1212     }
1213
1214     #warn " spent=$spent, comtd=$comtd\n";
1215     $sth->finish;
1216     return ( $spent, $comtd );
1217 }
1218
1219
1220 =item curconvert
1221
1222   $foreignprice = &curconvert($currency, $localprice);
1223
1224 Converts the price C<$localprice> to foreign currency C<$currency> by
1225 dividing by the exchange rate, and returns the result.
1226
1227 If no exchange rate is found, C<&curconvert> assumes the rate is one
1228 to one.
1229
1230 =cut
1231
1232 #'
1233 sub curconvert {
1234     my ( $currency, $price ) = @_;
1235     my $dbh = C4::Context->dbh;
1236     my $sth = $dbh->prepare("Select rate from currency where currency=?");
1237     $sth->execute($currency);
1238     my $cur = ( $sth->fetchrow_array() )[0];
1239     $sth->finish;
1240     if ( $cur == 0 ) {
1241         $cur = 1;
1242     }
1243     return ( $price / $cur );
1244 }
1245
1246 =item getcurrencies
1247
1248   ($count, $currencies) = &getcurrencies();
1249
1250 Returns the list of all known currencies.
1251
1252 C<$count> is the number of elements in C<$currencies>. C<$currencies>
1253 is a reference-to-array; its elements are references-to-hash, whose
1254 keys are the fields from the currency table in the Koha database.
1255
1256 =cut
1257
1258 #'
1259 sub getcurrencies {
1260     my $dbh = C4::Context->dbh;
1261     my $sth = $dbh->prepare("Select * from currency");
1262     $sth->execute;
1263     my @results = ();
1264     while ( my $data = $sth->fetchrow_hashref ) {
1265         push( @results, $data );
1266     }
1267     $sth->finish;
1268     return ( scalar(@results), \@results );
1269 }
1270
1271 =item updatecurrencies
1272
1273   &updatecurrencies($currency, $newrate);
1274
1275 Sets the exchange rate for C<$currency> to be C<$newrate>.
1276
1277 =cut
1278
1279 #'
1280 sub updatecurrencies {
1281     my ( $currency, $rate ) = @_;
1282     my $dbh = C4::Context->dbh;
1283     my $sth = $dbh->prepare("update currency set rate=? where currency=?");
1284     $sth->execute( $rate, $currency );
1285     $sth->finish;
1286 }
1287
1288 #
1289 #
1290 # OTHERS
1291 #
1292 #
1293
1294 =item bookseller
1295
1296   ($count, @results) = &bookseller($searchstring);
1297
1298 Looks up a book seller. C<$searchstring> may be either a book seller
1299 ID, or a string to look for in the book seller's name.
1300
1301 C<$count> is the number of elements in C<@results>. C<@results> is an
1302 array of references-to-hash, whose keys are the fields of of the
1303 aqbooksellers table in the Koha database.
1304
1305 =cut
1306
1307 #'
1308 sub bookseller {
1309     my ($searchstring) = @_;
1310     my $dbh            = C4::Context->dbh;
1311     my $sth            =
1312       $dbh->prepare("Select * from aqbooksellers where name like ? or id = ?");
1313     $sth->execute( "$searchstring%", $searchstring );
1314     my @results;
1315     while ( my $data = $sth->fetchrow_hashref ) {
1316         push( @results, $data );
1317     }
1318     $sth->finish;
1319     return ( scalar(@results), @results );
1320 }
1321
1322 =item breakdown
1323
1324   ($count, $results) = &breakdown($ordernumber);
1325
1326 Looks up an order by order ID, and returns its breakdown.
1327
1328 C<$count> is the number of elements in C<$results>. C<$results> is a
1329 reference-to-array; its elements are references-to-hash, whose keys
1330 are the fields of the aqorderbreakdown table in the Koha database.
1331
1332 =cut
1333
1334 #'
1335 sub breakdown {
1336     my ($id) = @_;
1337     my $dbh  = C4::Context->dbh;
1338     my $sth  =
1339       $dbh->prepare("Select * from aqorderbreakdown where ordernumber=?");
1340     $sth->execute($id);
1341     my @results = ();
1342     while ( my $data = $sth->fetchrow_hashref ) {
1343         push( @results, $data );
1344     }
1345     $sth->finish;
1346     return ( scalar(@results), \@results );
1347 }
1348
1349 =item branches
1350
1351   ($count, @results) = &branches();
1352
1353 Returns a list of all library branches.
1354
1355 C<$count> is the number of elements in C<@results>. C<@results> is an
1356 array of references-to-hash, whose keys are the fields of the branches
1357 table of the Koha database.
1358
1359 =cut
1360
1361 #'
1362 sub branches {
1363     my $dbh = C4::Context->dbh;
1364     my $sth;
1365     if (   C4::Context->preference("IndependantBranches")
1366         && ( C4::Context->userenv )
1367         && ( C4::Context->userenv->{flags} != 1 ) )
1368     {
1369         my $strsth = "Select * from branches ";
1370         $strsth .=
1371           " WHERE branchcode = "
1372           . $dbh->quote( C4::Context->userenv->{branch} );
1373         $strsth .= " order by branchname";
1374         warn "C4::Acquisition->branches : " . $strsth;
1375         $sth = $dbh->prepare($strsth);
1376     }
1377     else {
1378         $sth = $dbh->prepare("Select * from branches order by branchname");
1379     }
1380     my @results = ();
1381
1382     $sth->execute();
1383     while ( my $data = $sth->fetchrow_hashref ) {
1384         push( @results, $data );
1385     }    # while
1386
1387     $sth->finish;
1388     return ( scalar(@results), @results );
1389 }    # sub branches
1390
1391 =item updatesup
1392
1393   &updatesup($bookseller);
1394
1395 Updates the information for a given bookseller. C<$bookseller> is a
1396 reference-to-hash whose keys are the fields of the aqbooksellers table
1397 in the Koha database. It must contain entries for all of the fields.
1398 The entry to modify is determined by C<$bookseller-E<gt>{id}>.
1399
1400 The easiest way to get all of the necessary fields is to look up a
1401 book seller with C<&booksellers>, modify what's necessary, then call
1402 C<&updatesup> with the result.
1403
1404 =cut
1405
1406 #'
1407 sub updatesup {
1408     my ($data) = @_;
1409     my $dbh    = C4::Context->dbh;
1410     my $sth    = $dbh->prepare(
1411         "Update aqbooksellers set
1412    name=?,address1=?,address2=?,address3=?,address4=?,postal=?,
1413    phone=?,fax=?,url=?,contact=?,contpos=?,contphone=?,contfax=?,contaltphone=?,
1414    contemail=?,contnotes=?,active=?,
1415    listprice=?, invoiceprice=?,gstreg=?, listincgst=?,
1416    invoiceincgst=?, specialty=?,discount=?,invoicedisc=?,
1417    nocalc=?, notes=?
1418    where id=?"
1419     );
1420     $sth->execute(
1421         $data->{'name'},         $data->{'address1'},
1422         $data->{'address2'},     $data->{'address3'},
1423         $data->{'address4'},     $data->{'postal'},
1424         $data->{'phone'},        $data->{'fax'},
1425         $data->{'url'},          $data->{'contact'},
1426         $data->{'contpos'},      $data->{'contphone'},
1427         $data->{'contfax'},      $data->{'contaltphone'},
1428         $data->{'contemail'},    $data->{'contnotes'},
1429         $data->{'active'},       $data->{'listprice'},
1430         $data->{'invoiceprice'}, $data->{'gstreg'},
1431         $data->{'listincgst'},   $data->{'invoiceincgst'},
1432         $data->{'specialty'},    $data->{'discount'},
1433         $data->{'invoicedisc'},  $data->{'nocalc'},
1434         $data->{'notes'},        $data->{'id'}
1435     );
1436     $sth->finish;
1437 }
1438
1439 =item insertsup
1440
1441   $id = &insertsup($bookseller);
1442
1443 Creates a new bookseller. C<$bookseller> is a reference-to-hash whose
1444 keys are the fields of the aqbooksellers table in the Koha database.
1445 All fields must be present.
1446
1447 Returns the ID of the newly-created bookseller.
1448
1449 =cut
1450
1451 #'
1452 sub insertsup {
1453     my ($data) = @_;
1454     my $dbh    = C4::Context->dbh;
1455     my $sth    = $dbh->prepare("Select max(id) from aqbooksellers");
1456     $sth->execute;
1457     my $data2 = $sth->fetchrow_hashref;
1458     $sth->finish;
1459     $data2->{'max(id)'}++;
1460     $sth = $dbh->prepare("Insert into aqbooksellers (id) values (?)");
1461     $sth->execute( $data2->{'max(id)'} );
1462     $sth->finish;
1463     $data->{'id'} = $data2->{'max(id)'};
1464     updatesup($data);
1465     return ( $data->{'id'} );
1466 }
1467
1468 =item getparcels
1469
1470   ($count, $results) = &getparcels($dbh, $bookseller, $order, $limit);
1471
1472 get a lists of parcels
1473 Returns the count of parcels returned and a pointer on a hash list containing parcel informations as such :
1474                 Creation date
1475                 Last operation
1476                 Number of biblio
1477                 Number of items
1478
1479
1480 =cut
1481
1482 #'
1483 sub getparcels {
1484     my ( $bookseller, $order, $code, $datefrom, $dateto, $limit ) = @_;
1485     my $dbh    = C4::Context->dbh;
1486     my $strsth =
1487 "SELECT aqorders.booksellerinvoicenumber, datereceived, count(DISTINCT biblionumber) as biblio, sum(quantity) as itemsexpected, sum(quantityreceived) as itemsreceived from aqorders, aqbasket where aqbasket.basketno = aqorders.basketno and aqbasket.booksellerid = $bookseller and datereceived is not null ";
1488     $strsth .= "and aqorders.booksellerinvoicenumber like \"$code%\" "
1489       if ($code);
1490     $strsth .= "and datereceived >=" . $dbh->quote($datefrom) . " "
1491       if ($datefrom);
1492     $strsth .= "and datereceived <=" . $dbh->quote($dateto) . " " if ($dateto);
1493     $strsth .= "group by aqorders.booksellerinvoicenumber,datereceived ";
1494     $strsth .= "order by $order " if ($order);
1495     $strsth .= " LIMIT 0,$limit" if ($limit);
1496     my $sth = $dbh->prepare($strsth);
1497 ###     getparcels:  $strsth
1498     $sth->execute;
1499     my @results;
1500
1501     while ( my $data2 = $sth->fetchrow_hashref ) {
1502         push @results, $data2;
1503     }
1504
1505     $sth->finish;
1506     return ( scalar(@results), @results );
1507 }
1508
1509 =item getparcels
1510
1511   ($count, $results) = &getparcels($dbh, $bookseller, $order, $limit);
1512
1513 get a lists of parcels
1514 Returns the count of parcels returned and a pointer on a hash list containing parcel informations as such :
1515                 Creation date
1516                 Last operation
1517                 Number of biblio
1518                 Number of items
1519
1520
1521 =cut
1522
1523 #'
1524 sub getparcels {
1525     my ( $bookseller, $order, $code, $datefrom, $dateto, $limit ) = @_;
1526     my $dbh    = C4::Context->dbh;
1527     my $strsth =
1528 "SELECT aqorders.booksellerinvoicenumber, datereceived, count(DISTINCT biblionumber) as biblio, sum(quantity) as itemsexpected, sum(quantityreceived) as itemsreceived from aqorders, aqbasket where aqbasket.basketno = aqorders.basketno and aqbasket.booksellerid = $bookseller and datereceived is not null ";
1529     $strsth .= "and aqorders.booksellerinvoicenumber like \"$code%\" "
1530       if ($code);
1531     $strsth .= "and datereceived >=" . $dbh->quote($datefrom) . " "
1532       if ($datefrom);
1533     $strsth .= "and datereceived <=" . $dbh->quote($dateto) . " " if ($dateto);
1534     $strsth .= "group by aqorders.booksellerinvoicenumber,datereceived ";
1535     $strsth .= "order by $order " if ($order);
1536     $strsth .= " LIMIT 0,$limit" if ($limit);
1537     my $sth = $dbh->prepare($strsth);
1538 ###     getparcels:  $strsth
1539     $sth->execute;
1540     my @results;
1541
1542     while ( my $data2 = $sth->fetchrow_hashref ) {
1543         push @results, $data2;
1544     }
1545
1546     $sth->finish;
1547     return ( scalar(@results), @results );
1548 }
1549
1550 END { }    # module clean-up code here (global destructor)
1551
1552 1;
1553 __END__
1554
1555 =back
1556
1557 =head1 AUTHOR
1558
1559 Koha Developement team <info@koha.org>
1560
1561 =cut