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