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 and $search){
 689         @searchterms = ($id, $search);
 690         $query =
 691           "SELECT *,biblio.title
 692              FROM aqorders
 693              LEFT JOIN biblio ON aqorders.biblionumber=biblio.biblionumber
 694              LEFT JOIN biblioitems ON biblioitems.biblionumber=biblio.biblionumber
 695              LEFT JOIN aqbasket ON aqorders.basketno = aqbasket.basketno
 696              WHERE aqbasket.booksellerid = ? AND aqorders.ordernumber = ?
 697           "
 698     }elsif ($id) {
 699         $query =
 700           "SELECT *,biblio.title
 701            FROM aqorders
 702            LEFT JOIN biblio ON aqorders.biblionumber=biblio.biblionumber
 703            LEFT JOIN biblioitems ON biblioitems.biblionumber=biblio.biblionumber
 704            LEFT JOIN aqbasket ON aqorders.basketno = aqbasket.basketno
 705             WHERE aqbasket.booksellerid = ?
 706             AND ((datecancellationprinted is NULL)
 707             OR (datecancellationprinted = '0000-00-00'))
 708             AND (("
 709           . (
 710             join( " AND ",
 711                 map { "(biblio.title like ? or biblio.title like ?)" } @data )
 712           )
 713           . ") OR biblioitems.isbn=? OR (aqorders.ordernumber=? AND aqorders.biblionumber=?)) ";
 714
 715     }
 716     else {
 717         $query =
 718           " SELECT *,biblio.title
 719             FROM   aqorders
 720             LEFT JOIN biblio ON biblio.biblionumber=aqorders.biblionumber
 721             LEFT JOIN aqbasket on aqorders.basketno=aqbasket.basketno
 722             LEFT JOIN biblioitems ON biblioitems.biblionumber=biblio.biblionumber
 723             WHERE  ((datecancellationprinted is NULL)
 724             OR     (datecancellationprinted = '0000-00-00'))
 725             AND    (aqorders.quantityreceived < aqorders.quantity OR aqorders.quantityreceived is NULL)
 726             AND (("
 727           . (
 728             join( " AND ",
 729                 map { "(biblio.title like ? OR biblio.title like ?)" } @data )
 730           )
 731           . ") or biblioitems.isbn=? OR (aqorders.ordernumber=? AND aqorders.biblionumber=?)) ";
 732     }
 733
 734     if ( $biblionumber ) {
 735         $query .= "AND biblio.biblionumber = ? ";
 736         push (@searchterms, $biblionumber);
 737     }
 738
 739     $query .= " GROUP BY aqorders.ordernumber";
 740     ### $query
 741     my $sth = $dbh->prepare($query);
 742     $sth->execute(@searchterms);
 743     my @results = ();
 744     my $query2 = "
 745         SELECT *
 746         FROM   biblio
 747         WHERE  biblionumber=?
 748     ";
 749     my $sth2 = $dbh->prepare($query2);
 750     my $query3 = "
 751         SELECT *
 752         FROM   aqorderbreakdown
 753         WHERE  ordernumber=?
 754     ";
 755     my $sth3 = $dbh->prepare($query3);
 756
 757     while ( my $data = $sth->fetchrow_hashref ) {
 758         $sth2->execute( $data->{'biblionumber'} );
 759         my $data2 = $sth2->fetchrow_hashref;
 760         $data->{'author'}      = $data2->{'author'};
 761         $data->{'seriestitle'} = $data2->{'seriestitle'};
 762         $sth3->execute( $data->{'ordernumber'} );
 763         my $data3 = $sth3->fetchrow_hashref;
 764         $data->{'branchcode'} = $data3->{'branchcode'};
 765         $data->{'bookfundid'} = $data3->{'bookfundid'};
 766         push( @results, $data );
 767     }
 768     ### @results
 769     $sth->finish;
 770     $sth2->finish;
 771     $sth3->finish;
 772     return @results;
 773 }
 774
 775 #------------------------------------------------------------#
 776
 777 =head3 DelOrder
 778
 779 =over 4
 780
 781 &DelOrder($biblionumber, $ordernumber);
 782
 783 Cancel the order with the given order and biblio numbers. It does not
 784 delete any entries in the aqorders table, it merely marks them as
 785 cancelled.
 786
 787 =back
 788
 789 =cut
 790
 791 sub DelOrder {
 792     my ( $bibnum, $ordnum ) = @_;
 793     my $dbh = C4::Context->dbh;
 794     my $query = "
 795         UPDATE aqorders
 796         SET    datecancellationprinted=now()
 797         WHERE  biblionumber=? AND ordernumber=?
 798     ";
 799     my $sth = $dbh->prepare($query);
 800     $sth->execute( $bibnum, $ordnum );
 801     $sth->finish;
 802 }
 803
 804 =head2 FUNCTIONS ABOUT PARCELS
 805
 806 =cut
 807
 808 #------------------------------------------------------------#
 809
 810 =head3 GetParcel
 811
 812 =over 4
 813
 814 @results = &GetParcel($booksellerid, $code, $date);
 815
 816 Looks up all of the received items from the supplier with the given
 817 bookseller ID at the given date, for the given code (bookseller Invoice number). Ignores cancelled and completed orders.
 818
 819 C<@results> is an array of references-to-hash. The keys of each element are fields from
 820 the aqorders, biblio, and biblioitems tables of the Koha database.
 821
 822 C<@results> is sorted alphabetically by book title.
 823
 824 =back
 825
 826 =cut
 827
 828 sub GetParcel {
 829     #gets all orders from a certain supplier, orders them alphabetically
 830     my ( $supplierid, $code, $datereceived ) = @_;
 831     my $dbh     = C4::Context->dbh;
 832     my @results = ();
 833     $code .= '%'
 834       if $code;  # add % if we search on a given code (otherwise, let him empty)
 835     my $strsth ="
 836         SELECT  authorisedby,
 837                 creationdate,
 838                 aqbasket.basketno,
 839                 closedate,surname,
 840                 firstname,
 841                 aqorders.biblionumber,
 842                 aqorders.title,
 843                 aqorders.ordernumber,
 844                 aqorders.quantity,
 845                 aqorders.quantityreceived,
 846                 aqorders.unitprice,
 847                 aqorders.listprice,
 848                 aqorders.rrp,
 849                 aqorders.ecost
 850         FROM aqorders
 851         LEFT JOIN aqbasket ON aqbasket.basketno=aqorders.basketno
 852         LEFT JOIN borrowers ON aqbasket.authorisedby=borrowers.borrowernumber
 853         WHERE
 854             aqbasket.booksellerid = ?
 855             AND aqorders.booksellerinvoicenumber LIKE ?
 856             AND aqorders.datereceived = ? ";
 857
 858     my @query_params = ( $supplierid, $code, $datereceived );
 859     if ( C4::Context->preference("IndependantBranches") ) {
 860         my $userenv = C4::Context->userenv;
 861         if ( ($userenv) && ( $userenv->{flags} != 1 ) ) {
 862             $strsth .= " and (borrowers.branchcode = ?
 863                           or borrowers.branchcode  = '')";
 864             push @query_params, $userenv->{branch};
 865         }
 866     }
 867     $strsth .= " ORDER BY aqbasket.basketno";
 868     ### parcelinformation : $strsth
 869     my $sth = $dbh->prepare($strsth);
 870     $sth->execute( @query_params );
 871     while ( my $data = $sth->fetchrow_hashref ) {
 872         push( @results, $data );
 873     }
 874     ### countparcelbiblio: scalar(@results)
 875     $sth->finish;
 876
 877     return @results;
 878 }
 879
 880 #------------------------------------------------------------#
 881
 882 =head3 GetParcels
 883
 884 =over 4
 885
 886 $results = &GetParcels($bookseller, $order, $code, $datefrom, $dateto);
 887 get a lists of parcels.
 888
 889 =back
 890
 891 * Input arg :
 892
 893 =over 4
 894
 895 =item $bookseller
 896 is the bookseller this function has to get parcels.
 897
 898 =item $order
 899 To know on what criteria the results list has to be ordered.
 900
 901 =item $code
 902 is the booksellerinvoicenumber.
 903
 904 =item $datefrom & $dateto
 905 to know on what date this function has to filter its search.
 906
 907 * return:
 908 a pointer on a hash list containing parcel informations as such :
 909
 910 =item Creation date
 911
 912 =item Last operation
 913
 914 =item Number of biblio
 915
 916 =item Number of items
 917
 918 =back
 919
 920 =cut
 921
 922 sub GetParcels {
 923     my ($bookseller,$order, $code, $datefrom, $dateto) = @_;
 924     my $dbh    = C4::Context->dbh;
 925     my @query_params = ();
 926     my $strsth ="
 927         SELECT  aqorders.booksellerinvoicenumber,
 928                 datereceived,purchaseordernumber,
 929                 count(DISTINCT biblionumber) AS biblio,
 930                 sum(quantity) AS itemsexpected,
 931                 sum(quantityreceived) AS itemsreceived
 932         FROM   aqorders LEFT JOIN aqbasket ON aqbasket.basketno = aqorders.basketno
 933         WHERE aqbasket.booksellerid = $bookseller and datereceived IS NOT NULL
 934     ";
 935
 936     if ( defined $code ) {
 937         $strsth .= ' and aqorders.booksellerinvoicenumber like ? ';
 938         # add a % to the end of the code to allow stemming.
 939         push @query_params, "$code%";
 940     }
 941
 942     if ( defined $datefrom ) {
 943         $strsth .= ' and datereceived >= ? ';
 944         push @query_params, $datefrom;
 945     }
 946
 947     if ( defined $dateto ) {
 948         $strsth .=  'and datereceived <= ? ';
 949         push @query_params, $dateto;
 950     }
 951
 952     $strsth .= "group by aqorders.booksellerinvoicenumber,datereceived ";
 953
 954     # can't use a placeholder to place this column name.
 955     # but, we could probably be checking to make sure it is a column that will be fetched.
 956     $strsth .= "order by $order " if ($order);
 957
 958     my $sth = $dbh->prepare($strsth);
 959
 960     $sth->execute( @query_params );
 961     my $results = $sth->fetchall_arrayref({});
 962     $sth->finish;
 963     return @$results;
 964 }
 965
 966 #------------------------------------------------------------#
 967
 968 =head3 GetLateOrders
 969
 970 =over 4
 971
 972 @results = &GetLateOrders;
 973
 974 Searches for bookseller with late orders.
 975
 976 return:
 977 the table of supplier with late issues. This table is full of hashref.
 978
 979 =back
 980
 981 =cut
 982
 983 sub GetLateOrders {
 984     my $delay      = shift;
 985     my $supplierid = shift;
 986     my $branch     = shift;
 987
 988     my $dbh = C4::Context->dbh;
 989
 990     #BEWARE, order of parenthesis and LEFT JOIN is important for speed
 991     my $dbdriver = C4::Context->config("db_scheme") || "mysql";
 992
 993     my @query_params = ($delay);        # delay is the first argument regardless
 994         my $select = "
 995       SELECT aqbasket.basketno,
 996           aqorders.ordernumber,
 997           DATE(aqbasket.closedate)  AS orderdate,
 998           aqorders.rrp              AS unitpricesupplier,
 999           aqorders.ecost            AS unitpricelib,
1000           aqbookfund.bookfundname   AS budget,
1001           borrowers.branchcode      AS branch,
1002           aqbooksellers.name        AS supplier,
1003           aqorders.title,
1004           biblio.author,
1005           biblioitems.publishercode AS publisher,
1006           biblioitems.publicationyear,
1007         ";
1008         my $from = "
1009       FROM (((
1010           (aqorders LEFT JOIN biblio     ON biblio.biblionumber         = aqorders.biblionumber)
1011           LEFT JOIN biblioitems          ON biblioitems.biblionumber    = biblio.biblionumber)
1012           LEFT JOIN aqorderbreakdown     ON aqorders.ordernumber        = aqorderbreakdown.ordernumber)
1013           LEFT JOIN aqbookfund           ON aqorderbreakdown.bookfundid = aqbookfund.bookfundid),
1014           (aqbasket LEFT JOIN borrowers  ON aqbasket.authorisedby       = borrowers.borrowernumber)
1015           LEFT JOIN aqbooksellers        ON aqbasket.booksellerid       = aqbooksellers.id
1016           WHERE aqorders.basketno = aqbasket.basketno
1017           AND ( (datereceived = '' OR datereceived IS NULL)
1018               OR (aqorders.quantityreceived < aqorders.quantity)
1019           )
1020     ";
1021         my $having = "";
1022     if ($dbdriver eq "mysql") {
1023                 $select .= "
1024            aqorders.quantity - IFNULL(aqorders.quantityreceived,0)                 AS quantity,
1025           (aqorders.quantity - IFNULL(aqorders.quantityreceived,0)) * aqorders.rrp AS subtotal,
1026           DATEDIFF(CURDATE( ),closedate) AS latesince
1027                 ";
1028         $from .= " AND (closedate <= DATE_SUB(CURDATE( ),INTERVAL ? DAY)) ";
1029                 $having = "
1030          HAVING quantity          <> 0
1031             AND unitpricesupplier <> 0
1032             AND unitpricelib      <> 0
1033                 ";
1034     } else {
1035                 # FIXME: account for IFNULL as above
1036         $select .= "
1037                 aqorders.quantity                AS quantity,
1038                 aqorders.quantity * aqorders.rrp AS subtotal,
1039                 (CURDATE - closedate)            AS latesince
1040                 ";
1041         $from .= " AND (closedate <= (CURDATE -(INTERVAL ? DAY)) ";
1042     }
1043     if (defined $supplierid) {
1044                 $from .= ' AND aqbasket.booksellerid = ? ';
1045         push @query_params, $supplierid;
1046     }
1047     if (defined $branch) {
1048         $from .= ' AND borrowers.branchcode LIKE ? ';
1049         push @query_params, $branch;
1050     }
1051     if (C4::Context->preference("IndependantBranches")
1052              && C4::Context->userenv
1053              && C4::Context->userenv->{flags} != 1 ) {
1054         $from .= ' AND borrowers.branchcode LIKE ? ';
1055         push @query_params, C4::Context->userenv->{branch};
1056     }
1057         my $query = "$select $from $having\nORDER BY latesince, basketno, borrowers.branchcode, supplier";
1058         $debug and print STDERR "GetLateOrders query: $query\nGetLateOrders args: " . join(" ",@query_params);
1059     my $sth = $dbh->prepare($query);
1060     $sth->execute(@query_params);
1061     my @results;
1062     while (my $data = $sth->fetchrow_hashref) {
1063         $data->{orderdate} = format_date($data->{orderdate});
1064         push @results, $data;
1065     }
1066     return @results;
1067 }
1068
1069 #------------------------------------------------------------#
1070
1071 =head3 GetHistory
1072
1073 =over 4
1074
1075 (\@order_loop, $total_qty, $total_price, $total_qtyreceived) = GetHistory( $title, $author, $name, $from_placed_on, $to_placed_on );
1076
1077   Retreives some acquisition history information
1078
1079   returns:
1080     $order_loop is a list of hashrefs that each look like this:
1081               {
1082                 'author'           => 'Twain, Mark',
1083                 'basketno'         => '1',
1084                 'biblionumber'     => '215',
1085                 'count'            => 1,
1086                 'creationdate'     => 'MM/DD/YYYY',
1087                 'datereceived'     => undef,
1088                 'ecost'            => '1.00',
1089                 'id'               => '1',
1090                 'invoicenumber'    => undef,
1091                 'name'             => '',
1092                 'ordernumber'      => '1',
1093                 'quantity'         => 1,
1094                 'quantityreceived' => undef,
1095                 'title'            => 'The Adventures of Huckleberry Finn'
1096               }
1097     $total_qty is the sum of all of the quantities in $order_loop
1098     $total_price is the cost of each in $order_loop times the quantity
1099     $total_qtyreceived is the sum of all of the quantityreceived entries in $order_loop
1100
1101 =back
1102
1103 =cut
1104
1105 sub GetHistory {
1106     my ( $title, $author, $name, $from_placed_on, $to_placed_on ) = @_;
1107     my @order_loop;
1108     my $total_qty         = 0;
1109     my $total_qtyreceived = 0;
1110     my $total_price       = 0;
1111
1112 # don't run the query if there are no parameters (list would be too long for sure !)
1113     if ( $title || $author || $name || $from_placed_on || $to_placed_on ) {
1114         my $dbh   = C4::Context->dbh;
1115         my $query ="
1116             SELECT
1117                 biblio.title,
1118                 biblio.author,
1119                 aqorders.basketno,
1120                 name,aqbasket.creationdate,
1121                 aqorders.datereceived,
1122                 aqorders.quantity,
1123                 aqorders.quantityreceived,
1124                 aqorders.ecost,
1125                 aqorders.ordernumber,
1126                 aqorders.booksellerinvoicenumber as invoicenumber,
1127                 aqbooksellers.id as id,
1128                 aqorders.biblionumber
1129             FROM aqorders
1130             LEFT JOIN aqbasket ON aqorders.basketno=aqbasket.basketno
1131             LEFT JOIN aqbooksellers ON aqbasket.booksellerid=aqbooksellers.id
1132             LEFT JOIN biblio ON biblio.biblionumber=aqorders.biblionumber";
1133
1134         $query .= " LEFT JOIN borrowers ON aqbasket.authorisedby=borrowers.borrowernumber"
1135           if ( C4::Context->preference("IndependantBranches") );
1136
1137         $query .= " WHERE (datecancellationprinted is NULL or datecancellationprinted='0000-00-00') ";
1138
1139         my @query_params  = ();
1140
1141         if ( defined $title ) {
1142             $query .= " AND biblio.title LIKE ? ";
1143             push @query_params, "%$title%";
1144         }
1145
1146         if ( defined $author ) {
1147             $query .= " AND biblio.author LIKE ? ";
1148             push @query_params, "%$author%";
1149         }
1150
1151         if ( defined $name ) {
1152             $query .= " AND name LIKE ? ";
1153             push @query_params, "%$name%";
1154         }
1155
1156         if ( defined $from_placed_on ) {
1157             $query .= " AND creationdate >= ? ";
1158             push @query_params, $from_placed_on;
1159         }
1160
1161         if ( defined $to_placed_on ) {
1162             $query .= " AND creationdate <= ? ";
1163             push @query_params, $to_placed_on;
1164         }
1165
1166         if ( C4::Context->preference("IndependantBranches") ) {
1167             my $userenv = C4::Context->userenv;
1168             if ( ($userenv) && ( $userenv->{flags} != 1 ) ) {
1169                 $query .= " AND (borrowers.branchcode = ? OR borrowers.branchcode ='' ) ";
1170                 push @query_params, $userenv->{branch};
1171             }
1172         }
1173         $query .= " ORDER BY booksellerid";
1174         my $sth = $dbh->prepare($query);
1175         $sth->execute( @query_params );
1176         my $cnt = 1;
1177         while ( my $line = $sth->fetchrow_hashref ) {
1178             $line->{count} = $cnt++;
1179             $line->{toggle} = 1 if $cnt % 2;
1180             push @order_loop, $line;
1181             $line->{creationdate} = format_date( $line->{creationdate} );
1182             $line->{datereceived} = format_date( $line->{datereceived} );
1183             $total_qty         += $line->{'quantity'};
1184             $total_qtyreceived += $line->{'quantityreceived'};
1185             $total_price       += $line->{'quantity'} * $line->{'ecost'};
1186         }
1187     }
1188     return \@order_loop, $total_qty, $total_price, $total_qtyreceived;
1189 }
1190
1191 =head2 GetRecentAcqui
1192
1193    $results = GetRecentAcqui($days);
1194
1195    C<$results> is a ref to a table which containts hashref
1196
1197 =cut
1198
1199 sub GetRecentAcqui {
1200     my $limit  = shift;
1201     my $dbh    = C4::Context->dbh;
1202     my $query = "
1203         SELECT *
1204         FROM   biblio
1205         ORDER BY timestamp DESC
1206         LIMIT  0,".$limit;
1207
1208     my $sth = $dbh->prepare($query);
1209     $sth->execute;
1210     my @results;
1211     while(my $data = $sth->fetchrow_hashref){
1212         push @results,$data;
1213     }
1214     return \@results;
1215 }
1216
1217 1;
1218 __END__
1219
1220 =head1 AUTHOR
1221
1222 Koha Developement team <info@koha.org>
1223
1224 =cut