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