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