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