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
  21 use strict;
  22 use C4::Context;
  23 use C4::Debug;
  24 use C4::Dates qw(format_date);
  25 use MARC::Record;
  26 use C4::Suggestions;
  27 use Time::localtime;
  28
  29 use vars qw($VERSION @ISA @EXPORT);
  30
  31 BEGIN {
  32         # set the version for version checking
  33         $VERSION = 3.01;
  34         require Exporter;
  35         @ISA    = qw(Exporter);
  36         @EXPORT = qw(
  37                 &GetBasket &NewBasket &CloseBasket
  38                 &GetPendingOrders &GetOrder &GetOrders
  39                 &GetOrderNumber &GetLateOrders &NewOrder &DelOrder
  40                 &SearchOrder &GetHistory &GetRecentAcqui
  41                 &ModOrder &ModReceiveOrder &ModOrderBiblioNumber
  42                 &GetParcels &GetParcel
  43         );
  44 }
  45
  46 # used in receiveorder subroutine
  47 # to provide library specific handling
  48 my $library_name = C4::Context->preference("LibraryName");
  49
  50 =head1 NAME
  51
  52 C4::Acquisition - Koha functions for dealing with orders and acquisitions
  53
  54 =head1 SYNOPSIS
  55
  56 use C4::Acquisition;
  57
  58 =head1 DESCRIPTION
  59
  60 The functions in this module deal with acquisitions, managing book
  61 orders, basket and parcels.
  62
  63 =head1 FUNCTIONS
  64
  65 =head2 FUNCTIONS ABOUT BASKETS
  66
  67 =head3 GetBasket
  68
  69 =over 4
  70
  71 $aqbasket = &GetBasket($basketnumber);
  72
  73 get all basket informations in aqbasket for a given basket
  74
  75 return :
  76 informations for a given basket returned as a hashref.
  77
  78 =back
  79
  80 =cut
  81
  82 sub GetBasket {
  83     my ($basketno) = @_;
  84     my $dbh        = C4::Context->dbh;
  85     my $query = "
  86         SELECT  aqbasket.*,
  87                 concat( b.firstname,' ',b.surname) AS authorisedbyname,
  88                 b.branchcode AS branch
  89         FROM    aqbasket
  90         LEFT JOIN borrowers b ON aqbasket.authorisedby=b.borrowernumber
  91         WHERE basketno=?
  92     ";
  93     my $sth=$dbh->prepare($query);
  94     $sth->execute($basketno);
  95     my $basket = $sth->fetchrow_hashref;
  96         return ( $basket );
  97 }
  98
  99 #------------------------------------------------------------#
 100
 101 =head3 NewBasket
 102
 103 =over 4
 104
 105 $basket = &NewBasket();
 106
 107 Create a new basket in aqbasket table
 108
 109 =back
 110
 111 =cut
 112
 113 # FIXME : this function seems to be unused.
 114
 115 sub NewBasket {
 116     my ( $booksellerid, $authorisedby ) = @_;
 117     my $dbh = C4::Context->dbh;
 118     my $query = "
 119         INSERT INTO aqbasket
 120                 (creationdate,booksellerid,authorisedby)
 121         VALUES  (now(),'$booksellerid','$authorisedby')
 122     ";
 123     my $sth =
 124       $dbh->do($query);
 125
 126 #find & return basketno MYSQL dependant, but $dbh->last_insert_id always returns null :-(
 127     my $basket = $dbh->{'mysql_insertid'};
 128     return $basket;
 129 }
 130
 131 #------------------------------------------------------------#
 132
 133 =head3 CloseBasket
 134
 135 =over 4
 136
 137 &CloseBasket($basketno);
 138
 139 close a basket (becomes unmodifiable,except for recieves)
 140
 141 =back
 142
 143 =cut
 144
 145 sub CloseBasket {
 146     my ($basketno) = @_;
 147     my $dbh        = C4::Context->dbh;
 148     my $query = "
 149         UPDATE aqbasket
 150         SET    closedate=now()
 151         WHERE  basketno=?
 152     ";
 153     my $sth = $dbh->prepare($query);
 154     $sth->execute($basketno);
 155 }
 156
 157 #------------------------------------------------------------#
 158
 159 =head2 FUNCTIONS ABOUT ORDERS
 160
 161 =cut
 162
 163 #------------------------------------------------------------#
 164
 165 =head3 GetPendingOrders
 166
 167 =over 4
 168
 169 $orders = &GetPendingOrders($booksellerid, $grouped);
 170
 171 Finds pending orders from the bookseller with the given ID. Ignores
 172 completed and cancelled orders.
 173
 174 C<$orders> is a reference-to-array; each element is a
 175 reference-to-hash with the following fields:
 176 C<$grouped> is a boolean that, if set to 1 will group all order lines of the same basket
 177 in a single result line
 178
 179 =over 2
 180
 181 =item C<authorizedby>
 182
 183 =item C<entrydate>
 184
 185 =item C<basketno>
 186
 187 These give the value of the corresponding field in the aqorders table
 188 of the Koha database.
 189
 190 =back
 191
 192 =back
 193
 194 Results are ordered from most to least recent.
 195
 196 =cut
 197
 198 sub GetPendingOrders {
 199     my ($supplierid,$grouped) = @_;
 200     my $dbh = C4::Context->dbh;
 201     my $strsth = "
 202         SELECT    ".($grouped?"count(*),":"")."aqbasket.basketno,
 203                     surname,firstname,aqorders.*,
 204                     aqbasket.closedate, aqbasket.creationdate
 205         FROM      aqorders
 206         LEFT JOIN aqbasket ON aqbasket.basketno=aqorders.basketno
 207         LEFT JOIN borrowers ON aqbasket.authorisedby=borrowers.borrowernumber
 208         WHERE booksellerid=?
 209             AND (quantity > quantityreceived OR quantityreceived is NULL)
 210             AND datecancellationprinted IS NULL
 211             AND (to_days(now())-to_days(closedate) < 180 OR closedate IS NULL)
 212     ";
 213     ## FIXME  Why 180 days ???
 214     my @query_params = ( $supplierid );
 215     if ( C4::Context->preference("IndependantBranches") ) {
 216         my $userenv = C4::Context->userenv;
 217         if ( ($userenv) && ( $userenv->{flags} != 1 ) ) {
 218             $strsth .= " and (borrowers.branchcode = ?
 219                           or borrowers.branchcode  = '')";
 220             push @query_params, $userenv->{branch};
 221         }
 222     }
 223     $strsth .= " group by aqbasket.basketno" if $grouped;
 224     $strsth .= " order by aqbasket.basketno";
 225
 226     my $sth = $dbh->prepare($strsth);
 227     $sth->execute( @query_params );
 228     my $results = $sth->fetchall_arrayref({});
 229     $sth->finish;
 230     return $results;
 231 }
 232
 233 #------------------------------------------------------------#
 234
 235 =head3 GetOrders
 236
 237 =over 4
 238
 239 @orders = &GetOrders($basketnumber, $orderby);
 240
 241 Looks up the pending (non-cancelled) orders with the given basket
 242 number. If C<$booksellerID> is non-empty, only orders from that seller
 243 are returned.
 244
 245 return :
 246 C<&basket> returns a two-element array. C<@orders> is an array of
 247 references-to-hash, whose keys are the fields from the aqorders,
 248 biblio, and biblioitems tables in the Koha database.
 249
 250 =back
 251
 252 =cut
 253
 254 sub GetOrders {
 255     my ( $basketno, $orderby ) = @_;
 256     my $dbh   = C4::Context->dbh;
 257     my $query  ="
 258          SELECT  aqorderbreakdown.*,
 259                 biblio.*,biblioitems.*,
 260                 aqorders.*,
 261                 aqbookfund.bookfundname,
 262                 biblio.title
 263         FROM    aqorders
 264             LEFT JOIN aqorderbreakdown ON aqorders.ordernumber=aqorderbreakdown.ordernumber
 265             LEFT JOIN aqbookfund       ON aqbookfund.bookfundid=aqorderbreakdown.bookfundid
 266             LEFT JOIN biblio           ON biblio.biblionumber=aqorders.biblionumber
 267             LEFT JOIN biblioitems      ON biblioitems.biblionumber=biblio.biblionumber
 268         WHERE   basketno=?
 269             AND (datecancellationprinted IS NULL OR datecancellationprinted='0000-00-00')
 270     ";
 271
 272     $orderby = "biblioitems.publishercode,biblio.title" unless $orderby;
 273     $query .= " ORDER BY $orderby";
 274     my $sth = $dbh->prepare($query);
 275     $sth->execute($basketno);
 276     my @results;
 277
 278     while ( my $data = $sth->fetchrow_hashref ) {
 279         push @results, $data;
 280     }
 281     $sth->finish;
 282     return @results;
 283 }
 284
 285 #------------------------------------------------------------#
 286
 287 =head3 GetOrderNumber
 288
 289 =over 4
 290
 291 $ordernumber = &GetOrderNumber($biblioitemnumber, $biblionumber);
 292
 293 =back
 294
 295 Looks up the ordernumber with the given biblionumber and biblioitemnumber.
 296
 297 Returns the number of this order.
 298
 299 =over 4
 300
 301 =item C<$ordernumber> is the order number.
 302
 303 =back
 304
 305 =cut
 306 sub GetOrderNumber {
 307     my ( $biblionumber,$biblioitemnumber ) = @_;
 308     my $dbh = C4::Context->dbh;
 309     my $query = "
 310         SELECT ordernumber
 311         FROM   aqorders
 312         WHERE  biblionumber=?
 313         AND    biblioitemnumber=?
 314     ";
 315     my $sth = $dbh->prepare($query);
 316     $sth->execute( $biblionumber, $biblioitemnumber );
 317
 318     return $sth->fetchrow;
 319 }
 320
 321 #------------------------------------------------------------#
 322
 323 =head3 GetOrder
 324
 325 =over 4
 326
 327 $order = &GetOrder($ordernumber);
 328
 329 Looks up an order by order number.
 330
 331 Returns a reference-to-hash describing the order. The keys of
 332 C<$order> are fields from the biblio, biblioitems, aqorders, and
 333 aqorderbreakdown tables of the Koha database.
 334
 335 =back
 336
 337 =cut
 338
 339 sub GetOrder {
 340     my ($ordnum) = @_;
 341     my $dbh      = C4::Context->dbh;
 342     my $query = "
 343         SELECT biblioitems.*, biblio.*, aqorderbreakdown.*, aqorders.*
 344         FROM   aqorders
 345         LEFT JOIN aqorderbreakdown ON aqorders.ordernumber=aqorderbreakdown.ordernumber
 346         LEFT JOIN biblio on           biblio.biblionumber=aqorders.biblionumber
 347         LEFT JOIN biblioitems on       biblioitems.biblionumber=aqorders.biblionumber
 348         WHERE aqorders.ordernumber=?
 349
 350     ";
 351     my $sth= $dbh->prepare($query);
 352     $sth->execute($ordnum);
 353     my $data = $sth->fetchrow_hashref;
 354     $sth->finish;
 355     return $data;
 356 }
 357
 358 #------------------------------------------------------------#
 359
 360 =head3 NewOrder
 361
 362 =over 4
 363
 364   &NewOrder($basket, $biblionumber, $title, $quantity, $listprice,
 365     $booksellerid, $who, $notes, $bookfund, $biblioitemnumber, $rrp,
 366     $ecost, $gst, $budget, $unitprice, $subscription,
 367     $booksellerinvoicenumber, $purchaseorder, $branchcode);
 368
 369 Adds a new order to the database. Any argument that isn't described
 370 below is the new value of the field with the same name in the aqorders
 371 table of the Koha database.
 372
 373 C<$ordnum> is a "minimum order number." After adding the new entry to
 374 the aqorders table, C<&neworder> finds the first entry in aqorders
 375 with order number greater than or equal to C<$ordnum>, and adds an
 376 entry to the aqorderbreakdown table, with the order number just found,
 377 and the book fund ID of the newly-added order.
 378
 379 C<$budget> is effectively ignored.
 380   If it's undef (anything false) or the string 'now', the current day is used.
 381   Else, the upcoming July 1st is used.
 382
 383 C<$subscription> may be either "yes", or anything else for "no".
 384
 385 =back
 386
 387 =cut
 388
 389 sub NewOrder {
 390    my (
 391         $basketno,  $bibnum,       $title,        $quantity,
 392         $listprice, $booksellerid, $authorisedby, $notes,
 393         $bookfund,  $bibitemnum,   $rrp,          $ecost,
 394         $gst,       $budget,       $cost,         $sub,
 395         $invoice,   $sort1,        $sort2,        $purchaseorder,
 396                 $branchcode
 397       )
 398       = @_;
 399
 400     my $year  = localtime->year() + 1900;
 401     my $month = localtime->mon() + 1;       # months starts at 0, add 1
 402
 403     if ( !$budget || $budget eq 'now' ) {
 404         $budget = undef;
 405     }
 406
 407     # if month is july or more, budget start is 1 jul, next year.
 408     elsif ( $month >= '7' ) {
 409         ++$year;                            # add 1 to year , coz its next year
 410         $budget = "$year-07-01";
 411     }
 412     else {
 413
 414         # START OF NEW BUDGET, 1ST OF JULY, THIS YEAR
 415         $budget = "$year-07-01";
 416     }
 417
 418     if ( $sub eq 'yes' ) {
 419         $sub = 1;
 420     }
 421     else {
 422         $sub = 0;
 423     }
 424
 425     # if $basket empty, it's also a new basket, create it
 426     unless ($basketno) {
 427         $basketno = NewBasket( $booksellerid, $authorisedby );
 428     }
 429
 430     my $dbh = C4::Context->dbh;
 431     my $query = "
 432         INSERT INTO aqorders
 433            ( biblionumber, title,            basketno, quantity, listprice,
 434              notes,        biblioitemnumber, rrp,      ecost,    gst,
 435              unitprice,    subscription,     sort1,    sort2,    budgetdate,
 436              entrydate,    purchaseordernumber)
 437         VALUES ( ?,?,?,?,?,?,?,?,?,?,?,?,?,?,COALESCE(?,NOW()),NOW(),? )
 438     ";
 439     my $sth = $dbh->prepare($query);
 440
 441     $sth->execute(
 442         $bibnum, $title,      $basketno, $quantity, $listprice,
 443         $notes,  $bibitemnum, $rrp,      $ecost,    $gst,
 444         $cost,   $sub,        $sort1,    $sort2,    $budget,
 445                  $purchaseorder
 446     );
 447     $sth->finish;
 448
 449     #get ordnum MYSQL dependant, but $dbh->last_insert_id returns null
 450     my $ordnum = $dbh->{'mysql_insertid'};
 451     $query = "
 452         INSERT INTO aqorderbreakdown (ordernumber,bookfundid, branchcode)
 453         VALUES (?,?,?)
 454     ";
 455     $sth = $dbh->prepare($query);
 456     $sth->execute( $ordnum, $bookfund, $branchcode );
 457     $sth->finish;
 458     return ( $basketno, $ordnum );
 459 }
 460
 461 #------------------------------------------------------------#
 462
 463 =head3 ModOrder
 464
 465 =over 4
 466
 467 &ModOrder($title, $ordernumber, $quantity, $listprice,
 468     $biblionumber, $basketno, $supplier, $who, $notes,
 469     $bookfundid, $bibitemnum, $rrp, $ecost, $gst, $budget,
 470     $unitprice, $booksellerinvoicenumber, $branchcode);
 471
 472 Modifies an existing order. Updates the order with order number
 473 C<$ordernumber> and biblionumber C<$biblionumber>. All other arguments
 474 update the fields with the same name in the aqorders table of the Koha
 475 database.
 476
 477 Entries with order number C<$ordernumber> in the aqorderbreakdown
 478 table are also updated to the new book fund ID or branchcode.
 479
 480 =back
 481
 482 =cut
 483
 484 sub ModOrder {
 485     my (
 486         $title,      $ordnum,   $quantity, $listprice, $bibnum,
 487         $basketno,   $supplier, $who,      $notes,     $bookfund,
 488         $bibitemnum, $rrp,      $ecost,    $gst,       $budget,
 489         $cost,       $invoice,  $sort1,    $sort2,     $purchaseorder, $branchcode
 490       )
 491       = @_;
 492  # FIXME : Refactor to pass a hashref instead of fifty params.
 493     my $dbh = C4::Context->dbh;
 494     my $query = "
 495         UPDATE aqorders
 496         SET    title=?,
 497                quantity=?,listprice=?,basketno=?,
 498                rrp=?,ecost=?,unitprice=?,booksellerinvoicenumber=?,
 499                notes=?,sort1=?, sort2=?, purchaseordernumber=?
 500         WHERE  ordernumber=? AND biblionumber=?
 501     ";
 502     my $sth = $dbh->prepare($query);
 503     $sth->execute(
 504         $title, $quantity, $listprice, $basketno, $rrp,
 505         $ecost, $cost,     $invoice,   $notes,    $sort1,
 506         $sort2, $purchaseorder,
 507                 $ordnum,   $bibnum
 508     );
 509     $sth->finish;
 510     $query = "
 511         UPDATE aqorderbreakdown
 512         SET    bookfundid=?,branchcode=?
 513         WHERE  ordernumber=?
 514     ";
 515     $sth = $dbh->prepare($query);
 516
 517     my $rv = $sth->execute( $bookfund,$branchcode, $ordnum );
 518     unless($rv && ( $rv ne '0E0' ))   {    # zero rows affected [Bug 734]
 519         my $query ="
 520             INSERT INTO aqorderbreakdown
 521                      (ordernumber,branchcode,bookfundid)
 522             VALUES   (?,?,?)
 523         ";
 524         $sth = $dbh->prepare($query);
 525         $sth->execute( $ordnum,$branchcode, $bookfund );
 526     }
 527     $sth->finish;
 528 }
 529
 530 #------------------------------------------------------------#
 531
 532 =head3 ModOrderBiblioNumber
 533
 534 =over 4
 535
 536 &ModOrderBiblioNumber($biblioitemnumber,$ordnum, $biblionumber);
 537
 538 Modifies the biblioitemnumber for an existing order.
 539 Updates the order with order number C<$ordernum> and biblionumber C<$biblionumber>.
 540
 541 =back
 542
 543 =cut
 544
 545 sub ModOrderBiblioNumber {
 546     my ($biblioitemnumber,$ordnum, $biblionumber) = @_;
 547     my $dbh = C4::Context->dbh;
 548     my $query = "
 549       UPDATE aqorders
 550       SET    biblioitemnumber = ?
 551       WHERE  ordernumber = ?
 552       AND biblionumber =  ?";
 553     my $sth = $dbh->prepare($query);
 554     $sth->execute( $biblioitemnumber, $ordnum, $biblionumber );
 555 }
 556
 557 #------------------------------------------------------------#
 558
 559 =head3 ModReceiveOrder
 560
 561 =over 4
 562
 563 &ModReceiveOrder($biblionumber, $ordernumber, $quantityreceived, $user,
 564     $unitprice, $booksellerinvoicenumber, $biblioitemnumber,
 565     $freight, $bookfund, $rrp);
 566
 567 Updates an order, to reflect the fact that it was received, at least
 568 in part. All arguments not mentioned below update the fields with the
 569 same name in the aqorders table of the Koha database.
 570
 571 If a partial order is received, splits the order into two.  The received
 572 portion must have a booksellerinvoicenumber.
 573
 574 Updates the order with bibilionumber C<$biblionumber> and ordernumber
 575 C<$ordernumber>.
 576
 577 Also updates the book fund ID in the aqorderbreakdown table.
 578
 579 =back
 580
 581 =cut
 582
 583
 584 sub ModReceiveOrder {
 585     my (
 586         $biblionumber,    $ordnum,  $quantrec, $user, $cost,
 587         $invoiceno, $freight, $rrp, $bookfund, $datereceived
 588       )
 589       = @_;
 590     my $dbh = C4::Context->dbh;
 591 #     warn "DATE BEFORE : $daterecieved";
 592 #    $daterecieved=POSIX::strftime("%Y-%m-%d",CORE::localtime) unless $daterecieved;
 593 #     warn "DATE REC : $daterecieved";
 594         $datereceived = C4::Dates->output('iso') unless $datereceived;
 595     my $suggestionid = GetSuggestionFromBiblionumber( $dbh, $biblionumber );
 596     if ($suggestionid) {
 597         ModStatus( $suggestionid, 'AVAILABLE', '', $biblionumber );
 598     }
 599     # Allows libraries to change their bookfund during receiving orders
 600     # allows them to adjust budgets
 601     if ( C4::Context->preference("LooseBudgets") && $bookfund ) {
 602         my $query = "
 603             UPDATE aqorderbreakdown
 604             SET    bookfundid=?
 605             WHERE  ordernumber=?
 606         ";
 607         my $sth = $dbh->prepare($query);
 608         $sth->execute( $bookfund, $ordnum );
 609         $sth->finish;
 610     }
 611
 612         my $sth=$dbh->prepare("SELECT * FROM aqorders  LEFT JOIN aqorderbreakdown ON aqorders.ordernumber=aqorderbreakdown.ordernumber
 613                                                         WHERE biblionumber=? AND aqorders.ordernumber=?");
 614     $sth->execute($biblionumber,$ordnum);
 615     my $order = $sth->fetchrow_hashref();
 616     $sth->finish();
 617
 618         if ( $order->{quantity} > $quantrec ) {
 619         $sth=$dbh->prepare("update aqorders
 620                                                         set quantityreceived=?,datereceived=?,booksellerinvoicenumber=?,
 621                                                                 unitprice=?,freight=?,rrp=?,quantity=?
 622                             where biblionumber=? and ordernumber=?");
 623         $sth->execute($quantrec,$datereceived,$invoiceno,$cost,$freight,$rrp,$quantrec,$biblionumber,$ordnum);
 624         $sth->finish;
 625         # create a new order for the remaining items, and set its bookfund.
 626         my $newOrder = NewOrder($order->{'basketno'},$order->{'biblionumber'},$order->{'title'}, $order->{'quantity'} - $quantrec,
 627                     $order->{'listprice'},$order->{'booksellerid'},$order->{'authorisedby'},$order->{'notes'},
 628                     $order->{'bookfundid'},$order->{'biblioitemnumber'},$order->{'rrp'},$order->{'ecost'},$order->{'gst'},
 629                     $order->{'budget'},$order->{'unitcost'},$order->{'sub'},'',$order->{'sort1'},$order->{'sort2'},$order->{'purchaseordernumber'});
 630   } else {
 631         $sth=$dbh->prepare("update aqorders
 632                                                         set quantityreceived=?,datereceived=?,booksellerinvoicenumber=?,
 633                                                                 unitprice=?,freight=?,rrp=?
 634                             where biblionumber=? and ordernumber=?");
 635         $sth->execute($quantrec,$datereceived,$invoiceno,$cost,$freight,$rrp,$biblionumber,$ordnum);
 636         $sth->finish;
 637     }
 638     return $datereceived;
 639 }
 640 #------------------------------------------------------------#
 641
 642 =head3 SearchOrder
 643
 644 @results = &SearchOrder($search, $biblionumber, $complete);
 645
 646 Searches for orders.
 647
 648 C<$search> may take one of several forms: if it is an ISBN,
 649 C<&ordersearch> returns orders with that ISBN. If C<$search> is an
 650 order number, C<&ordersearch> returns orders with that order number
 651 and biblionumber C<$biblionumber>. Otherwise, C<$search> is considered
 652 to be a space-separated list of search terms; in this case, all of the
 653 terms must appear in the title (matching the beginning of title
 654 words).
 655
 656 If C<$complete> is C<yes>, the results will include only completed
 657 orders. In any case, C<&ordersearch> ignores cancelled orders.
 658
 659 C<&ordersearch> returns an array.
 660 C<@results> is an array of references-to-hash with the following keys:
 661
 662 =over 4
 663
 664 =item C<author>
 665
 666 =item C<seriestitle>
 667
 668 =item C<branchcode>
 669
 670 =item C<bookfundid>
 671
 672 =back
 673
 674 =cut
 675
 676 sub SearchOrder {
 677     my ( $search, $id, $biblionumber, $catview ) = @_;
 678     my $dbh = C4::Context->dbh;
 679     my @data = split( ' ', $search );
 680     my @searchterms;
 681     if ($id) {
 682         @searchterms = ($id);
 683     }
 684     map { push( @searchterms, "$_%", "%$_%" ) } @data;
 685     push( @searchterms, $search, $search, $biblionumber );
 686     my $query;
 687   ### FIXME  THIS CAN raise a problem if more THAN ONE biblioitem is linked to one biblio
 688     if ($id) {
 689         $query =
 690           "SELECT *,biblio.title
 691            FROM aqorders
 692            LEFT JOIN biblio ON aqorders.biblionumber=biblio.biblionumber
 693            LEFT JOIN biblioitems ON biblioitems.biblionumber=biblio.biblionumber
 694            LEFT JOIN aqbasket ON aqorders.basketno = aqbasket.basketno
 695             WHERE aqbasket.booksellerid = ?
 696             AND ((datecancellationprinted is NULL)
 697             OR (datecancellationprinted = '0000-00-00'))
 698             AND (("
 699           . (
 700             join( " AND ",
 701                 map { "(biblio.title like ? or biblio.title like ?)" } @data )
 702           )
 703           . ") OR biblioitems.isbn=? OR (aqorders.ordernumber=? AND aqorders.biblionumber=?)) ";
 704
 705     }
 706     else {
 707         $query =
 708           " SELECT *,biblio.title
 709             FROM   aqorders
 710             LEFT JOIN biblio ON biblio.biblionumber=aqorders.biblionumber
 711             LEFT JOIN aqbasket on aqorders.basketno=aqbasket.basketno
 712             LEFT JOIN biblioitems ON biblioitems.biblionumber=biblio.biblionumber
 713             WHERE  ((datecancellationprinted is NULL)
 714             OR     (datecancellationprinted = '0000-00-00'))
 715             AND    (aqorders.quantityreceived < aqorders.quantity OR aqorders.quantityreceived is NULL)
 716             AND (("
 717           . (
 718             join( " AND ",
 719                 map { "(biblio.title like ? OR biblio.title like ?)" } @data )
 720           )
 721           . ") or biblioitems.isbn=? OR (aqorders.ordernumber=? AND aqorders.biblionumber=?)) ";
 722     }
 723     $query .= " GROUP BY aqorders.ordernumber";
 724     ### $query
 725     my $sth = $dbh->prepare($query);
 726     $sth->execute(@searchterms);
 727     my @results = ();
 728     my $query2 = "
 729         SELECT *
 730         FROM   biblio
 731         WHERE  biblionumber=?
 732     ";
 733     my $sth2 = $dbh->prepare($query2);
 734     my $query3 = "
 735         SELECT *
 736         FROM   aqorderbreakdown
 737         WHERE  ordernumber=?
 738     ";
 739     my $sth3 = $dbh->prepare($query3);
 740
 741     while ( my $data = $sth->fetchrow_hashref ) {
 742         $sth2->execute( $data->{'biblionumber'} );
 743         my $data2 = $sth2->fetchrow_hashref;
 744         $data->{'author'}      = $data2->{'author'};
 745         $data->{'seriestitle'} = $data2->{'seriestitle'};
 746         $sth3->execute( $data->{'ordernumber'} );
 747         my $data3 = $sth3->fetchrow_hashref;
 748         $data->{'branchcode'} = $data3->{'branchcode'};
 749         $data->{'bookfundid'} = $data3->{'bookfundid'};
 750         push( @results, $data );
 751     }
 752     ### @results
 753     $sth->finish;
 754     $sth2->finish;
 755     $sth3->finish;
 756     return @results;
 757 }
 758
 759 #------------------------------------------------------------#
 760
 761 =head3 DelOrder
 762
 763 =over 4
 764
 765 &DelOrder($biblionumber, $ordernumber);
 766
 767 Cancel the order with the given order and biblio numbers. It does not
 768 delete any entries in the aqorders table, it merely marks them as
 769 cancelled.
 770
 771 =back
 772
 773 =cut
 774
 775 sub DelOrder {
 776     my ( $bibnum, $ordnum ) = @_;
 777     my $dbh = C4::Context->dbh;
 778     my $query = "
 779         UPDATE aqorders
 780         SET    datecancellationprinted=now()
 781         WHERE  biblionumber=? AND ordernumber=?
 782     ";
 783     my $sth = $dbh->prepare($query);
 784     $sth->execute( $bibnum, $ordnum );
 785     $sth->finish;
 786 }
 787
 788 =head2 FUNCTIONS ABOUT PARCELS
 789
 790 =cut
 791
 792 #------------------------------------------------------------#
 793
 794 =head3 GetParcel
 795
 796 =over 4
 797
 798 @results = &GetParcel($booksellerid, $code, $date);
 799
 800 Looks up all of the received items from the supplier with the given
 801 bookseller ID at the given date, for the given code (bookseller Invoice number). Ignores cancelled and completed orders.
 802
 803 C<@results> is an array of references-to-hash. The keys of each element are fields from
 804 the aqorders, biblio, and biblioitems tables of the Koha database.
 805
 806 C<@results> is sorted alphabetically by book title.
 807
 808 =back
 809
 810 =cut
 811
 812 sub GetParcel {
 813     #gets all orders from a certain supplier, orders them alphabetically
 814     my ( $supplierid, $code, $datereceived ) = @_;
 815     my $dbh     = C4::Context->dbh;
 816     my @results = ();
 817     $code .= '%'
 818       if $code;  # add % if we search on a given code (otherwise, let him empty)
 819     my $strsth ="
 820         SELECT  authorisedby,
 821                 creationdate,
 822                 aqbasket.basketno,
 823                 closedate,surname,
 824                 firstname,
 825                 aqorders.biblionumber,
 826                 aqorders.title,
 827                 aqorders.ordernumber,
 828                 aqorders.quantity,
 829                 aqorders.quantityreceived,
 830                 aqorders.unitprice,
 831                 aqorders.listprice,
 832                 aqorders.rrp,
 833                 aqorders.ecost
 834         FROM aqorders
 835         LEFT JOIN aqbasket ON aqbasket.basketno=aqorders.basketno
 836         LEFT JOIN borrowers ON aqbasket.authorisedby=borrowers.borrowernumber
 837         WHERE
 838             aqbasket.booksellerid = ?
 839             AND aqorders.booksellerinvoicenumber LIKE ?
 840             AND aqorders.datereceived = ? ";
 841
 842     my @query_params = ( $supplierid, $code, $datereceived );
 843     if ( C4::Context->preference("IndependantBranches") ) {
 844         my $userenv = C4::Context->userenv;
 845         if ( ($userenv) && ( $userenv->{flags} != 1 ) ) {
 846             $strsth .= " and (borrowers.branchcode = ?
 847                           or borrowers.branchcode  = '')";
 848             push @query_params, $userenv->{branch};
 849         }
 850     }
 851     $strsth .= " ORDER BY aqbasket.basketno";
 852     ### parcelinformation : $strsth
 853     my $sth = $dbh->prepare($strsth);
 854     $sth->execute( @query_params );
 855     while ( my $data = $sth->fetchrow_hashref ) {
 856         push( @results, $data );
 857     }
 858     ### countparcelbiblio: scalar(@results)
 859     $sth->finish;
 860
 861     return @results;
 862 }
 863
 864 #------------------------------------------------------------#
 865
 866 =head3 GetParcels
 867
 868 =over 4
 869
 870 $results = &GetParcels($bookseller, $order, $code, $datefrom, $dateto);
 871 get a lists of parcels.
 872
 873 =back
 874
 875 * Input arg :
 876
 877 =over 4
 878
 879 =item $bookseller
 880 is the bookseller this function has to get parcels.
 881
 882 =item $order
 883 To know on what criteria the results list has to be ordered.
 884
 885 =item $code
 886 is the booksellerinvoicenumber.
 887
 888 =item $datefrom & $dateto
 889 to know on what date this function has to filter its search.
 890
 891 * return:
 892 a pointer on a hash list containing parcel informations as such :
 893
 894 =item Creation date
 895
 896 =item Last operation
 897
 898 =item Number of biblio
 899
 900 =item Number of items
 901
 902 =back
 903
 904 =cut
 905
 906 sub GetParcels {
 907     my ($bookseller,$order, $code, $datefrom, $dateto) = @_;
 908     my $dbh    = C4::Context->dbh;
 909     my @query_params = ();
 910     my $strsth ="
 911         SELECT  aqorders.booksellerinvoicenumber,
 912                 datereceived,purchaseordernumber,
 913                 count(DISTINCT biblionumber) AS biblio,
 914                 sum(quantity) AS itemsexpected,
 915                 sum(quantityreceived) AS itemsreceived
 916         FROM   aqorders LEFT JOIN aqbasket ON aqbasket.basketno = aqorders.basketno
 917         WHERE aqbasket.booksellerid = $bookseller and datereceived IS NOT NULL
 918     ";
 919
 920     if ( defined $code ) {
 921         $strsth .= ' and aqorders.booksellerinvoicenumber like ? ';
 922         # add a % to the end of the code to allow stemming.
 923         push @query_params, "$code%";
 924     }
 925
 926     if ( defined $datefrom ) {
 927         $strsth .= ' and datereceived >= ? ';
 928         push @query_params, $datefrom;
 929     }
 930
 931     if ( defined $dateto ) {
 932         $strsth .=  'and datereceived <= ? ';
 933         push @query_params, $dateto;
 934     }
 935
 936     $strsth .= "group by aqorders.booksellerinvoicenumber,datereceived ";
 937
 938     # can't use a placeholder to place this column name.
 939     # but, we could probably be checking to make sure it is a column that will be fetched.
 940     $strsth .= "order by $order " if ($order);
 941
 942     my $sth = $dbh->prepare($strsth);
 943
 944     $sth->execute( @query_params );
 945     my $results = $sth->fetchall_arrayref({});
 946     $sth->finish;
 947     return @$results;
 948 }
 949
 950 #------------------------------------------------------------#
 951
 952 =head3 GetLateOrders
 953
 954 =over 4
 955
 956 @results = &GetLateOrders;
 957
 958 Searches for bookseller with late orders.
 959
 960 return:
 961 the table of supplier with late issues. This table is full of hashref.
 962
 963 =back
 964
 965 =cut
 966
 967 sub GetLateOrders {
 968     my $delay      = shift;
 969     my $supplierid = shift;
 970     my $branch     = shift;
 971
 972     my $dbh = C4::Context->dbh;
 973
 974     #BEWARE, order of parenthesis and LEFT JOIN is important for speed
 975     my $dbdriver = C4::Context->config("db_scheme") || "mysql";
 976
 977     my @query_params = ($delay);        # delay is the first argument regardless
 978         my $select = "
 979       SELECT aqbasket.basketno,
 980           aqorders.ordernumber,
 981           DATE(aqbasket.closedate)  AS orderdate,
 982           aqorders.rrp              AS unitpricesupplier,
 983           aqorders.ecost            AS unitpricelib,
 984           aqbookfund.bookfundname   AS budget,
 985           borrowers.branchcode      AS branch,
 986           aqbooksellers.name        AS supplier,
 987           aqorders.title,
 988           biblio.author,
 989           biblioitems.publishercode AS publisher,
 990           biblioitems.publicationyear,
 991         ";
 992         my $from = "
 993       FROM (((
 994           (aqorders LEFT JOIN biblio     ON biblio.biblionumber         = aqorders.biblionumber)
 995           LEFT JOIN biblioitems          ON biblioitems.biblionumber    = biblio.biblionumber)
 996           LEFT JOIN aqorderbreakdown     ON aqorders.ordernumber        = aqorderbreakdown.ordernumber)
 997           LEFT JOIN aqbookfund           ON aqorderbreakdown.bookfundid = aqbookfund.bookfundid),
 998           (aqbasket LEFT JOIN borrowers  ON aqbasket.authorisedby       = borrowers.borrowernumber)
 999           LEFT JOIN aqbooksellers        ON aqbasket.booksellerid       = aqbooksellers.id
1000           WHERE aqorders.basketno = aqbasket.basketno
1001           AND ( (datereceived = '' OR datereceived IS NULL)
1002               OR (aqorders.quantityreceived < aqorders.quantity)
1003           )
1004     ";
1005         my $having = "";
1006     if ($dbdriver eq "mysql") {
1007                 $select .= "
1008            aqorders.quantity - IFNULL(aqorders.quantityreceived,0)                 AS quantity,
1009           (aqorders.quantity - IFNULL(aqorders.quantityreceived,0)) * aqorders.rrp AS subtotal,
1010           DATEDIFF(CURDATE( ),closedate) AS latesince
1011                 ";
1012         $from .= " AND (closedate <= DATE_SUB(CURDATE( ),INTERVAL ? DAY)) ";
1013                 $having = "
1014          HAVING quantity          <> 0
1015             AND unitpricesupplier <> 0
1016             AND unitpricelib      <> 0
1017                 ";
1018     } else {
1019                 # FIXME: account for IFNULL as above
1020         $select .= "
1021                 aqorders.quantity                AS quantity,
1022                 aqorders.quantity * aqorders.rrp AS subtotal,
1023                 (CURDATE - closedate)            AS latesince
1024                 ";
1025         $from .= " AND (closedate <= (CURDATE -(INTERVAL ? DAY)) ";
1026     }
1027     if (defined $supplierid) {
1028                 $from .= ' AND aqbasket.booksellerid = ? ';
1029         push @query_params, $supplierid;
1030     }
1031     if (defined $branch) {
1032         $from .= ' AND borrowers.branchcode LIKE ? ';
1033         push @query_params, $branch;
1034     }
1035     if (C4::Context->preference("IndependantBranches")
1036              && C4::Context->userenv
1037              && C4::Context->userenv->{flags} != 1 ) {
1038         $from .= ' AND borrowers.branchcode LIKE ? ';
1039         push @query_params, C4::Context->userenv->{branch};
1040     }
1041         my $query = "$select $from $having\nORDER BY latesince, basketno, borrowers.branchcode, supplier";
1042         $debug and print STDERR "GetLateOrders query: $query\nGetLateOrders args: " . join(" ",@query_params);
1043     my $sth = $dbh->prepare($query);
1044     $sth->execute(@query_params);
1045     my @results;
1046     while (my $data = $sth->fetchrow_hashref) {
1047         $data->{orderdate} = format_date($data->{orderdate});
1048         push @results, $data;
1049     }
1050     return @results;
1051 }
1052
1053 #------------------------------------------------------------#
1054
1055 =head3 GetHistory
1056
1057 =over 4
1058
1059 (\@order_loop, $total_qty, $total_price, $total_qtyreceived) = GetHistory( $title, $author, $name, $from_placed_on, $to_placed_on );
1060
1061   Retreives some acquisition history information
1062
1063   returns:
1064     $order_loop is a list of hashrefs that each look like this:
1065               {
1066                 'author'           => 'Twain, Mark',
1067                 'basketno'         => '1',
1068                 'biblionumber'     => '215',
1069                 'count'            => 1,
1070                 'creationdate'     => 'MM/DD/YYYY',
1071                 'datereceived'     => undef,
1072                 'ecost'            => '1.00',
1073                 'id'               => '1',
1074                 'invoicenumber'    => undef,
1075                 'name'             => '',
1076                 'ordernumber'      => '1',
1077                 'quantity'         => 1,
1078                 'quantityreceived' => undef,
1079                 'title'            => 'The Adventures of Huckleberry Finn'
1080               }
1081     $total_qty is the sum of all of the quantities in $order_loop
1082     $total_price is the cost of each in $order_loop times the quantity
1083     $total_qtyreceived is the sum of all of the quantityreceived entries in $order_loop
1084
1085 =back
1086
1087 =cut
1088
1089 sub GetHistory {
1090     my ( $title, $author, $name, $from_placed_on, $to_placed_on ) = @_;
1091     my @order_loop;
1092     my $total_qty         = 0;
1093     my $total_qtyreceived = 0;
1094     my $total_price       = 0;
1095
1096 # don't run the query if there are no parameters (list would be too long for sure !)
1097     if ( $title || $author || $name || $from_placed_on || $to_placed_on ) {
1098         my $dbh   = C4::Context->dbh;
1099         my $query ="
1100             SELECT
1101                 biblio.title,
1102                 biblio.author,
1103                 aqorders.basketno,
1104                 name,aqbasket.creationdate,
1105                 aqorders.datereceived,
1106                 aqorders.quantity,
1107                 aqorders.quantityreceived,
1108                 aqorders.ecost,
1109                 aqorders.ordernumber,
1110                 aqorders.booksellerinvoicenumber as invoicenumber,
1111                 aqbooksellers.id as id,
1112                 aqorders.biblionumber
1113             FROM aqorders
1114             LEFT JOIN aqbasket ON aqorders.basketno=aqbasket.basketno
1115             LEFT JOIN aqbooksellers ON aqbasket.booksellerid=aqbooksellers.id
1116             LEFT JOIN biblio ON biblio.biblionumber=aqorders.biblionumber";
1117
1118         $query .= " LEFT JOIN borrowers ON aqbasket.authorisedby=borrowers.borrowernumber"
1119           if ( C4::Context->preference("IndependantBranches") );
1120
1121         $query .= " WHERE (datecancellationprinted is NULL or datecancellationprinted='0000-00-00') ";
1122
1123         my @query_params  = ();
1124
1125         if ( defined $title ) {
1126             $query .= " AND biblio.title LIKE ? ";
1127             push @query_params, "%$title%";
1128         }
1129
1130         if ( defined $author ) {
1131             $query .= " AND biblio.author LIKE ? ";
1132             push @query_params, "%$author%";
1133         }
1134
1135         if ( defined $name ) {
1136             $query .= " AND name LIKE ? ";
1137             push @query_params, "%$name%";
1138         }
1139
1140         if ( defined $from_placed_on ) {
1141             $query .= " AND creationdate >= ? ";
1142             push @query_params, $from_placed_on;
1143         }
1144
1145         if ( defined $to_placed_on ) {
1146             $query .= " AND creationdate <= ? ";
1147             push @query_params, $to_placed_on;
1148         }
1149
1150         if ( C4::Context->preference("IndependantBranches") ) {
1151             my $userenv = C4::Context->userenv;
1152             if ( ($userenv) && ( $userenv->{flags} != 1 ) ) {
1153                 $query .= " AND (borrowers.branchcode = ? OR borrowers.branchcode ='' ) ";
1154                 push @query_params, $userenv->{branch};
1155             }
1156         }
1157         $query .= " ORDER BY booksellerid";
1158         my $sth = $dbh->prepare($query);
1159         $sth->execute( @query_params );
1160         my $cnt = 1;
1161         while ( my $line = $sth->fetchrow_hashref ) {
1162             $line->{count} = $cnt++;
1163             $line->{toggle} = 1 if $cnt % 2;
1164             push @order_loop, $line;
1165             $line->{creationdate} = format_date( $line->{creationdate} );
1166             $line->{datereceived} = format_date( $line->{datereceived} );
1167             $total_qty         += $line->{'quantity'};
1168             $total_qtyreceived += $line->{'quantityreceived'};
1169             $total_price       += $line->{'quantity'} * $line->{'ecost'};
1170         }
1171     }
1172     return \@order_loop, $total_qty, $total_price, $total_qtyreceived;
1173 }
1174
1175 =head2 GetRecentAcqui
1176
1177    $results = GetRecentAcqui($days);
1178
1179    C<$results> is a ref to a table which containts hashref
1180
1181 =cut
1182
1183 sub GetRecentAcqui {
1184     my $limit  = shift;
1185     my $dbh    = C4::Context->dbh;
1186     my $query = "
1187         SELECT *
1188         FROM   biblio
1189         ORDER BY timestamp DESC
1190         LIMIT  0,".$limit;
1191
1192     my $sth = $dbh->prepare($query);
1193     $sth->execute;
1194     my @results;
1195     while(my $data = $sth->fetchrow_hashref){
1196         push @results,$data;
1197     }
1198     return \@results;
1199 }
1200
1201 1;
1202 __END__
1203
1204 =head1 AUTHOR
1205
1206 Koha Developement team <info@koha.org>
1207
1208 =cut