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 require Exporter;
  23 use C4::Context;
  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 # set the version for version checking
  32 $VERSION = 3.01;
  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                 concat( b.firstname,' ',b.surname) AS authorisedbyname,
  98                 b.branchcode AS branch
  99         FROM    aqbasket
 100         LEFT JOIN borrowers b ON aqbasket.authorisedby=b.borrowernumber
 101         WHERE basketno=?
 102     ";
 103     my $sth=$dbh->prepare($query);
 104     $sth->execute($basketno);
 105     my $basket = $sth->fetchrow_hashref;
 106         return ( $basket );
 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.publishercode,
 274                 aqorders.*,
 275                 aqbookfund.bookfundname,
 276                 biblio.title
 277         FROM    aqorders
 278             LEFT JOIN aqorderbreakdown ON aqorders.ordernumber=aqorderbreakdown.ordernumber
 279             LEFT JOIN aqbookfund       ON aqbookfund.bookfundid=aqorderbreakdown.bookfundid
 280             LEFT JOIN biblio           ON biblio.biblionumber=aqorders.biblionumber
 281             LEFT JOIN biblioitems      ON biblioitems.biblionumber=biblio.biblionumber
 282         WHERE   basketno=?
 283             AND (datecancellationprinted IS NULL OR datecancellationprinted='0000-00-00')
 284     ";
 285
 286     $orderby = "biblioitems.publishercode,biblio.title" 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, $purchaseorder);
 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,        $purchaseorder
 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,purchaseordernumber)
 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,        $purchaseorder
 450     );
 451     $sth->finish;
 452
 453     #get ordnum MYSQL dependant, but $dbh->last_insert_id returns null
 454     my $ordnum = $dbh->{'mysql_insertid'};
 455     $query = "
 456         INSERT INTO aqorderbreakdown (ordernumber,bookfundid)
 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,     $purchaseorder
 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=?, purchaseordernumber=?
 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, $purchaseorder,
 510                 $ordnum,   $bibnum
 511     );
 512     $sth->finish;
 513     $query = "
 514         UPDATE aqorderbreakdown
 515         SET    bookfundid=?
 516         WHERE  ordernumber=?
 517     ";
 518     $sth = $dbh->prepare($query);
 519
 520     unless ( $sth->execute( $bookfund, $ordnum ) )
 521     {    # zero rows affected [Bug 734]
 522         my $query ="
 523             INSERT INTO aqorderbreakdown
 524                      (ordernumber,bookfundid)
 525             VALUES   (?,?)
 526         ";
 527         $sth = $dbh->prepare($query);
 528         $sth->execute( $ordnum, $bookfund );
 529     }
 530     $sth->finish;
 531 }
 532
 533 #------------------------------------------------------------#
 534
 535 =head3 ModOrderBiblioNumber
 536
 537 =over 4
 538
 539 &ModOrderBiblioNumber($biblioitemnumber,$ordnum, $biblionumber);
 540
 541 Modifies the biblioitemnumber for an existing order.
 542 Updates the order with order number C<$ordernum> and biblionumber C<$biblionumber>.
 543
 544 =back
 545
 546 =cut
 547
 548 sub ModOrderBiblioNumber {
 549     my ($biblioitemnumber,$ordnum, $biblionumber) = @_;
 550     my $dbh = C4::Context->dbh;
 551     my $query = "
 552       UPDATE aqorders
 553       SET    biblioitemnumber = ?
 554       WHERE  ordernumber = ?
 555       AND biblionumber =  ?";
 556     my $sth = $dbh->prepare($query);
 557     $sth->execute( $biblioitemnumber, $ordnum, $biblionumber );
 558 }
 559
 560 #------------------------------------------------------------#
 561
 562 =head3 ModReceiveOrder
 563
 564 =over 4
 565
 566 &ModReceiveOrder($biblionumber, $ordernumber, $quantityreceived, $user,
 567     $unitprice, $booksellerinvoicenumber, $biblioitemnumber,
 568     $freight, $bookfund, $rrp);
 569
 570 Updates an order, to reflect the fact that it was received, at least
 571 in part. All arguments not mentioned below update the fields with the
 572 same name in the aqorders table of the Koha database.
 573
 574 If a partial order is received, splits the order into two.  The received
 575 portion must have a booksellerinvoicenumber.
 576
 577 Updates the order with bibilionumber C<$biblionumber> and ordernumber
 578 C<$ordernumber>.
 579
 580 Also updates the book fund ID in the aqorderbreakdown table.
 581
 582 =back
 583
 584 =cut
 585
 586
 587 sub ModReceiveOrder {
 588     my (
 589         $biblionumber,    $ordnum,  $quantrec, $user, $cost,
 590         $invoiceno, $freight, $rrp, $bookfund, $datereceived
 591       )
 592       = @_;
 593     my $dbh = C4::Context->dbh;
 594 #     warn "DATE BEFORE : $daterecieved";
 595 #    $daterecieved=POSIX::strftime("%Y-%m-%d",CORE::localtime) unless $daterecieved;
 596 #     warn "DATE REC : $daterecieved";
 597         $datereceived = C4::Dates->output('iso') unless $datereceived;
 598
 599         my $sth=$dbh->prepare("SELECT * FROM aqorders  LEFT JOIN aqorderbreakdown ON aqorders.ordernumber=aqorderbreakdown.ordernumber
 600                                                         WHERE biblionumber=? AND aqorders.ordernumber=?");
 601     $sth->execute($biblionumber,$ordnum);
 602     my $order = $sth->fetchrow_hashref();
 603     $sth->finish();
 604
 605         if ( $order->{quantity} > $quantrec ) {
 606         $sth=$dbh->prepare("update aqorders
 607                                                         set quantityreceived=?,datereceived=?,booksellerinvoicenumber=?,
 608                                                                 unitprice=?,freight=?,rrp=?,quantity=?
 609                             where biblionumber=? and ordernumber=?");
 610         $sth->execute($quantrec,$datereceived,$invoiceno,$cost,$freight,$rrp,$quantrec,$biblionumber,$ordnum);
 611         $sth->finish;
 612         # create a new order for the remaining items, and set its bookfund.
 613         my $newOrder = NewOrder($order->{'basketno'},$order->{'biblionumber'},$order->{'title'}, $order->{'quantity'} - $quantrec,
 614                     $order->{'listprice'},$order->{'booksellerid'},$order->{'authorisedby'},$order->{'notes'},
 615                     $order->{'bookfundid'},$order->{'biblioitemnumber'},$order->{'rrp'},$order->{'ecost'},$order->{'gst'},
 616                     $order->{'budget'},$order->{'unitcost'},$order->{'sub'},'',$order->{'sort1'},$order->{'sort2'},$order->{'purchaseordernumber'});
 617
 618         $sth = $dbh->prepare("select branchcode, bookfundid from aqorderbreakdown where ordernumber=?");
 619         $sth->execute($ordnum);
 620         my ($branch,$bookfund) = $sth->fetchrow_array;
 621         $sth->finish;
 622         $sth=$dbh->prepare(" insert into aqorderbreakdown (ordernumber, branchcode, bookfundid) values (?,?,?)");
 623         $sth->execute($newOrder,$branch,$bookfund);
 624     } else {
 625         $sth=$dbh->prepare("update aqorders
 626                                                         set quantityreceived=?,datereceived=?,booksellerinvoicenumber=?,
 627                                                                 unitprice=?,freight=?,rrp=?
 628                             where biblionumber=? and ordernumber=?");
 629         $sth->execute($quantrec,$datereceived,$invoiceno,$cost,$freight,$rrp,$biblionumber,$ordnum);
 630         $sth->finish;
 631     }
 632     my $suggestionid = GetSuggestionFromBiblionumber( $dbh, $biblionumber );
 633     if ($suggestionid) {
 634         ModStatus( $suggestionid, 'AVAILABLE', '', $biblionumber );
 635     }
 636     # Allows libraries to change their bookfund during receiving orders
 637     # allows them to adjust budgets
 638     if ( C4::Context->preference("LooseBudgets") ) {
 639         my $query = "
 640             UPDATE aqorderbreakdown
 641             SET    bookfundid=?
 642             WHERE  ordernumber=?
 643         ";
 644         my $sth = $dbh->prepare($query);
 645         $sth->execute( $bookfund, $ordnum );
 646         $sth->finish;
 647     }
 648     return $datereceived;
 649 }
 650 #------------------------------------------------------------#
 651
 652 =head3 SearchOrder
 653
 654 @results = &SearchOrder($search, $biblionumber, $complete);
 655
 656 Searches for orders.
 657
 658 C<$search> may take one of several forms: if it is an ISBN,
 659 C<&ordersearch> returns orders with that ISBN. If C<$search> is an
 660 order number, C<&ordersearch> returns orders with that order number
 661 and biblionumber C<$biblionumber>. Otherwise, C<$search> is considered
 662 to be a space-separated list of search terms; in this case, all of the
 663 terms must appear in the title (matching the beginning of title
 664 words).
 665
 666 If C<$complete> is C<yes>, the results will include only completed
 667 orders. In any case, C<&ordersearch> ignores cancelled orders.
 668
 669 C<&ordersearch> returns an array.
 670 C<@results> is an array of references-to-hash with the following keys:
 671
 672 =over 4
 673
 674 =item C<author>
 675
 676 =item C<seriestitle>
 677
 678 =item C<branchcode>
 679
 680 =item C<bookfundid>
 681
 682 =back
 683
 684 =cut
 685
 686 sub SearchOrder {
 687     my ( $search, $id, $biblionumber, $catview ) = @_;
 688     my $dbh = C4::Context->dbh;
 689     my @data = split( ' ', $search );
 690     my @searchterms;
 691     if ($id) {
 692         @searchterms = ($id);
 693     }
 694     map { push( @searchterms, "$_%", "%$_%" ) } @data;
 695     push( @searchterms, $search, $search, $biblionumber );
 696     my $query;
 697   ### FIXME  THIS CAN raise a problem if more THAN ONE biblioitem is linked to one biblio
 698     if ($id) {
 699         $query =
 700           "SELECT *,biblio.title
 701            FROM aqorders
 702            LEFT JOIN biblio ON aqorders.biblionumber=biblio.biblionumber
 703            LEFT JOIN biblioitems ON biblioitems.biblionumber=biblio.biblionumber
 704            LEFT JOIN aqbasket ON aqorders.basketno = aqbasket.basketno
 705             WHERE aqbasket.booksellerid = ?
 706             AND ((datecancellationprinted is NULL)
 707             OR (datecancellationprinted = '0000-00-00'))
 708             AND (("
 709           . (
 710             join( " AND ",
 711                 map { "(biblio.title like ? or biblio.title like ?)" } @data )
 712           )
 713           . ") OR biblioitems.isbn=? OR (aqorders.ordernumber=? AND aqorders.biblionumber=?)) ";
 714
 715     }
 716     else {
 717         $query =
 718           " SELECT *,biblio.title
 719             FROM   aqorders
 720             LEFT JOIN biblio ON biblio.biblionumber=aqorders.biblionumber
 721             LEFT JOIN aqbasket on aqorders.basketno=aqbasket.basketno
 722             LEFT JOIN biblioitems ON biblioitems.biblionumber=biblio.biblionumber
 723             WHERE  ((datecancellationprinted is NULL)
 724             OR     (datecancellationprinted = '0000-00-00'))
 725             AND    (aqorders.quantityreceived < aqorders.quantity OR aqorders.quantityreceived is NULL)
 726             AND (("
 727           . (
 728             join( " AND ",
 729                 map { "(biblio.title like ? OR biblio.title like ?)" } @data )
 730           )
 731           . ") or biblioitems.isbn=? OR (aqorders.ordernumber=? AND aqorders.biblionumber=?)) ";
 732     }
 733     $query .= " GROUP BY aqorders.ordernumber";
 734     ### $query
 735     my $sth = $dbh->prepare($query);
 736     $sth->execute(@searchterms);
 737     my @results = ();
 738     my $query2 = "
 739         SELECT *
 740         FROM   biblio
 741         WHERE  biblionumber=?
 742     ";
 743     my $sth2 = $dbh->prepare($query2);
 744     my $query3 = "
 745         SELECT *
 746         FROM   aqorderbreakdown
 747         WHERE  ordernumber=?
 748     ";
 749     my $sth3 = $dbh->prepare($query3);
 750
 751     while ( my $data = $sth->fetchrow_hashref ) {
 752         $sth2->execute( $data->{'biblionumber'} );
 753         my $data2 = $sth2->fetchrow_hashref;
 754         $data->{'author'}      = $data2->{'author'};
 755         $data->{'seriestitle'} = $data2->{'seriestitle'};
 756         $sth3->execute( $data->{'ordernumber'} );
 757         my $data3 = $sth3->fetchrow_hashref;
 758         $data->{'branchcode'} = $data3->{'branchcode'};
 759         $data->{'bookfundid'} = $data3->{'bookfundid'};
 760         push( @results, $data );
 761     }
 762     ### @results
 763     $sth->finish;
 764     $sth2->finish;
 765     $sth3->finish;
 766     return @results;
 767 }
 768
 769 #------------------------------------------------------------#
 770
 771 =head3 DelOrder
 772
 773 =over 4
 774
 775 &DelOrder($biblionumber, $ordernumber);
 776
 777 Cancel the order with the given order and biblio numbers. It does not
 778 delete any entries in the aqorders table, it merely marks them as
 779 cancelled.
 780
 781 =back
 782
 783 =cut
 784
 785 sub DelOrder {
 786     my ( $bibnum, $ordnum ) = @_;
 787     my $dbh = C4::Context->dbh;
 788     my $query = "
 789         UPDATE aqorders
 790         SET    datecancellationprinted=now()
 791         WHERE  biblionumber=? AND ordernumber=?
 792     ";
 793     my $sth = $dbh->prepare($query);
 794     $sth->execute( $bibnum, $ordnum );
 795     $sth->finish;
 796 }
 797
 798
 799 =back
 800
 801 =head2 FUNCTIONS ABOUT PARCELS
 802
 803 =over 2
 804
 805 =cut
 806
 807 #------------------------------------------------------------#
 808
 809 =head3 GetParcel
 810
 811 =over 4
 812
 813 @results = &GetParcel($booksellerid, $code, $date);
 814
 815 Looks up all of the received items from the supplier with the given
 816 bookseller ID at the given date, for the given code (bookseller Invoice number). Ignores cancelled and completed orders.
 817
 818 C<@results> is an array of references-to-hash. The keys of each element are fields from
 819 the aqorders, biblio, and biblioitems tables of the Koha database.
 820
 821 C<@results> is sorted alphabetically by book title.
 822
 823 =back
 824
 825 =cut
 826
 827 sub GetParcel {
 828     #gets all orders from a certain supplier, orders them alphabetically
 829     my ( $supplierid, $code, $datereceived ) = @_;
 830     my $dbh     = C4::Context->dbh;
 831     my @results = ();
 832     $code .= '%'
 833       if $code;  # add % if we search on a given code (otherwise, let him empty)
 834     my $strsth ="
 835         SELECT  authorisedby,
 836                 creationdate,
 837                 aqbasket.basketno,
 838                 closedate,surname,
 839                 firstname,
 840                 aqorders.biblionumber,
 841                 aqorders.title,
 842                 aqorders.ordernumber,
 843                 aqorders.quantity,
 844                 aqorders.quantityreceived,
 845                 aqorders.unitprice,
 846                 aqorders.listprice,
 847                 aqorders.rrp,
 848                 aqorders.ecost
 849         FROM aqorders
 850         LEFT JOIN aqbasket ON aqbasket.basketno=aqorders.basketno
 851         LEFT JOIN borrowers ON aqbasket.authorisedby=borrowers.borrowernumber
 852         WHERE
 853             aqbasket.booksellerid=?
 854             AND aqorders.booksellerinvoicenumber LIKE  \"$code\"
 855             AND aqorders.datereceived= \'$datereceived\'";
 856
 857     if ( C4::Context->preference("IndependantBranches") ) {
 858         my $userenv = C4::Context->userenv;
 859         if ( ($userenv) && ( $userenv->{flags} != 1 ) ) {
 860             $strsth .=
 861                 " AND (borrowers.branchcode = '"
 862               . $userenv->{branch}
 863               . "' OR borrowers.branchcode ='')";
 864         }
 865     }
 866     $strsth .= " ORDER BY aqbasket.basketno";
 867     ### parcelinformation : $strsth
 868  #   warn "STH : $strsth";
 869     my $sth = $dbh->prepare($strsth);
 870     $sth->execute($supplierid);
 871     while ( my $data = $sth->fetchrow_hashref ) {
 872         push( @results, $data );
 873     }
 874     ### countparcelbiblio: scalar(@results)
 875     $sth->finish;
 876
 877     return @results;
 878 }
 879
 880 #------------------------------------------------------------#
 881
 882 =head3 GetParcels
 883
 884 =over 4
 885
 886 $results = &GetParcels($bookseller, $order, $code, $datefrom, $dateto);
 887 get a lists of parcels.
 888
 889 * Input arg :
 890
 891 =item $bookseller
 892 is the bookseller this function has to get parcels.
 893
 894 =item $order
 895 To know on what criteria the results list has to be ordered.
 896
 897 =item $code
 898 is the booksellerinvoicenumber.
 899
 900 =item $datefrom & $dateto
 901 to know on what date this function has to filter its search.
 902
 903 * return:
 904 a pointer on a hash list containing parcel informations as such :
 905
 906 =item Creation date
 907
 908 =item Last operation
 909
 910 =item Number of biblio
 911
 912 =item Number of items
 913
 914 =back
 915
 916 =cut
 917
 918 sub GetParcels {
 919     my ($bookseller,$order, $code, $datefrom, $dateto) = @_;
 920     my $dbh    = C4::Context->dbh;
 921     my $strsth ="
 922         SELECT  aqorders.booksellerinvoicenumber,
 923                 datereceived,purchaseordernumber,
 924                 count(DISTINCT biblionumber) AS biblio,
 925                 sum(quantity) AS itemsexpected,
 926                 sum(quantityreceived) AS itemsreceived
 927         FROM   aqorders LEFT JOIN aqbasket ON aqbasket.basketno = aqorders.basketno
 928         WHERE aqbasket.booksellerid = $bookseller and datereceived IS NOT NULL
 929     ";
 930
 931     $strsth .= "and aqorders.booksellerinvoicenumber like \"$code%\" " if ($code);
 932
 933     $strsth .= "and datereceived >=" . $dbh->quote($datefrom) . " " if ($datefrom);
 934
 935     $strsth .= "and datereceived <=" . $dbh->quote($dateto) . " " if ($dateto);
 936
 937     $strsth .= "group by aqorders.booksellerinvoicenumber,datereceived ";
 938     $strsth .= "order by $order " if ($order);
 939 ### $strsth
 940     my $sth = $dbh->prepare($strsth);
 941
 942     $sth->execute;
 943     my $results = $sth->fetchall_arrayref({});
 944     $sth->finish;
 945     return @$results;
 946 }
 947
 948 #------------------------------------------------------------#
 949
 950 =head3 GetLateOrders
 951
 952 =over 4
 953
 954 @results = &GetLateOrders;
 955
 956 Searches for bookseller with late orders.
 957
 958 return:
 959 the table of supplier with late issues. This table is full of hashref.
 960
 961 =back
 962
 963 =cut
 964
 965 sub GetLateOrders {
 966     my $delay      = shift;
 967     my $supplierid = shift;
 968     my $branch     = shift;
 969
 970     my $dbh = C4::Context->dbh;
 971
 972     #BEWARE, order of parenthesis and LEFT JOIN is important for speed
 973     my $strsth;
 974     my $dbdriver = C4::Context->config("db_scheme") || "mysql";
 975
 976     #    warn " $dbdriver";
 977     if ( $dbdriver eq "mysql" ) {
 978         $strsth = "
 979             SELECT aqbasket.basketno,aqorders.ordernumber,
 980                 DATE(aqbasket.closedate) AS orderdate,
 981                 aqorders.quantity - IFNULL(aqorders.quantityreceived,0) AS quantity,
 982                 aqorders.rrp AS unitpricesupplier,
 983                 aqorders.ecost AS unitpricelib,
 984                 (aqorders.quantity - IFNULL(aqorders.quantityreceived,0)) * aqorders.rrp AS subtotal,
 985                 aqbookfund.bookfundname AS budget,
 986                 borrowers.branchcode AS branch,
 987                 aqbooksellers.name AS supplier,
 988                 aqorders.title,
 989                 biblio.author,
 990                 biblioitems.publishercode AS publisher,
 991                 biblioitems.publicationyear,
 992                 DATEDIFF(CURDATE( ),closedate) AS latesince
 993             FROM  (((
 994                 (aqorders LEFT JOIN biblio ON biblio.biblionumber = aqorders.biblionumber)
 995             LEFT JOIN biblioitems ON  biblioitems.biblionumber=biblio.biblionumber)
 996             LEFT JOIN aqorderbreakdown ON aqorders.ordernumber = aqorderbreakdown.ordernumber)
 997             LEFT JOIN aqbookfund ON aqorderbreakdown.bookfundid = aqbookfund.bookfundid),
 998             (aqbasket LEFT JOIN borrowers ON aqbasket.authorisedby = borrowers.borrowernumber)
 999             LEFT JOIN aqbooksellers ON aqbasket.booksellerid = aqbooksellers.id
1000             WHERE aqorders.basketno = aqbasket.basketno
1001             AND (closedate < DATE_SUB(CURDATE( ),INTERVAL $delay DAY))
1002             AND ((datereceived = '' OR datereceived is null)
1003             OR (aqorders.quantityreceived < aqorders.quantity) )
1004         ";
1005         $strsth .= " AND aqbasket.booksellerid = $supplierid " if ($supplierid);
1006         $strsth .= " AND borrowers.branchcode like \'" . $branch . "\'"
1007           if ($branch);
1008         $strsth .=
1009           " AND borrowers.branchcode like \'"
1010           . C4::Context->userenv->{branch} . "\'"
1011           if ( C4::Context->preference("IndependantBranches")
1012             && C4::Context->userenv
1013             && C4::Context->userenv->{flags} != 1 );
1014         $strsth .=" HAVING quantity<>0
1015                     AND unitpricesupplier<>0
1016                     AND unitpricelib<>0
1017                     ORDER BY latesince,basketno,borrowers.branchcode, supplier
1018         ";
1019     }
1020     else {
1021         $strsth = "
1022             SELECT aqbasket.basketno,
1023                    DATE(aqbasket.closedate) AS orderdate,
1024                     aqorders.quantity, aqorders.rrp AS unitpricesupplier,
1025                     aqorders.ecost as unitpricelib,
1026                     aqorders.quantity * aqorders.rrp AS subtotal
1027                     aqbookfund.bookfundname AS budget,
1028                     borrowers.branchcode AS branch,
1029                     aqbooksellers.name AS supplier,
1030                     biblio.title,
1031                     biblio.author,
1032                     biblioitems.publishercode AS publisher,
1033                     biblioitems.publicationyear,
1034                     (CURDATE -  closedate) AS latesince
1035                     FROM(( (
1036                         (aqorders LEFT JOIN biblio on biblio.biblionumber = aqorders.biblionumber)
1037                         LEFT JOIN biblioitems on  biblioitems.biblionumber=biblio.biblionumber)
1038                         LEFT JOIN aqorderbreakdown on aqorders.ordernumber = aqorderbreakdown.ordernumber)
1039                         LEFT JOIN aqbookfund ON aqorderbreakdown.bookfundid = aqbookfund.bookfundid),
1040                         (aqbasket LEFT JOIN borrowers on aqbasket.authorisedby = borrowers.borrowernumber) LEFT JOIN aqbooksellers ON aqbasket.booksellerid = aqbooksellers.id
1041                     WHERE aqorders.basketno = aqbasket.basketno
1042                     AND (closedate < (CURDATE -(INTERVAL $delay DAY))
1043                     AND ((datereceived = '' OR datereceived is null)
1044                     OR (aqorders.quantityreceived < aqorders.quantity) ) ";
1045         $strsth .= " AND aqbasket.booksellerid = $supplierid " if ($supplierid);
1046
1047         $strsth .= " AND borrowers.branchcode like \'" . $branch . "\'" if ($branch);
1048         $strsth .=" AND borrowers.branchcode like \'". C4::Context->userenv->{branch} . "\'"
1049             if (C4::Context->preference("IndependantBranches") && C4::Context->userenv->{flags} != 1 );
1050         $strsth .=" ORDER BY latesince,basketno,borrowers.branchcode, supplier";
1051     }
1052     my $sth = $dbh->prepare($strsth);
1053     $sth->execute;
1054     my @results;
1055     my $hilighted = 1;
1056     while ( my $data = $sth->fetchrow_hashref ) {
1057         $data->{hilighted} = $hilighted if ( $hilighted > 0 );
1058         $data->{orderdate} = format_date( $data->{orderdate} );
1059         push @results, $data;
1060         $hilighted = -$hilighted;
1061     }
1062     $sth->finish;
1063     return @results;
1064 }
1065
1066 #------------------------------------------------------------#
1067
1068 =head3 GetHistory
1069
1070 =over 4
1071
1072 (\@order_loop, $total_qty, $total_price, $total_qtyreceived)=&GetHistory( $title, $author, $name, $from_placed_on, $to_placed_on )
1073
1074 this function get the search history.
1075
1076 =back
1077
1078 =cut
1079
1080 sub GetHistory {
1081     my ( $title, $author, $name, $from_placed_on, $to_placed_on ) = @_;
1082     my @order_loop;
1083     my $total_qty         = 0;
1084     my $total_qtyreceived = 0;
1085     my $total_price       = 0;
1086
1087 # don't run the query if there are no parameters (list would be too long for sure !)
1088     if ( $title || $author || $name || $from_placed_on || $to_placed_on ) {
1089         my $dbh   = C4::Context->dbh;
1090         my $query ="
1091             SELECT
1092                 biblio.title,
1093                 biblio.author,
1094                 aqorders.basketno,
1095                 name,aqbasket.creationdate,
1096                 aqorders.datereceived,
1097                 aqorders.quantity,
1098                 aqorders.quantityreceived,
1099                 aqorders.ecost,
1100                 aqorders.ordernumber,
1101                 aqorders.booksellerinvoicenumber as invoicenumber,
1102                 aqbooksellers.id as id,
1103                 aqorders.biblionumber
1104             FROM aqorders
1105             LEFT JOIN aqbasket ON aqorders.basketno=aqbasket.basketno
1106             LEFT JOIN aqbooksellers ON aqbasket.booksellerid=aqbooksellers.id
1107             LEFT JOIN biblio ON biblio.biblionumber=aqorders.biblionumber";
1108
1109         $query .= " LEFT JOIN borrowers ON aqbasket.authorisedby=borrowers.borrowernumber"
1110           if ( C4::Context->preference("IndependantBranches") );
1111
1112         $query .= " WHERE 1 ";
1113         $query .= " AND biblio.title LIKE " . $dbh->quote( "%" . $title . "%" )
1114           if $title;
1115
1116         $query .=
1117           " AND biblio.author LIKE " . $dbh->quote( "%" . $author . "%" )
1118           if $author;
1119
1120         $query .= " AND name LIKE " . $dbh->quote( "%" . $name . "%" ) if $name;
1121
1122         $query .= " AND creationdate >" . $dbh->quote($from_placed_on)
1123           if $from_placed_on;
1124
1125         $query .= " AND creationdate<" . $dbh->quote($to_placed_on)
1126           if $to_placed_on;
1127         $query .= " AND (datecancellationprinted is NULL or datecancellationprinted='0000-00-00')";
1128
1129         if ( C4::Context->preference("IndependantBranches") ) {
1130             my $userenv = C4::Context->userenv;
1131             if ( ($userenv) && ( $userenv->{flags} != 1 ) ) {
1132                 $query .=
1133                     " AND (borrowers.branchcode = '"
1134                   . $userenv->{branch}
1135                   . "' OR borrowers.branchcode ='')";
1136             }
1137         }
1138         $query .= " ORDER BY booksellerid";
1139         my $sth = $dbh->prepare($query);
1140         $sth->execute;
1141         my $cnt = 1;
1142         while ( my $line = $sth->fetchrow_hashref ) {
1143             $line->{count} = $cnt++;
1144             $line->{toggle} = 1 if $cnt % 2;
1145             push @order_loop, $line;
1146             $line->{creationdate} = format_date( $line->{creationdate} );
1147             $line->{datereceived} = format_date( $line->{datereceived} );
1148             $total_qty         += $line->{'quantity'};
1149             $total_qtyreceived += $line->{'quantityreceived'};
1150             $total_price       += $line->{'quantity'} * $line->{'ecost'};
1151         }
1152     }
1153     return \@order_loop, $total_qty, $total_price, $total_qtyreceived;
1154 }
1155
1156 =head2 GetRecentAcqui
1157
1158    $results = GetRecentAcqui($days);
1159
1160    C<$results> is a ref to a table which containts hashref
1161
1162 =cut
1163
1164 sub GetRecentAcqui {
1165     my $limit  = shift;
1166     my $dbh    = C4::Context->dbh;
1167     my $query = "
1168         SELECT *
1169         FROM   biblio
1170         ORDER BY timestamp DESC
1171         LIMIT  0,".$limit;
1172
1173     my $sth = $dbh->prepare($query);
1174     $sth->execute;
1175     my @results;
1176     while(my $data = $sth->fetchrow_hashref){
1177         push @results,$data;
1178     }
1179     return \@results;
1180 }
1181
1182 END { }    # module clean-up code here (global destructor)
1183
1184 1;
1185
1186 __END__
1187
1188 =back
1189
1190 =head1 AUTHOR
1191
1192 Koha Developement team <info@koha.org>
1193
1194 =cut