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 ( $biblio, $ordnum, $quantrec, $user, $cost, $invoiceno, $freight, $rrp, $bookfund)
 387       = @_;
 388     my $dbh = C4::Context->dbh;
 389     my $sth = $dbh->prepare(
 390 "update aqorders set quantityreceived=?,datereceived=now(),booksellerinvoicenumber=?,
 391                                                                                         unitprice=?,freight=?,rrp=?
 392                                                         where biblionumber=? and ordernumber=?"
 393     );
 394     my $suggestionid = findsuggestion_from_biblionumber( $dbh, $biblio );
 395     if ($suggestionid) {
 396         changestatus( $suggestionid, 'AVAILABLE', '', $biblio );
 397     }
 398     $sth->execute( $quantrec, $invoiceno, $cost, $freight, $rrp, $biblio,
 399         $ordnum );
 400     $sth->finish;
 401
 402     # Allows libraries to change their bookfund during receiving orders
 403     # allows them to adjust budgets
 404     if ( C4::Context->preferene("LooseBudgets") ) {
 405         my $sth = $dbh->prepare(
 406 "UPDATE aqorderbreakdown SET bookfundid=?
 407                            WHERE ordernumber=?"
 408         );
 409         $sth->execute( $bookfund, $ordnum );
 410         $sth->finish;
 411     }
 412 }
 413
 414 =item updaterecorder
 415
 416   &updaterecorder($biblionumber, $ordernumber, $user, $unitprice,
 417         $bookfundid, $rrp);
 418
 419 Updates the order with biblionumber C<$biblionumber> and order number
 420 C<$ordernumber>. C<$bookfundid> is the new value for the book fund ID
 421 in the aqorderbreakdown table of the Koha database. All other
 422 arguments update the fields with the same name in the aqorders table.
 423
 424 C<$user> is ignored.
 425
 426 =cut
 427
 428 #'
 429 sub updaterecorder {
 430     my ( $biblio, $ordnum, $user, $cost, $bookfund, $rrp ) = @_;
 431     my $dbh = C4::Context->dbh;
 432     my $sth = $dbh->prepare(
 433         "update aqorders set
 434   unitprice=?, rrp=?
 435   where biblionumber=? and ordernumber=?
 436   "
 437     );
 438     $sth->execute( $cost, $rrp, $biblio, $ordnum );
 439     $sth->finish;
 440     $sth =
 441       $dbh->prepare(
 442         "update aqorderbreakdown set bookfundid=? where ordernumber=?");
 443     $sth->execute( $bookfund, $ordnum );
 444     $sth->finish;
 445 }
 446
 447 #
 448 #
 449 # ORDERS
 450 #
 451 #
 452
 453 =item getorders
 454
 455   ($count, $orders) = &getorders($booksellerid);
 456
 457 Finds pending orders from the bookseller with the given ID. Ignores
 458 completed and cancelled orders.
 459
 460 C<$count> is the number of elements in C<@{$orders}>.
 461
 462 C<$orders> is a reference-to-array; each element is a
 463 reference-to-hash with the following fields:
 464
 465 =over 4
 466
 467 =item C<count(*)>
 468
 469 Gives the number of orders in with this basket number.
 470
 471 =item C<authorizedby>
 472
 473 =item C<entrydate>
 474
 475 =item C<basketno>
 476
 477 These give the value of the corresponding field in the aqorders table
 478 of the Koha database.
 479
 480 =back
 481
 482 Results are ordered from most to least recent.
 483
 484 =cut
 485
 486 #'
 487 sub getorders {
 488     my ($supplierid) = @_;
 489     my $dbh = C4::Context->dbh;
 490     my $strsth = "Select count(*),authorisedby,creationdate,aqbasket.basketno,
 491 closedate,surname,firstname,aqorders.title
 492 from aqorders
 493 left join aqbasket on aqbasket.basketno=aqorders.basketno
 494 left join borrowers on aqbasket.authorisedby=borrowers.borrowernumber
 495 where booksellerid=? and (quantity > quantityreceived or
 496 quantityreceived is NULL) and datecancellationprinted is NULL and (to_days(now())-to_days(closedate) < 180 or closedate is null)";
 497     if ( C4::Context->preference("IndependantBranches") ) {
 498         my $userenv = C4::Context->userenv;
 499         if ( ($userenv) && ( $userenv->{flags} != 1 ) ) {
 500             $strsth .=
 501                 " and (borrowers.branchcode = '"
 502               . $userenv->{branch}
 503               . "' or borrowers.branchcode ='')";
 504         }
 505     }
 506     $strsth .= " group by basketno order by aqbasket.basketno";
 507     my $sth = $dbh->prepare($strsth);
 508     $sth->execute($supplierid);
 509     my @results = ();
 510     while ( my $data = $sth->fetchrow_hashref ) {
 511         push( @results, $data );
 512     }
 513     $sth->finish;
 514     return ( scalar(@results), \@results );
 515 }
 516
 517 =item getorder
 518
 519   ($order, $ordernumber) = &getorder($biblioitemnumber, $biblionumber);
 520
 521 Looks up the order with the given biblionumber and biblioitemnumber.
 522
 523 Returns a two-element array. C<$ordernumber> is the order number.
 524 C<$order> is a reference-to-hash describing the order; its keys are
 525 fields from the biblio, biblioitems, aqorders, and aqorderbreakdown
 526 tables of the Koha database.
 527
 528 =cut
 529
 530 sub getorder {
 531     my ( $bi, $bib ) = @_;
 532     my $dbh = C4::Context->dbh;
 533     my $sth =
 534       $dbh->prepare(
 535 "Select ordernumber from aqorders where biblionumber=? and biblioitemnumber=?"
 536       );
 537     $sth->execute( $bib, $bi );
 538
 539     # FIXME - Use fetchrow_array(), since we're only interested in the one
 540     # value.
 541     my $ordnum = $sth->fetchrow_hashref;
 542     $sth->finish;
 543     my $order = getsingleorder( $ordnum->{'ordernumber'} );
 544     return ( $order, $ordnum->{'ordernumber'} );
 545 }
 546
 547 =item getsingleorder
 548
 549   $order = &getsingleorder($ordernumber);
 550
 551 Looks up an order by order number.
 552
 553 Returns a reference-to-hash describing the order. The keys of
 554 C<$order> are fields from the biblio, biblioitems, aqorders, and
 555 aqorderbreakdown tables of the Koha database.
 556
 557 =cut
 558
 559 sub getsingleorder {
 560     my ($ordnum) = @_;
 561     my $dbh      = C4::Context->dbh;
 562     my $sth      = $dbh->prepare(
 563         "Select * from biblio,biblioitems,aqorders left join aqorderbreakdown
 564   on aqorders.ordernumber=aqorderbreakdown.ordernumber
 565   where aqorders.ordernumber=?
 566   and biblio.biblionumber=aqorders.biblionumber and
 567   biblioitems.biblioitemnumber=aqorders.biblioitemnumber"
 568     );
 569     $sth->execute($ordnum);
 570     my $data = $sth->fetchrow_hashref;
 571     $sth->finish;
 572     return ($data);
 573 }
 574
 575 =item getallorders
 576
 577   ($count, @results) = &getallorders($booksellerid);
 578
 579 Looks up all of the pending orders from the supplier with the given
 580 bookseller ID. Ignores cancelled and completed orders.
 581
 582 C<$count> is the number of elements in C<@results>. C<@results> is an
 583 array of references-to-hash. The keys of each element are fields from
 584 the aqorders, biblio, and biblioitems tables of the Koha database.
 585
 586 C<@results> is sorted alphabetically by book title.
 587
 588 =cut
 589
 590 #'
 591 sub getallorders {
 592
 593     #gets all orders from a certain supplier, orders them alphabetically
 594     my ($supplierid) = @_;
 595     my $dbh          = C4::Context->dbh;
 596     my @results      = ();
 597     my $strsth = "Select count(*),authorisedby,creationdate,aqbasket.basketno,
 598 closedate,surname,firstname,aqorders.biblionumber,aqorders.title, aqorders.ordernumber
 599 from aqorders
 600 left join aqbasket on aqbasket.basketno=aqorders.basketno
 601 left join borrowers on aqbasket.authorisedby=borrowers.borrowernumber
 602 where booksellerid=? and (quantity > quantityreceived or
 603 quantityreceived is NULL) and datecancellationprinted is NULL ";
 604
 605     if ( C4::Context->preference("IndependantBranches") ) {
 606         my $userenv = C4::Context->userenv;
 607         if ( ($userenv) && ( $userenv->{flags} != 1 ) ) {
 608             $strsth .=
 609                 " and (borrowers.branchcode = '"
 610               . $userenv->{branch}
 611               . "' or borrowers.branchcode ='')";
 612         }
 613     }
 614     $strsth .= " group by basketno order by aqbasket.basketno";
 615     my $sth = $dbh->prepare($strsth);
 616     $sth->execute($supplierid);
 617     while ( my $data = $sth->fetchrow_hashref ) {
 618         push( @results, $data );
 619     }
 620     $sth->finish;
 621     return ( scalar(@results), @results );
 622 }
 623
 624 =item getparcelinformation
 625
 626   ($count, @results) = &getparcelinformation($booksellerid, $code, $date);
 627
 628 Looks up all of the received items from the supplier with the given
 629 bookseller ID at the given date, for the given code. Ignores cancelled and completed orders.
 630
 631 C<$count> is the number of elements in C<@results>. C<@results> is an
 632 array of references-to-hash. The keys of each element are fields from
 633 the aqorders, biblio, and biblioitems tables of the Koha database.
 634
 635 C<@results> is sorted alphabetically by book title.
 636
 637 =cut
 638
 639 #'
 640 sub getparcelinformation {
 641
 642     #gets all orders from a certain supplier, orders them alphabetically
 643     my ( $supplierid, $code, $datereceived ) = @_;
 644     my $dbh     = C4::Context->dbh;
 645     my @results = ();
 646     $code .= '%'
 647       if $code;  # add % if we search on a given code (otherwise, let him empty)
 648     my $strsth =
 649 "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\'";
 650
 651     if ( C4::Context->preference("IndependantBranches") ) {
 652         my $userenv = C4::Context->userenv;
 653         if ( ($userenv) && ( $userenv->{flags} != 1 ) ) {
 654             $strsth .=
 655                 " and (borrowers.branchcode = '"
 656               . $userenv->{branch}
 657               . "' or borrowers.branchcode ='')";
 658         }
 659     }
 660     $strsth .= " order by aqbasket.basketno";
 661     ### parcelinformation : $strsth
 662     my $sth = $dbh->prepare($strsth);
 663     $sth->execute($supplierid);
 664     while ( my $data = $sth->fetchrow_hashref ) {
 665         push( @results, $data );
 666     }
 667     my $count = scalar(@results);
 668     ### countparcelbiblio: $count
 669     $sth->finish;
 670
 671     return ( scalar(@results), @results );
 672 }
 673 =item getparcelinformation
 674
 675   ($count, @results) = &getparcelinformation($booksellerid, $code, $date);
 676
 677 Looks up all of the received items from the supplier with the given
 678 bookseller ID at the given date, for the given code. Ignores cancelled and completed orders.
 679
 680 C<$count> is the number of elements in C<@results>. C<@results> is an
 681 array of references-to-hash. The keys of each element are fields from
 682 the aqorders, biblio, and biblioitems tables of the Koha database.
 683
 684 C<@results> is sorted alphabetically by book title.
 685
 686 =cut
 687 #'
 688 sub getparcelinformation {
 689   #gets all orders from a certain supplier, orders them alphabetically
 690   my ($supplierid,$code, $datereceived)=@_;
 691   my $dbh = C4::Context->dbh;
 692   my @results = ();
 693   $code .='%' if $code; # add % if we search on a given code (otherwise, let him empty)
 694         my $strsth ="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\'";
 695
 696         if (C4::Context->preference("IndependantBranches")) {
 697                 my $userenv = C4::Context->userenv;
 698                 if (($userenv) &&($userenv->{flags} != 1)){
 699                         $strsth .= " and (borrowers.branchcode = '".$userenv->{branch}."' or borrowers.branchcode ='')";
 700                 }
 701         }
 702         $strsth.=" order by aqbasket.basketno";
 703         ### parcelinformation : $strsth
 704         my $sth=$dbh->prepare($strsth);
 705   $sth->execute($supplierid);
 706   while (my $data=$sth->fetchrow_hashref){
 707     push(@results,$data);
 708   }
 709   my $count =scalar(@results);
 710   ### countparcelbiblio: $count
 711   $sth->finish;
 712
 713   return(scalar(@results),@results);
 714 }
 715 =item getsupplierlistwithlateorders
 716
 717   %results = &getsupplierlistwithlateorders;
 718
 719 Searches for suppliers with late orders.
 720
 721 =cut
 722
 723 #'
 724 sub getsupplierlistwithlateorders {
 725     my $delay = shift;
 726     my $dbh   = C4::Context->dbh;
 727
 728 #FIXME NOT quite sure that this operation is valid for DBMs different from Mysql, HOPING so
 729 #should be tested with other DBMs
 730
 731     my $strsth;
 732     my $dbdriver = C4::Context->config("db_scheme") || "mysql";
 733     if ( $dbdriver eq "mysql" ) {
 734         $strsth = "SELECT DISTINCT aqbasket.booksellerid, aqbooksellers.name
 735                                         FROM aqorders, aqbasket
 736                                         LEFT JOIN aqbooksellers ON aqbasket.booksellerid = aqbooksellers.id
 737                                         WHERE aqorders.basketno = aqbasket.basketno AND
 738                                         (closedate < DATE_SUB(CURDATE( ),INTERVAL $delay DAY) AND (datereceived = '' or datereceived is null))
 739                                         ";
 740     }
 741     else {
 742         $strsth = "SELECT DISTINCT aqbasket.booksellerid, aqbooksellers.name
 743                         FROM aqorders, aqbasket
 744                         LEFT JOIN aqbooksellers ON aqbasket.aqbooksellerid = aqbooksellers.id
 745                         WHERE aqorders.basketno = aqbasket.basketno AND
 746                         (closedate < (CURDATE( )-(INTERVAL $delay DAY))) AND (datereceived = '' or datereceived is null))
 747                         ";
 748     }
 749
 750     #   warn "C4::Acquisition getsupplierlistwithlateorders : ".$strsth;
 751     my $sth = $dbh->prepare($strsth);
 752     $sth->execute;
 753     my %supplierlist;
 754     while ( my ( $id, $name ) = $sth->fetchrow ) {
 755         $supplierlist{$id} = $name;
 756     }
 757     return %supplierlist;
 758 }
 759
 760 =item getlateorders
 761
 762   %results = &getlateorders;
 763
 764 Searches for suppliers with late orders.
 765
 766 =cut
 767
 768 #'
 769 sub getlateorders {
 770     my $delay      = shift;
 771     my $supplierid = shift;
 772     my $branch     = shift;
 773
 774     my $dbh = C4::Context->dbh;
 775
 776     #BEWARE, order of parenthesis and LEFT JOIN is important for speed
 777     my $strsth;
 778     my $dbdriver = C4::Context->config("db_scheme") || "mysql";
 779
 780     #   warn " $dbdriver";
 781     if ( $dbdriver eq "mysql" ) {
 782         $strsth = "SELECT aqbasket.basketno,
 783                                         DATE(aqbasket.closedate) as orderdate, aqorders.quantity - IFNULL(aqorders.quantityreceived,0) as quantity, aqorders.rrp as unitpricesupplier,aqorders.ecost as unitpricelib,
 784                                         (aqorders.quantity - IFNULL(aqorders.quantityreceived,0)) * aqorders.rrp as subtotal, aqbookfund.bookfundname as budget, borrowers.branchcode as branch,
 785                                         aqbooksellers.name as supplier,
 786                                         aqorders.title, biblio.author, biblioitems.publishercode as publisher, biblioitems.publicationyear,
 787                                         DATEDIFF(CURDATE( ),closedate) AS latesince
 788                                         FROM
 789                                                 ((      (
 790                                                                 (aqorders LEFT JOIN biblio on biblio.biblionumber = aqorders.biblionumber) LEFT JOIN biblioitems on  biblioitems.biblionumber=biblio.biblionumber
 791                                                         )  LEFT JOIN aqorderbreakdown on aqorders.ordernumber = aqorderbreakdown.ordernumber
 792                                                 ) LEFT JOIN aqbookfund on aqorderbreakdown.bookfundid = aqbookfund.bookfundid
 793                                                 ),(aqbasket LEFT JOIN borrowers on aqbasket.authorisedby = borrowers.borrowernumber) LEFT JOIN aqbooksellers ON aqbasket.booksellerid = aqbooksellers.id
 794                                         WHERE aqorders.basketno = aqbasket.basketno AND (closedate < DATE_SUB(CURDATE( ),INTERVAL $delay DAY))
 795                                         AND ((datereceived = '' OR datereceived is null) OR (aqorders.quantityreceived < aqorders.quantity) ) ";
 796         $strsth .= " AND aqbasket.booksellerid = $supplierid " if ($supplierid);
 797         $strsth .= " AND borrowers.branchcode like \'" . $branch . "\'"
 798           if ($branch);
 799         $strsth .=
 800           " AND borrowers.branchcode like \'"
 801           . C4::Context->userenv->{branch} . "\'"
 802           if ( C4::Context->preference("IndependantBranches")
 803             && C4::Context->userenv
 804             && C4::Context->userenv->{flags} != 1 );
 805         $strsth .=
 806 " HAVING quantity<>0 AND unitpricesupplier<>0 AND unitpricelib<>0 ORDER BY latesince,basketno,borrowers.branchcode, supplier ";
 807     }
 808     else {
 809         $strsth = "SELECT aqbasket.basketno,
 810                                         DATE(aqbasket.closedate) as orderdate,
 811                                         aqorders.quantity, aqorders.rrp as unitpricesupplier,aqorders.ecost as unitpricelib, aqorders.quantity * aqorders.rrp as subtotal
 812                                         aqbookfund.bookfundname as budget, borrowers.branchcode as branch,
 813                                         aqbooksellers.name as supplier,
 814                                         biblio.title, biblio.author, biblioitems.publishercode as publisher, biblioitems.publicationyear,
 815                                         (CURDATE -  closedate) AS latesince
 816                                         FROM
 817                                                 ((      (
 818                                                                 (aqorders LEFT JOIN biblio on biblio.biblionumber = aqorders.biblionumber) LEFT JOIN biblioitems on  biblioitems.biblionumber=biblio.biblionumber
 819                                                         )  LEFT JOIN aqorderbreakdown on aqorders.ordernumber = aqorderbreakdown.ordernumber
 820                                                 ) LEFT JOIN aqbookfund on aqorderbreakdown.bookfundid = aqbookfund.bookfundid
 821                                                 ),(aqbasket LEFT JOIN borrowers on aqbasket.authorisedby = borrowers.borrowernumber) LEFT JOIN aqbooksellers ON aqbasket.booksellerid = aqbooksellers.id
 822                                         WHERE aqorders.basketno = aqbasket.basketno AND (closedate < (CURDATE -(INTERVAL $delay DAY))
 823                                         AND ((datereceived = '' OR datereceived is null) OR (aqorders.quantityreceived < aqorders.quantity) ) ";
 824         $strsth .= " AND aqbasket.booksellerid = $supplierid " if ($supplierid);
 825         $strsth .= " AND borrowers.branchcode like \'" . $branch . "\'"
 826           if ($branch);
 827         $strsth .=
 828           " AND borrowers.branchcode like \'"
 829           . C4::Context->userenv->{branch} . "\'"
 830           if ( C4::Context->preference("IndependantBranches")
 831             && C4::Context->userenv->{flags} != 1 );
 832         $strsth .=
 833           " ORDER BY latesince,basketno,borrowers.branchcode, supplier";
 834     }
 835     warn "C4::Acquisition : getlateorders SQL:" . $strsth;
 836     my $sth = $dbh->prepare($strsth);
 837     $sth->execute;
 838     my @results;
 839     my $hilighted = 1;
 840     while ( my $data = $sth->fetchrow_hashref ) {
 841         $data->{hilighted} = $hilighted if ( $hilighted > 0 );
 842         $data->{orderdate} = format_date( $data->{orderdate} );
 843         push @results, $data;
 844         $hilighted = -$hilighted;
 845     }
 846     $sth->finish;
 847     return ( scalar(@results), @results );
 848 }
 849
 850 # FIXME - Never used
 851 sub getrecorders {
 852
 853     #gets all orders from a certain supplier, orders them alphabetically
 854     my ($supid) = @_;
 855     my $dbh     = C4::Context->dbh;
 856     my @results = ();
 857     my $sth     = $dbh->prepare(
 858         "Select * from aqorders,biblio,biblioitems where booksellerid=?
 859   and (cancelledby is NULL or cancelledby = '')
 860   and biblio.biblionumber=aqorders.biblionumber and biblioitems.biblioitemnumber=
 861   aqorders.biblioitemnumber and
 862   aqorders.quantityreceived>0
 863   and aqorders.datereceived >=now()
 864   group by aqorders.biblioitemnumber
 865   order by
 866   biblio.title"
 867     );
 868     $sth->execute($supid);
 869     while ( my $data = $sth->fetchrow_hashref ) {
 870         push( @results, $data );
 871     }
 872     $sth->finish;
 873     return ( scalar(@results), @results );
 874 }
 875
 876 =item ordersearch
 877
 878   ($count, @results) = &ordersearch($search, $biblionumber, $complete);
 879
 880 Searches for orders.
 881
 882 C<$search> may take one of several forms: if it is an ISBN,
 883 C<&ordersearch> returns orders with that ISBN. If C<$search> is an
 884 order number, C<&ordersearch> returns orders with that order number
 885 and biblionumber C<$biblionumber>. Otherwise, C<$search> is considered
 886 to be a space-separated list of search terms; in this case, all of the
 887 terms must appear in the title (matching the beginning of title
 888 words).
 889
 890 If C<$complete> is C<yes>, the results will include only completed
 891 orders. In any case, C<&ordersearch> ignores cancelled orders.
 892
 893 C<&ordersearch> returns an array. C<$count> is the number of elements
 894 in C<@results>. C<@results> is an array of references-to-hash with the
 895 following keys:
 896
 897 =over 4
 898
 899 =item C<author>
 900
 901 =item C<seriestitle>
 902
 903 =item C<branchcode>
 904
 905 =item C<bookfundid>
 906
 907 =back
 908
 909 =cut
 910
 911 #'
 912 sub ordersearch {
 913     my ( $search, $id, $biblio, $catview ) = @_;
 914     my $dbh = C4::Context->dbh;
 915     my @data = split( ' ', $search );
 916     my @searchterms;
 917     if ($id) {
 918         @searchterms = ($id);
 919     }
 920     map { push( @searchterms, "$_%", "% $_%" ) } @data;
 921     push( @searchterms, $search, $search, $biblio );
 922     my $query;
 923     if ($id) {
 924         $query =
 925           "SELECT *,biblio.title FROM aqorders,biblioitems,biblio,aqbasket
 926   WHERE aqorders.biblioitemnumber = biblioitems.biblioitemnumber AND
 927   aqorders.basketno = aqbasket.basketno
 928   AND aqbasket.booksellerid = ?
 929   AND biblio.biblionumber=aqorders.biblionumber
 930   AND ((datecancellationprinted is NULL)
 931       OR (datecancellationprinted = '0000-00-00'))
 932   AND (("
 933           . (
 934             join( " AND ",
 935                 map { "(biblio.title like ? or biblio.title like ?)" } @data )
 936           )
 937           . ") OR biblioitems.isbn=? OR (aqorders.ordernumber=? AND aqorders.biblionumber=?)) ";
 938
 939     }
 940     else {
 941         $query =
 942           "SELECT *,biblio.title FROM aqorders,biblioitems,biblio,aqbasket
 943   WHERE aqorders.biblioitemnumber = biblioitems.biblioitemnumber AND
 944   aqorders.basketno = aqbasket.basketno
 945   AND biblio.biblionumber=aqorders.biblionumber
 946   AND ((datecancellationprinted is NULL)
 947       OR (datecancellationprinted = '0000-00-00'))
 948   AND (aqorders.quantityreceived < aqorders.quantity OR aqorders.quantityreceived is NULL)
 949   AND (("
 950           . (
 951             join( " AND ",
 952                 map { "(biblio.title like ? OR biblio.title like ?)" } @data )
 953           )
 954           . ") or biblioitems.isbn=? OR (aqorders.ordernumber=? AND aqorders.biblionumber=?)) ";
 955     }
 956     $query .= " GROUP BY aqorders.ordernumber";
 957     my $sth = $dbh->prepare($query);
 958     $sth->execute(@searchterms);
 959     my @results = ();
 960     my $sth2    = $dbh->prepare("SELECT * FROM biblio WHERE biblionumber=?");
 961     my $sth3    =
 962       $dbh->prepare("SELECT * FROM aqorderbreakdown WHERE ordernumber=?");
 963     while ( my $data = $sth->fetchrow_hashref ) {
 964         $sth2->execute( $data->{'biblionumber'} );
 965         my $data2 = $sth2->fetchrow_hashref;
 966         $data->{'author'}      = $data2->{'author'};
 967         $data->{'seriestitle'} = $data2->{'seriestitle'};
 968         $sth3->execute( $data->{'ordernumber'} );
 969         my $data3 = $sth3->fetchrow_hashref;
 970         $data->{'branchcode'} = $data3->{'branchcode'};
 971         $data->{'bookfundid'} = $data3->{'bookfundid'};
 972         push( @results, $data );
 973     }
 974     $sth->finish;
 975     $sth2->finish;
 976     $sth3->finish;
 977     return ( scalar(@results), @results );
 978 }
 979
 980 sub histsearch {
 981     my ( $title, $author, $name, $from_placed_on, $to_placed_on ) = @_;
 982     my @order_loop;
 983     my $total_qty         = 0;
 984     my $total_qtyreceived = 0;
 985     my $total_price       = 0;
 986
 987 # don't run the query if there are no parameters (list would be too long for sure !
 988     if ( $title || $author || $name || $from_placed_on || $to_placed_on ) {
 989         my $dbh   = C4::Context->dbh;
 990         my $query =
 991 "select biblio.title,biblio.author,aqorders.basketno,name,aqbasket.creationdate,aqorders.datereceived, aqorders.quantity, aqorders.quantityreceived, aqorders.ecost from aqorders,aqbasket,aqbooksellers,biblio";
 992         $query .= ",borrowers "
 993           if ( C4::Context->preference("IndependantBranches") );
 994         $query .=
 995 " where aqorders.basketno=aqbasket.basketno and aqbasket.booksellerid=aqbooksellers.id and biblio.biblionumber=aqorders.biblionumber ";
 996         $query .= " and aqbasket.authorisedby=borrowers.borrowernumber"
 997           if ( C4::Context->preference("IndependantBranches") );
 998         $query .= " and biblio.title like " . $dbh->quote( "%" . $title . "%" )
 999           if $title;
1000         $query .=
1001           " and biblio.author like " . $dbh->quote( "%" . $author . "%" )
1002           if $author;
1003         $query .= " and name like " . $dbh->quote( "%" . $name . "%" ) if $name;
1004         $query .= " and creationdate >" . $dbh->quote($from_placed_on)
1005           if $from_placed_on;
1006         $query .= " and creationdate<" . $dbh->quote($to_placed_on)
1007           if $to_placed_on;
1008
1009         if ( C4::Context->preference("IndependantBranches") ) {
1010             my $userenv = C4::Context->userenv;
1011             if ( ($userenv) && ( $userenv->{flags} != 1 ) ) {
1012                 $query .=
1013                     " and (borrowers.branchcode = '"
1014                   . $userenv->{branch}
1015                   . "' or borrowers.branchcode ='')";
1016             }
1017         }
1018         $query .= " order by booksellerid";
1019         warn "query histearch: " . $query;
1020         my $sth = $dbh->prepare($query);
1021         $sth->execute;
1022         my $cnt = 1;
1023         while ( my $line = $sth->fetchrow_hashref ) {
1024             $line->{count} = $cnt++;
1025             $line->{toggle} = 1 if $cnt % 2;
1026             push @order_loop, $line;
1027             $line->{creationdate} = format_date( $line->{creationdate} );
1028             $line->{datereceived} = format_date( $line->{datereceived} );
1029             $total_qty         += $line->{'quantity'};
1030             $total_qtyreceived += $line->{'quantityreceived'};
1031             $total_price       += $line->{'quantity'} * $line->{'ecost'};
1032         }
1033     }
1034     return \@order_loop, $total_qty, $total_price, $total_qtyreceived;
1035 }
1036
1037 #
1038 #
1039 # MONEY
1040 #
1041 #
1042
1043 =item invoice
1044
1045   ($count, @results) = &invoice($booksellerinvoicenumber);
1046
1047 Looks up orders by invoice number.
1048
1049 Returns an array. C<$count> is the number of elements in C<@results>.
1050 C<@results> is an array of references-to-hash; the keys of each
1051 elements are fields from the aqorders, biblio, and biblioitems tables
1052 of the Koha database.
1053
1054 =cut
1055
1056 #'
1057 sub invoice {
1058     my ($invoice) = @_;
1059     my $dbh       = C4::Context->dbh;
1060     my @results   = ();
1061     my $sth       = $dbh->prepare(
1062         "Select * from aqorders,biblio,biblioitems where
1063   booksellerinvoicenumber=?
1064   and biblio.biblionumber=aqorders.biblionumber and biblioitems.biblioitemnumber=
1065   aqorders.biblioitemnumber group by aqorders.ordernumber,aqorders.biblioitemnumber"
1066     );
1067     $sth->execute($invoice);
1068     while ( my $data = $sth->fetchrow_hashref ) {
1069         push( @results, $data );
1070     }
1071     $sth->finish;
1072     return ( scalar(@results), @results );
1073 }
1074
1075 =item bookfunds
1076
1077   ($count, @results) = &bookfunds();
1078
1079 Returns a list of all book funds.
1080
1081 C<$count> is the number of elements in C<@results>. C<@results> is an
1082 array of references-to-hash, whose keys are fields from the aqbookfund
1083 and aqbudget tables of the Koha database. Results are ordered
1084 alphabetically by book fund name.
1085
1086 =cut
1087
1088 #'
1089 sub bookfunds {
1090     my ($branch) = @_;
1091     my $dbh      = C4::Context->dbh;
1092     my $userenv  = C4::Context->userenv;
1093     my $branch   = $userenv->{branch};
1094     my $strsth;
1095
1096     if ( $branch ne '' ) {
1097         $strsth = "SELECT * FROM aqbookfund,aqbudget WHERE aqbookfund.bookfundid
1098       =aqbudget.bookfundid AND startdate<now() AND enddate>now() AND (aqbookfund.branchcode is null or aqbookfund.branchcode='' or aqbookfund.branchcode= ? )
1099       GROUP BY aqbookfund.bookfundid ORDER BY bookfundname";
1100     }
1101     else {
1102         $strsth = "SELECT * FROM aqbookfund,aqbudget WHERE aqbookfund.bookfundid
1103       =aqbudget.bookfundid AND startdate<now() AND enddate>now()
1104       GROUP BY aqbookfund.bookfundid ORDER BY bookfundname";
1105     }
1106     my $sth = $dbh->prepare($strsth);
1107     if ( $branch ne '' ) {
1108         $sth->execute($branch);
1109     }
1110     else {
1111         $sth->execute;
1112     }
1113     my @results = ();
1114     while ( my $data = $sth->fetchrow_hashref ) {
1115         push( @results, $data );
1116     }
1117     $sth->finish;
1118     return ( scalar(@results), @results );
1119 }
1120
1121 =item bookfundbreakdown
1122
1123         returns the total comtd & spent for a given bookfund, and a given year
1124         used in acqui-home.pl
1125 =cut
1126
1127 #'
1128
1129 sub bookfundbreakdown {
1130     my ( $id, $year ,$start, $end) = @_;
1131     my $dbh = C4::Context->dbh;
1132     my $sth = $dbh->prepare(
1133         "SELECT quantity,datereceived,freight,unitprice,listprice,ecost,
1134   quantityreceived,subscription
1135   FROM aqorders,aqorderbreakdown WHERE bookfundid=? AND
1136   aqorders.ordernumber=aqorderbreakdown.ordernumber
1137   AND (datecancellationprinted is NULL OR
1138       datecancellationprinted='0000-00-00')"
1139     );
1140     if ($start) {
1141         $sth = $dbh->prepare(
1142             "SELECT quantity,datereceived,freight,unitprice,listprice,ecost,
1143   quantityreceived,subscription
1144   FROM aqorders,aqorderbreakdown
1145   WHERE bookfundid=? AND
1146   aqorders.ordernumber=aqorderbreakdown.ordernumber
1147   AND (datecancellationprinted is NULL OR
1148      datecancellationprinted='0000-00-00')
1149   AND ((datereceived >= ? AND datereceived < ?) OR
1150  (budgetdate >= ? AND budgetdate < ?))"
1151         );
1152         $sth->execute( $id, $start, $end, $start, $end );
1153     }
1154     else {
1155         $sth->execute($id);
1156     }
1157
1158     my $comtd = 0;
1159     my $spent = 0;
1160     while ( my $data = $sth->fetchrow_hashref ) {
1161
1162         if ( $data->{'subscription'} == 1 ) {
1163             $spent += $data->{'quantity'} * $data->{'unitprice'};
1164         }
1165         else {
1166             my $leftover = $data->{'quantity'} - $data->{'quantityreceived'};
1167             $comtd += ( $data->{'ecost'} ) * $leftover;
1168             $spent += ( $data->{'unitprice'} ) * $data->{'quantityreceived'};
1169         }
1170     }
1171     $sth->finish;
1172     return ( $spent, $comtd );
1173 }
1174
1175 =item curconvert
1176
1177   $foreignprice = &curconvert($currency, $localprice);
1178
1179 Converts the price C<$localprice> to foreign currency C<$currency> by
1180 dividing by the exchange rate, and returns the result.
1181
1182 If no exchange rate is found, C<&curconvert> assumes the rate is one
1183 to one.
1184
1185 =cut
1186
1187 #'
1188 sub curconvert {
1189     my ( $currency, $price ) = @_;
1190     my $dbh = C4::Context->dbh;
1191     my $sth = $dbh->prepare("Select rate from currency where currency=?");
1192     $sth->execute($currency);
1193     my $cur = ( $sth->fetchrow_array() )[0];
1194     $sth->finish;
1195     if ( $cur == 0 ) {
1196         $cur = 1;
1197     }
1198     return ( $price / $cur );
1199 }
1200
1201 =item getcurrencies
1202
1203   ($count, $currencies) = &getcurrencies();
1204
1205 Returns the list of all known currencies.
1206
1207 C<$count> is the number of elements in C<$currencies>. C<$currencies>
1208 is a reference-to-array; its elements are references-to-hash, whose
1209 keys are the fields from the currency table in the Koha database.
1210
1211 =cut
1212
1213 #'
1214 sub getcurrencies {
1215     my $dbh = C4::Context->dbh;
1216     my $sth = $dbh->prepare("Select * from currency");
1217     $sth->execute;
1218     my @results = ();
1219     while ( my $data = $sth->fetchrow_hashref ) {
1220         push( @results, $data );
1221     }
1222     $sth->finish;
1223     return ( scalar(@results), \@results );
1224 }
1225
1226 =item updatecurrencies
1227
1228   &updatecurrencies($currency, $newrate);
1229
1230 Sets the exchange rate for C<$currency> to be C<$newrate>.
1231
1232 =cut
1233
1234 #'
1235 sub updatecurrencies {
1236     my ( $currency, $rate ) = @_;
1237     my $dbh = C4::Context->dbh;
1238     my $sth = $dbh->prepare("update currency set rate=? where currency=?");
1239     $sth->execute( $rate, $currency );
1240     $sth->finish;
1241 }
1242
1243 #
1244 #
1245 # OTHERS
1246 #
1247 #
1248
1249 =item bookseller
1250
1251   ($count, @results) = &bookseller($searchstring);
1252
1253 Looks up a book seller. C<$searchstring> may be either a book seller
1254 ID, or a string to look for in the book seller's name.
1255
1256 C<$count> is the number of elements in C<@results>. C<@results> is an
1257 array of references-to-hash, whose keys are the fields of of the
1258 aqbooksellers table in the Koha database.
1259
1260 =cut
1261
1262 #'
1263 sub bookseller {
1264     my ($searchstring) = @_;
1265     my $dbh            = C4::Context->dbh;
1266     my $sth            =
1267       $dbh->prepare("Select * from aqbooksellers where name like ? or id = ?");
1268     $sth->execute( "$searchstring%", $searchstring );
1269     my @results;
1270     while ( my $data = $sth->fetchrow_hashref ) {
1271         push( @results, $data );
1272     }
1273     $sth->finish;
1274     return ( scalar(@results), @results );
1275 }
1276
1277 =item breakdown
1278
1279   ($count, $results) = &breakdown($ordernumber);
1280
1281 Looks up an order by order ID, and returns its breakdown.
1282
1283 C<$count> is the number of elements in C<$results>. C<$results> is a
1284 reference-to-array; its elements are references-to-hash, whose keys
1285 are the fields of the aqorderbreakdown table in the Koha database.
1286
1287 =cut
1288
1289 #'
1290 sub breakdown {
1291     my ($id) = @_;
1292     my $dbh  = C4::Context->dbh;
1293     my $sth  =
1294       $dbh->prepare("Select * from aqorderbreakdown where ordernumber=?");
1295     $sth->execute($id);
1296     my @results = ();
1297     while ( my $data = $sth->fetchrow_hashref ) {
1298         push( @results, $data );
1299     }
1300     $sth->finish;
1301     return ( scalar(@results), \@results );
1302 }
1303
1304 =item branches
1305
1306   ($count, @results) = &branches();
1307
1308 Returns a list of all library branches.
1309
1310 C<$count> is the number of elements in C<@results>. C<@results> is an
1311 array of references-to-hash, whose keys are the fields of the branches
1312 table of the Koha database.
1313
1314 =cut
1315
1316 #'
1317 sub branches {
1318     my $dbh = C4::Context->dbh;
1319     my $sth;
1320     if (   C4::Context->preference("IndependantBranches")
1321         && ( C4::Context->userenv )
1322         && ( C4::Context->userenv->{flags} != 1 ) )
1323     {
1324         my $strsth = "Select * from branches ";
1325         $strsth .=
1326           " WHERE branchcode = "
1327           . $dbh->quote( C4::Context->userenv->{branch} );
1328         $strsth .= " order by branchname";
1329         warn "C4::Acquisition->branches : " . $strsth;
1330         $sth = $dbh->prepare($strsth);
1331     }
1332     else {
1333         $sth = $dbh->prepare("Select * from branches order by branchname");
1334     }
1335     my @results = ();
1336
1337     $sth->execute();
1338     while ( my $data = $sth->fetchrow_hashref ) {
1339         push( @results, $data );
1340     }    # while
1341
1342     $sth->finish;
1343     return ( scalar(@results), @results );
1344 }    # sub branches
1345
1346 =item updatesup
1347
1348   &updatesup($bookseller);
1349
1350 Updates the information for a given bookseller. C<$bookseller> is a
1351 reference-to-hash whose keys are the fields of the aqbooksellers table
1352 in the Koha database. It must contain entries for all of the fields.
1353 The entry to modify is determined by C<$bookseller-E<gt>{id}>.
1354
1355 The easiest way to get all of the necessary fields is to look up a
1356 book seller with C<&booksellers>, modify what's necessary, then call
1357 C<&updatesup> with the result.
1358
1359 =cut
1360
1361 #'
1362 sub updatesup {
1363     my ($data) = @_;
1364     my $dbh    = C4::Context->dbh;
1365     my $sth    = $dbh->prepare(
1366         "Update aqbooksellers set
1367    name=?,address1=?,address2=?,address3=?,address4=?,postal=?,
1368    phone=?,fax=?,url=?,contact=?,contpos=?,contphone=?,contfax=?,contaltphone=?,
1369    contemail=?,contnotes=?,active=?,
1370    listprice=?, invoiceprice=?,gstreg=?, listincgst=?,
1371    invoiceincgst=?, specialty=?,discount=?,invoicedisc=?,
1372    nocalc=?, notes=?
1373    where id=?");
1374    $sth->execute($data->{'name'},$data->{'address1'},$data->{'address2'},
1375    $data->{'address3'},$data->{'address4'},$data->{'postal'},$data->{'phone'},
1376    $data->{'fax'},$data->{'url'},$data->{'contact'},$data->{'contpos'},
1377    $data->{'contphone'},$data->{'contfax'},$data->{'contaltphone'},
1378    $data->{'contemail'},
1379    $data->{'contnotes'},$data->{'active'},$data->{'listprice'},
1380    $data->{'invoiceprice'},$data->{'gstreg'},$data->{'listincgst'},
1381    $data->{'invoiceincgst'},$data->{'specialty'},$data->{'discount'},
1382    $data->{'invoicedisc'},$data->{'nocalc'},$data->{'notes'},$data->{'id'});
1383    $sth->finish;
1384 }
1385
1386 =item insertsup
1387
1388   $id = &insertsup($bookseller);
1389
1390 Creates a new bookseller. C<$bookseller> is a reference-to-hash whose
1391 keys are the fields of the aqbooksellers table in the Koha database.
1392 All fields must be present.
1393
1394 Returns the ID of the newly-created bookseller.
1395
1396 =cut
1397
1398 #'
1399 sub insertsup {
1400     my ($data) = @_;
1401     my $dbh    = C4::Context->dbh;
1402     my $sth    = $dbh->prepare("Select max(id) from aqbooksellers");
1403     $sth->execute;
1404     my $data2 = $sth->fetchrow_hashref;
1405     $sth->finish;
1406     $data2->{'max(id)'}++;
1407     $sth = $dbh->prepare("Insert into aqbooksellers (id) values (?)");
1408     $sth->execute( $data2->{'max(id)'} );
1409     $sth->finish;
1410     $data->{'id'} = $data2->{'max(id)'};
1411     updatesup($data);
1412     return ( $data->{'id'} );
1413 }
1414
1415 =item getparcels
1416
1417   ($count, $results) = &getparcels($dbh, $bookseller, $order, $limit);
1418
1419 get a lists of parcels
1420 Returns the count of parcels returned and a pointer on a hash list containing parcel informations as such :
1421                 Creation date
1422                 Last operation
1423                 Number of biblio
1424                 Number of items
1425
1426
1427 =cut
1428
1429 #'
1430 sub getparcels {
1431     my ( $bookseller, $order, $code, $datefrom, $dateto, $limit ) = @_;
1432     my $dbh    = C4::Context->dbh;
1433     my $strsth =
1434 "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 ";
1435     $strsth .= "and aqorders.booksellerinvoicenumber like \"$code%\" "
1436       if ($code);
1437     $strsth .= "and datereceived >=" . $dbh->quote($datefrom) . " "
1438       if ($datefrom);
1439     $strsth .= "and datereceived <=" . $dbh->quote($dateto) . " " if ($dateto);
1440     $strsth .= "group by aqorders.booksellerinvoicenumber,datereceived ";
1441     $strsth .= "order by $order " if ($order);
1442     $strsth .= " LIMIT 0,$limit" if ($limit);
1443     my $sth = $dbh->prepare($strsth);
1444 ###     getparcels:  $strsth
1445     $sth->execute;
1446     my @results;
1447
1448     while ( my $data2 = $sth->fetchrow_hashref ) {
1449         push @results, $data2;
1450     }
1451
1452     $sth->finish;
1453     return ( scalar(@results), @results );
1454 }
1455
1456 =item getparcels
1457
1458   ($count, $results) = &getparcels($dbh, $bookseller, $order, $limit);
1459
1460 get a lists of parcels
1461 Returns the count of parcels returned and a pointer on a hash list containing parcel informations as such :
1462                 Creation date
1463                 Last operation
1464                 Number of biblio
1465                 Number of items
1466
1467
1468 =cut
1469 #'
1470 sub getparcels {
1471   my ($bookseller, $order, $code,$datefrom,$dateto, $limit)=@_;
1472         my $dbh = C4::Context->dbh;
1473         my $strsth = "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 ";
1474         $strsth .= "and aqorders.booksellerinvoicenumber like \"$code%\" " if ($code);
1475         $strsth .= "and datereceived >=".$dbh->quote($datefrom)." " if ($datefrom);
1476         $strsth .= "and datereceived <=".$dbh->quote($dateto)." " if ($dateto);
1477         $strsth .= "group by aqorders.booksellerinvoicenumber,datereceived ";
1478         $strsth .= "order by $order " if ($order);
1479         $strsth .= " LIMIT 0,$limit" if ($limit);
1480         my $sth=$dbh->prepare($strsth);
1481 ###     getparcels:  $strsth
1482         $sth->execute;
1483         my @results;
1484         while (my $data2=$sth->fetchrow_hashref) {
1485                 push @results, $data2;
1486         }
1487
1488    $sth->finish;
1489    return(scalar(@results), @results);
1490 }
1491
1492 END { }       # module clean-up code here (global destructor)
1493
1494 1;
1495 __END__
1496
1497 =back
1498
1499 =head1 AUTHOR
1500
1501 Koha Developement team <info@koha.org>
1502
1503 =cut