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