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     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 )
 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 eq '' ) ) {
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 eq '' ) ) {
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 startdate, enddate, quantity, datereceived, freight, unitprice, listprice, ecost, quantityreceived, subscription
1092 FROM aqorders, aqorderbreakdown, aqbudget, aqbasket
1093 WHERE aqorderbreakdown.bookfundid = ?
1094 AND aqorders.ordernumber = aqorderbreakdown.ordernumber
1095 AND (
1096 datecancellationprinted IS NULL
1097 OR datecancellationprinted = '0000-00-00'
1098 )
1099 AND aqbudget.bookfundid = aqorderbreakdown.bookfundid
1100 AND aqbasket.basketno = aqorders.basketno
1101 AND aqbasket.creationdate >= startdate
1102 AND enddate >= aqbasket.creationdate
1103 and startdate<=now() and enddate>=now()"
1104     );
1105     $sth->execute($id);
1106     my $comtd = 0;
1107     my $spent = 0;
1108     while ( my $data = $sth->fetchrow_hashref ) {
1109
1110         if ( $data->{'subscription'} == 1 ) {
1111             $spent += $data->{'quantity'} * $data->{'unitprice'};
1112         }
1113         else {
1114             my $leftover = $data->{'quantity'} - $data->{'quantityreceived'};
1115             $comtd += ( $data->{'ecost'} ) * $leftover;
1116             $spent += ( $data->{'unitprice'} ) * $data->{'quantityreceived'};
1117         }
1118     }
1119     $sth->finish;
1120     return ( $spent, $comtd );
1121 }
1122
1123 =item curconvert
1124
1125   $foreignprice = &curconvert($currency, $localprice);
1126
1127 Converts the price C<$localprice> to foreign currency C<$currency> by
1128 dividing by the exchange rate, and returns the result.
1129
1130 If no exchange rate is found, C<&curconvert> assumes the rate is one
1131 to one.
1132
1133 =cut
1134
1135 #'
1136 sub curconvert {
1137     my ( $currency, $price ) = @_;
1138     my $dbh = C4::Context->dbh;
1139     my $sth = $dbh->prepare("Select rate from currency where currency=?");
1140     $sth->execute($currency);
1141     my $cur = ( $sth->fetchrow_array() )[0];
1142     $sth->finish;
1143     if ( $cur == 0 ) {
1144         $cur = 1;
1145     }
1146     return ( $price / $cur );
1147 }
1148
1149 =item getcurrencies
1150
1151   ($count, $currencies) = &getcurrencies();
1152
1153 Returns the list of all known currencies.
1154
1155 C<$count> is the number of elements in C<$currencies>. C<$currencies>
1156 is a reference-to-array; its elements are references-to-hash, whose
1157 keys are the fields from the currency table in the Koha database.
1158
1159 =cut
1160
1161 #'
1162 sub getcurrencies {
1163     my $dbh = C4::Context->dbh;
1164     my $sth = $dbh->prepare("Select * from currency");
1165     $sth->execute;
1166     my @results = ();
1167     while ( my $data = $sth->fetchrow_hashref ) {
1168         push( @results, $data );
1169     }
1170     $sth->finish;
1171     return ( scalar(@results), \@results );
1172 }
1173
1174 =item updatecurrencies
1175
1176   &updatecurrencies($currency, $newrate);
1177
1178 Sets the exchange rate for C<$currency> to be C<$newrate>.
1179
1180 =cut
1181
1182 #'
1183 sub updatecurrencies {
1184     my ( $currency, $rate ) = @_;
1185     my $dbh = C4::Context->dbh;
1186     my $sth = $dbh->prepare("update currency set rate=? where currency=?");
1187     $sth->execute( $rate, $currency );
1188     $sth->finish;
1189 }
1190
1191 #
1192 #
1193 # OTHERS
1194 #
1195 #
1196
1197 =item bookseller
1198
1199   ($count, @results) = &bookseller($searchstring);
1200
1201 Looks up a book seller. C<$searchstring> may be either a book seller
1202 ID, or a string to look for in the book seller's name.
1203
1204 C<$count> is the number of elements in C<@results>. C<@results> is an
1205 array of references-to-hash, whose keys are the fields of of the
1206 aqbooksellers table in the Koha database.
1207
1208 =cut
1209
1210 #'
1211 sub bookseller {
1212     my ($searchstring) = @_;
1213     my $dbh            = C4::Context->dbh;
1214     my $sth            =
1215       $dbh->prepare("Select * from aqbooksellers where name like ? or id = ?");
1216     $sth->execute( "$searchstring%", $searchstring );
1217     my @results;
1218     while ( my $data = $sth->fetchrow_hashref ) {
1219         push( @results, $data );
1220     }
1221     $sth->finish;
1222     return ( scalar(@results), @results );
1223 }
1224
1225 =item breakdown
1226
1227   ($count, $results) = &breakdown($ordernumber);
1228
1229 Looks up an order by order ID, and returns its breakdown.
1230
1231 C<$count> is the number of elements in C<$results>. C<$results> is a
1232 reference-to-array; its elements are references-to-hash, whose keys
1233 are the fields of the aqorderbreakdown table in the Koha database.
1234
1235 =cut
1236
1237 #'
1238 sub breakdown {
1239     my ($id) = @_;
1240     my $dbh  = C4::Context->dbh;
1241     my $sth  =
1242       $dbh->prepare("Select * from aqorderbreakdown where ordernumber=?");
1243     $sth->execute($id);
1244     my @results = ();
1245     while ( my $data = $sth->fetchrow_hashref ) {
1246         push( @results, $data );
1247     }
1248     $sth->finish;
1249     return ( scalar(@results), \@results );
1250 }
1251
1252 =item branches
1253
1254   ($count, @results) = &branches();
1255
1256 Returns a list of all library branches.
1257
1258 C<$count> is the number of elements in C<@results>. C<@results> is an
1259 array of references-to-hash, whose keys are the fields of the branches
1260 table of the Koha database.
1261
1262 =cut
1263
1264 #'
1265 sub branches {
1266     my $dbh = C4::Context->dbh;
1267     my $sth;
1268     if (   C4::Context->preference("IndependantBranches")
1269         && ( C4::Context->userenv )
1270         && ( C4::Context->userenv->{flags} != 1 ) )
1271     {
1272         my $strsth = "Select * from branches ";
1273         $strsth .=
1274           " WHERE branchcode = "
1275           . $dbh->quote( C4::Context->userenv->{branch} );
1276         $strsth .= " order by branchname";
1277         warn "C4::Acquisition->branches : " . $strsth;
1278         $sth = $dbh->prepare($strsth);
1279     }
1280     else {
1281         $sth = $dbh->prepare("Select * from branches order by branchname");
1282     }
1283     my @results = ();
1284
1285     $sth->execute();
1286     while ( my $data = $sth->fetchrow_hashref ) {
1287         push( @results, $data );
1288     }    # while
1289
1290     $sth->finish;
1291     return ( scalar(@results), @results );
1292 }    # sub branches
1293
1294 =item updatesup
1295
1296   &updatesup($bookseller);
1297
1298 Updates the information for a given bookseller. C<$bookseller> is a
1299 reference-to-hash whose keys are the fields of the aqbooksellers table
1300 in the Koha database. It must contain entries for all of the fields.
1301 The entry to modify is determined by C<$bookseller-E<gt>{id}>.
1302
1303 The easiest way to get all of the necessary fields is to look up a
1304 book seller with C<&booksellers>, modify what's necessary, then call
1305 C<&updatesup> with the result.
1306
1307 =cut
1308
1309 #'
1310 sub updatesup {
1311     my ($data) = @_;
1312     my $dbh    = C4::Context->dbh;
1313     my $sth    = $dbh->prepare(
1314         "Update aqbooksellers set
1315    name=?,address1=?,address2=?,address3=?,address4=?,postal=?,
1316    phone=?,fax=?,url=?,contact=?,contpos=?,contphone=?,contfax=?,contaltphone=?,
1317    contemail=?,contnotes=?,active=?,
1318    listprice=?, invoiceprice=?,gstreg=?, listincgst=?,
1319    invoiceincgst=?, specialty=?,discount=?,invoicedisc=?,
1320    nocalc=?
1321    where id=?"
1322     );
1323     $sth->execute(
1324         $data->{'name'},         $data->{'address1'},
1325         $data->{'address2'},     $data->{'address3'},
1326         $data->{'address4'},     $data->{'postal'},
1327         $data->{'phone'},        $data->{'fax'},
1328         $data->{'url'},          $data->{'contact'},
1329         $data->{'contpos'},      $data->{'contphone'},
1330         $data->{'contfax'},      $data->{'contaltphone'},
1331         $data->{'contemail'},    $data->{'contnote'},
1332         $data->{'active'},       $data->{'listprice'},
1333         $data->{'invoiceprice'}, $data->{'gstreg'},
1334         $data->{'listincgst'},   $data->{'invoiceincgst'},
1335         $data->{'specialty'},    $data->{'discount'},
1336         $data->{'invoicedisc'},  $data->{'nocalc'},
1337         $data->{'id'}
1338     );
1339     $sth->finish;
1340 }
1341
1342 =item insertsup
1343
1344   $id = &insertsup($bookseller);
1345
1346 Creates a new bookseller. C<$bookseller> is a reference-to-hash whose
1347 keys are the fields of the aqbooksellers table in the Koha database.
1348 All fields must be present.
1349
1350 Returns the ID of the newly-created bookseller.
1351
1352 =cut
1353
1354 #'
1355 sub insertsup {
1356     my ($data) = @_;
1357     my $dbh    = C4::Context->dbh;
1358     my $sth    = $dbh->prepare("Select max(id) from aqbooksellers");
1359     $sth->execute;
1360     my $data2 = $sth->fetchrow_hashref;
1361     $sth->finish;
1362     $data2->{'max(id)'}++;
1363     $sth = $dbh->prepare("Insert into aqbooksellers (id) values (?)");
1364     $sth->execute( $data2->{'max(id)'} );
1365     $sth->finish;
1366     $data->{'id'} = $data2->{'max(id)'};
1367     updatesup($data);
1368     return ( $data->{'id'} );
1369 }
1370
1371 =item getparcels
1372
1373   ($count, $results) = &getparcels($dbh, $bookseller, $order, $limit);
1374
1375 get a lists of parcels
1376 Returns the count of parcels returned and a pointer on a hash list containing parcel informations as such :
1377                 Creation date
1378                 Last operation
1379                 Number of biblio
1380                 Number of items
1381
1382
1383 =cut
1384
1385 #'
1386 sub getparcels {
1387     my ( $bookseller, $order, $code, $datefrom, $dateto, $limit ) = @_;
1388     my $dbh    = C4::Context->dbh;
1389     my $strsth =
1390 "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 ";
1391     $strsth .= "and aqorders.booksellerinvoicenumber like \"$code%\" "
1392       if ($code);
1393     $strsth .= "and datereceived >=" . $dbh->quote($datefrom) . " "
1394       if ($datefrom);
1395     $strsth .= "and datereceived <=" . $dbh->quote($dateto) . " " if ($dateto);
1396     $strsth .= "group by aqorders.booksellerinvoicenumber,datereceived ";
1397     $strsth .= "order by $order " if ($order);
1398     $strsth .= " LIMIT 0,$limit" if ($limit);
1399     my $sth = $dbh->prepare($strsth);
1400 ###     getparcels:  $strsth
1401     $sth->execute;
1402     my @results;
1403
1404     while ( my $data2 = $sth->fetchrow_hashref ) {
1405         push @results, $data2;
1406     }
1407
1408     $sth->finish;
1409     return ( scalar(@results), @results );
1410 }
1411
1412 END { }    # module clean-up code here (global destructor)
1413
1414 1;
1415 __END__
1416
1417 =back
1418
1419 =head1 AUTHOR
1420
1421 Koha Developement team <info@koha.org>
1422
1423 =cut