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