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