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