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