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