koha-dev.rot13.org Git - koha_gimpoz/blob - C4/Acquisition.pm

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