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