C4/Acquisition.pm

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