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 C4::Suggestions;
  27 use C4::Biblio;
  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    &GetHistory
  64   &ModOrder &ModReceiveOrder
  65   &GetSingleOrder
  66 );
  67
  68
  69 =head2 FUNCTIONS ABOUT BASKETS
  70
  71 =over 2
  72
  73 =cut
  74
  75 #------------------------------------------------------------#
  76
  77 =head3 GetBasket
  78
  79 =over 4
  80
  81 $aqbasket = &GetBasket($basketnumber);
  82
  83 get all basket informations in aqbasket for a given basket
  84
  85 return :
  86 informations for a given basket returned as a hashref.
  87
  88 =back
  89
  90 =back
  91
  92 =cut
  93
  94 sub GetBasket {
  95     my ($basketno) = shift;
  96     my $dbh        = C4::Context->dbh;
  97     my $query = "
  98         SELECT  aqbasket.*,
  99                 concat(borrowers.firstname,'  ',borrowers.surname) AS authorisedbyname,
 100                 borrowers.branchcode AS branch
 101         FROM    aqbasket
 102         LEFT JOIN borrowers ON aqbasket.authorisedby=borrowers.borrowernumber
 103         WHERE basketno=?
 104     ";
 105     my $sth=$dbh->prepare($query);
 106     $sth->execute($basketno);
 107     return ( $sth->fetchrow_hashref );
 108 }
 109
 110 #------------------------------------------------------------#
 111
 112 =head3 NewBasket
 113
 114 =over 4
 115
 116 $basket = &NewBasket();
 117
 118 Create a new basket in aqbasket table
 119
 120 =back
 121
 122 =cut
 123
 124 # FIXME : this function seems to be unused.
 125
 126 sub NewBasket {
 127     my ( $booksellerid, $authorisedby ) = @_;
 128     my $dbh = C4::Context->dbh;
 129     my $query = "
 130         INSERT INTO aqbasket
 131                 (creationdate,booksellerid,authorisedby)
 132         VALUES  (now(),'$booksellerid','$authorisedby')
 133     ";
 134     my $sth =
 135       $dbh->do($query);
 136
 137 #find & return basketno MYSQL dependant, but $dbh->last_insert_id always returns null :-(
 138     my $basket = $dbh->{'mysql_insertid'};
 139     return $basket;
 140 }
 141
 142 #------------------------------------------------------------#
 143
 144 =head3 CloseBasket
 145
 146 =over 4
 147
 148 &CloseBasket($basketno);
 149
 150 close a basket (becomes unmodifiable,except for recieves)
 151
 152 =back
 153
 154 =cut
 155
 156 sub CloseBasket {
 157     my ($basketno) = @_;
 158     my $dbh        = C4::Context->dbh;
 159     my $query = "
 160         UPDATE aqbasket
 161         SET    closedate=now()
 162         WHERE  basketno=?
 163     ";
 164     my $sth = $dbh->prepare($query);
 165     $sth->execute($basketno);
 166 }
 167
 168 #------------------------------------------------------------#
 169
 170 =back
 171
 172 =head2 FUNCTIONS ABOUT ORDERS
 173
 174 =over 2
 175
 176 =cut
 177
 178 #------------------------------------------------------------#
 179
 180 =head3 GetPendingOrders
 181
 182 =over 4
 183
 184 $orders = &GetPendingOrders($booksellerid);
 185
 186 Finds pending orders from the bookseller with the given ID. Ignores
 187 completed and cancelled orders.
 188
 189 C<$orders> is a reference-to-array; each element is a
 190 reference-to-hash with the following fields:
 191
 192 =over 2
 193
 194 =item C<authorizedby>
 195
 196 =item C<entrydate>
 197
 198 =item C<basketno>
 199
 200 These give the value of the corresponding field in the aqorders table
 201 of the Koha database.
 202
 203 =back
 204
 205 =back
 206
 207 Results are ordered from most to least recent.
 208
 209 =cut
 210
 211 sub GetPendingOrders {
 212     my $supplierid = shift;
 213     my $dbh = C4::Context->dbh;
 214     my $strsth = "SELECT aqorders.*,aqbasket.*,borrowers.firstname,borrowers.surname
 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     if ( C4::Context->preference("IndependantBranches") ) {
 224         my $userenv = C4::Context->userenv;
 225         if ( ($userenv) && ( $userenv->{flags} != 1 ) ) {
 226             $strsth .=
 227                 " and (borrowers.branchcode = '"
 228               . $userenv->{branch}
 229               . "' or borrowers.branchcode ='')";
 230         }
 231     }
 232    $strsth .= " group by aqbasket.basketno order by aqbasket.basketno";
 233     my $sth = $dbh->prepare($strsth);
 234     $sth->execute($supplierid);
 235     my @results;
 236     while (my $data = $sth->fetchrow_hashref ) {
 237         push @results, $data ;
 238   }
 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 non-cancelled orders (whether received or not) 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.*,
 270                 aqorders.*
 271         FROM    aqorders,biblio
 272         LEFT JOIN aqorderbreakdown ON
 273                     aqorders.ordernumber=aqorderbreakdown.ordernumber
 274         WHERE   basketno=?
 275             AND biblio.biblionumber=aqorders.biblionumber
 276             AND (datecancellationprinted IS NULL OR datecancellationprinted='0000-00-00')
 277     ";
 278
 279     $orderby = "biblio.title" unless $orderby;
 280     $query .= " ORDER BY $orderby";
 281     my $sth = $dbh->prepare($query);
 282     $sth->execute($basketno);
 283     my @results;
 284
 285     #  print $query;
 286     while ( my $data = $sth->fetchrow_hashref ) {
 287         push @results, $data;
 288     }
 289     $sth->finish;
 290     return @results;
 291 }
 292
 293 sub GetSingleOrder {
 294   my ($ordnum)=@_;
 295   my $dbh = C4::Context->dbh;
 296   my $sth=$dbh->prepare("Select * from biblio,aqorders left join aqorderbreakdown
 297   on aqorders.ordernumber=aqorderbreakdown.ordernumber
 298   where aqorders.ordernumber=?
 299   and biblio.biblionumber=aqorders.biblionumber");
 300   $sth->execute($ordnum);
 301   my $data=$sth->fetchrow_hashref;
 302   $sth->finish;
 303   return($data);
 304 }
 305
 306 #------------------------------------------------------------#
 307
 308 =head3 GetOrderNumber
 309
 310 =over 4
 311
 312 $ordernumber = &GetOrderNumber($biblioitemnumber, $biblionumber);
 313
 314 Looks up the ordernumber with the given biblionumber
 315
 316 Returns the number of this order.
 317
 318 =item C<$ordernumber> is the order number.
 319
 320 =back
 321
 322 =cut
 323 sub GetOrderNumber {
 324     my ( $biblionumber ) = @_;
 325     my $dbh = C4::Context->dbh;
 326     my $query = "
 327         SELECT ordernumber
 328         FROM   aqorders
 329         WHERE  biblionumber=?
 330
 331     ";
 332     my $sth = $dbh->prepare($query);
 333     $sth->execute( $biblionumber );
 334
 335     return $sth->fetchrow;
 336 }
 337
 338 #------------------------------------------------------------#
 339
 340 =head3 GetOrder
 341
 342 =over 4
 343
 344 $order = &GetOrder($ordernumber);
 345
 346 Looks up an order by order number.
 347
 348 Returns a reference-to-hash describing the order. The keys of
 349 C<$order> are fields from the biblio, , aqorders, and
 350 aqorderbreakdown tables of the Koha database.
 351
 352 =back
 353
 354 =cut
 355
 356 sub GetOrder {
 357     my ($ordnum) = @_;
 358     my $dbh      = C4::Context->dbh;
 359     my $query = "
 360         SELECT *
 361         FROM   biblio,aqorders
 362         LEFT JOIN aqorderbreakdown ON aqorders.ordernumber=aqorderbreakdown.ordernumber
 363         WHERE aqorders.ordernumber=?
 364         AND   biblio.biblionumber=aqorders.biblionumber
 365
 366     ";
 367     my $sth= $dbh->prepare($query);
 368     $sth->execute($ordnum);
 369     my $data = $sth->fetchrow_hashref;
 370     $sth->finish;
 371     return $data;
 372 }
 373
 374 #------------------------------------------------------------#
 375
 376 =head3 NewOrder
 377
 378 =over 4
 379
 380   &NewOrder($basket, $biblionumber, $title, $quantity, $listprice,
 381     $booksellerid, $who, $notes, $bookfund, $biblioitemnumber, $rrp,
 382     $ecost, $gst, $budget, $unitprice, $subscription,
 383     $booksellerinvoicenumber);
 384
 385 Adds a new order to the database. Any argument that isn't described
 386 below is the new value of the field with the same name in the aqorders
 387 table of the Koha database.
 388
 389 C<$ordnum> is a "minimum order number." After adding the new entry to
 390 the aqorders table, C<&neworder> finds the first entry in aqorders
 391 with order number greater than or equal to C<$ordnum>, and adds an
 392 entry to the aqorderbreakdown table, with the order number just found,
 393 and the book fund ID of the newly-added order.
 394
 395 C<$budget> is effectively ignored.
 396
 397 C<$subscription> may be either "yes", or anything else for "no".
 398
 399 =back
 400
 401 =cut
 402
 403 sub NewOrder {
 404    my (
 405         $basketno,  $biblionumber,       $title,        $quantity,
 406         $listprice, $booksellerid, $authorisedby, $notes,
 407         $bookfund,    $rrp,          $ecost,
 408         $gst,       $budget,       $cost,         $sub,
 409         $purchaseorderno,   $sort1,        $sort2,$discount,$branch
 410       )
 411       = @_;
 412
 413     my $year  = localtime->year() + 1900;
 414     my $month = localtime->mon() + 1;       # months starts at 0, add 1
 415
 416     if ( !$budget || $budget eq 'now' ) {
 417         $budget = "now()";
 418     }
 419
 420     if ( $sub eq 'yes' ) {
 421         $sub = 1;
 422     }
 423     else {
 424         $sub = 0;
 425     }
 426
 427     # if $basket empty, it's also a new basket, create it
 428     unless ($basketno) {
 429         $basketno = NewBasket( $booksellerid, $authorisedby );
 430     }
 431
 432     my $dbh = C4::Context->dbh;
 433     my $query = "
 434         INSERT INTO aqorders
 435            ( biblionumber,title,basketno,quantity,listprice,notes,
 436       rrp,ecost,gst,unitprice,subscription,sort1,sort2,purchaseordernumber,discount,budgetdate,entrydate)
 437         VALUES (?,?,?,?,?,?,?,?,?,?,?,?,?,?,?,$budget,now() )
 438     ";
 439     my $sth = $dbh->prepare($query);
 440
 441     $sth->execute(
 442         $biblionumber, $title,      $basketno, $quantity, $listprice,
 443         $notes,  $rrp,      $ecost,    $gst,
 444         $cost,   $sub,        $sort1,    $sort2,$purchaseorderno,$discount
 445     );
 446     $sth->finish;
 447
 448     #get ordnum MYSQL dependant, but $dbh->last_insert_id returns null
 449     my $ordnum = $dbh->{'mysql_insertid'};
 450     my $query = "
 451         INSERT INTO aqorderbreakdown (ordernumber,bookfundid,branchcode)
 452         VALUES (?,?,?)
 453     ";
 454     $sth = $dbh->prepare($query);
 455     $sth->execute( $ordnum, $bookfund,$branch );
 456     $sth->finish;
 457     return ( $basketno, $ordnum );
 458 }
 459
 460 #------------------------------------------------------------#
 461
 462 =head3 ModOrder
 463
 464 =over 4
 465
 466 &ModOrder($title, $ordernumber, $quantity, $listprice,
 467     $biblionumber, $basketno, $supplier, $who, $notes,
 468     $bookfundid, $bibitemnum, $rrp, $ecost, $gst, $budget,
 469     $unitprice, $booksellerinvoicenumber);
 470
 471 Modifies an existing order. Updates the order with order number
 472 C<$ordernumber> and biblionumber C<$biblionumber>. All other arguments
 473 update the fields with the same name in the aqorders table of the Koha
 474 database.
 475
 476 Entries with order number C<$ordernumber> in the aqorderbreakdown
 477 table are also updated to the new book fund ID.
 478
 479 =back
 480
 481 =cut
 482
 483 sub ModOrder {
 484     my (
 485         $title,      $ordnum,   $quantity, $listprice, $biblionumber,
 486         $basketno,   $supplier, $who,      $notes,     $bookfund,
 487         $rrp,      $ecost,    $gst,       $budget,
 488         $cost,       $invoice,  $sort1,    $sort2,$discount,$branch
 489       )
 490       = @_;
 491     my $dbh = C4::Context->dbh;
 492     my $query = "
 493         UPDATE aqorders
 494         SET    title=?,
 495                quantity=?,listprice=?,basketno=?,
 496                rrp=?,ecost=?,unitprice=?,purchaseordernumber=?,gst=?,
 497                notes=?,sort1=?, sort2=?,discount=?
 498         WHERE  ordernumber=? AND biblionumber=?
 499     ";
 500     my $sth = $dbh->prepare($query);
 501     $sth->execute(
 502         $title, $quantity, $listprice, $basketno, $rrp,
 503         $ecost, $cost,    $invoice, $gst,   $notes,    $sort1,
 504         $sort2, $discount,$ordnum,   $biblionumber
 505     );
 506     $sth->finish;
 507     my $query = "
 508         REPLACE aqorderbreakdown
 509         SET    ordernumber=?, bookfundid=?, branchcode=?
 510     ";
 511     $sth = $dbh->prepare($query);
 512
 513    $sth->execute( $ordnum,$bookfund, $branch );
 514
 515     $sth->finish;
 516 }
 517
 518 #------------------------------------------------------------#
 519
 520
 521
 522
 523 #------------------------------------------------------------#
 524
 525 =head3 ModReceiveOrder
 526
 527 =over 4
 528
 529 &ModReceiveOrder($biblionumber, $ordernumber, $quantityreceived, $user,
 530     $unitprice, $booksellerinvoicenumber, $biblioitemnumber,
 531     $freight, $bookfund, $rrp);
 532
 533 Updates an order, to reflect the fact that it was received, at least
 534 in part. All arguments not mentioned below update the fields with the
 535 same name in the aqorders table of the Koha database.
 536
 537 Updates the order with bibilionumber C<$biblionumber> and ordernumber
 538 C<$ordernumber>.
 539
 540
 541 =back
 542
 543 =cut
 544
 545
 546 sub ModReceiveOrder {
 547     my (
 548         $biblionumber,    $ordnum,  $quantrec,  $cost,
 549         $invoiceno, $freight, $rrp,      $listprice,$input
 550       )
 551       = @_;
 552     my $dbh = C4::Context->dbh;
 553     my $query = "
 554         UPDATE aqorders
 555         SET    quantityreceived=quantityreceived+?,datereceived=now(),booksellerinvoicenumber=?,
 556                unitprice=?,freight=?,rrp=?,listprice=?
 557         WHERE biblionumber=? AND ordernumber=?
 558     ";
 559     my $sth = $dbh->prepare($query);
 560     my $suggestionid = GetSuggestionFromBiblionumber( $dbh, $biblionumber );
 561     if ($suggestionid) {
 562         ModStatus( $suggestionid, 'AVAILABLE', '', $biblionumber,$input );
 563     }
 564     $sth->execute( $quantrec, $invoiceno, $cost, $freight, $rrp, $listprice, $biblionumber,
 565         $ordnum );
 566     $sth->finish;
 567
 568 }
 569
 570
 571 #------------------------------------------------------------#
 572
 573 =head3 DelOrder
 574
 575 =over 4
 576
 577 &DelOrder($biblionumber, $ordernumber);
 578
 579 Cancel the order with the given order and biblio numbers. It does not
 580 delete any entries in the aqorders table, it merely marks them as
 581 cancelled.
 582
 583 =back
 584
 585 =cut
 586
 587 sub DelOrder {
 588     my ( $biblionumber, $ordnum,$user ) = @_;
 589     my $dbh = C4::Context->dbh;
 590     my $query = "
 591         UPDATE aqorders
 592         SET    datecancellationprinted=now(), cancelledby=?
 593         WHERE  biblionumber=? AND ordernumber=?
 594     ";
 595     my $sth = $dbh->prepare($query);
 596     $sth->execute( $user,$biblionumber, $ordnum );
 597     $sth->finish;
 598 }
 599
 600
 601 =back
 602
 603 =back
 604
 605 =head2 FUNCTIONS ABOUT PARCELS
 606
 607 =over 2
 608
 609 =cut
 610
 611 #------------------------------------------------------------#
 612
 613 =head3 GetParcel
 614
 615 =over 4
 616
 617 @results = &GetParcel($booksellerid, $code, $date);
 618
 619 Looks up all of the received items from the supplier with the given
 620 bookseller ID at the given date, for the given code (bookseller Invoice number). Ignores cancelled and completed orders.
 621
 622 C<@results> is an array of references-to-hash. The keys of each element are fields from
 623 the aqorders, biblio tables of the Koha database.
 624
 625 C<@results> is sorted alphabetically by book title.
 626
 627 =back
 628
 629 =cut
 630 ## This routine is not used will be cleaned
 631 sub GetParcel {
 632
 633     #gets all orders from a certain supplier, orders them alphabetically
 634     my ( $supplierid, $invoice, $datereceived ) = @_;
 635     my $dbh     = C4::Context->dbh;
 636     my @results = ();
 637     $invoice .= '%' if $invoice;  # add % if we search on a given invoice
 638     my $strsth ="
 639         SELECT  authorisedby,
 640                 creationdate,
 641                 aqbasket.basketno,
 642                 closedate,surname,
 643                 firstname,
 644                 biblionumber,
 645                 aqorders.title,
 646                 aqorders.ordernumber,
 647                 aqorders.quantity,
 648                 aqorders.quantityreceived,
 649                 aqorders.unitprice,
 650                 aqorders.listprice,
 651                 aqorders.rrp,
 652                 aqorders.ecost
 653         FROM aqorders,aqbasket
 654         LEFT JOIN borrowers ON aqbasket.authorisedby=borrowers.borrowernumber
 655         WHERE aqbasket.basketno=aqorders.basketno
 656             AND aqbasket.booksellerid=?
 657             AND (aqorders.datereceived= \"$datereceived\" OR aqorders.datereceived is NULL)";
 658  $strsth.= " AND aqorders.purchaseordernumber LIKE  \"$invoice\"" if $invoice ne "%";
 659
 660     if ( C4::Context->preference("IndependantBranches") ) {
 661         my $userenv = C4::Context->userenv;
 662         if ( ($userenv) && ( $userenv->{flags} != 1 ) ) {
 663             $strsth .=
 664                 " and (borrowers.branchcode = '"
 665               . $userenv->{branch}
 666               . "' or borrowers.branchcode ='')";
 667         }
 668     }
 669     $strsth .= " order by aqbasket.basketno";
 670     ### parcelinformation : $strsth
 671     my $sth = $dbh->prepare($strsth);
 672     $sth->execute($supplierid);
 673     while ( my $data = $sth->fetchrow_hashref ) {
 674         push @results, $data ;
 675     }
 676     ### countparcelbiblio: $count
 677     $sth->finish;
 678
 679     return @results;
 680 }
 681
 682 #------------------------------------------------------------#
 683
 684 =head3 GetParcels
 685
 686 =over 4
 687
 688 $results = &GetParcels($bookseller, $order, $code, $datefrom, $dateto);
 689 get a lists of parcels.
 690
 691 * Input arg :
 692
 693 =item $bookseller
 694 is the bookseller this function has to get parcels.
 695
 696 =item $order
 697 To know on what criteria the results list has to be ordered.
 698
 699 =item $code
 700 is the booksellerinvoicenumber.
 701
 702 =item $datefrom & $dateto
 703 to know on what date this function has to filter its search.
 704
 705 * return:
 706 a pointer on a hash list containing parcel informations as such :
 707
 708 =item Creation date
 709
 710 =item Last operation
 711
 712 =item Number of biblio
 713
 714 =item Number of items
 715
 716 =back
 717
 718 =cut
 719 ### This routine is not used will be cleaned
 720 sub GetParcels {
 721     my ($bookseller,$order, $code, $datefrom, $dateto) = @_;
 722     my $dbh    = C4::Context->dbh;
 723     my $strsth ="
 724         SELECT  aqorders.booksellerinvoicenumber,
 725                 datereceived,
 726                 count(DISTINCT biblionumber) AS biblio,
 727                 sum(quantity) AS itemsexpected,
 728                 sum(quantityreceived) AS itemsreceived
 729         FROM   aqorders, aqbasket
 730         WHERE  aqbasket.basketno = aqorders.basketno
 731              AND aqbasket.booksellerid = $bookseller and datereceived IS NOT NULL
 732     ";
 733
 734     $strsth .= "and aqorders.booksellerinvoicenumber like \"$code%\" " if ($code);
 735
 736     $strsth .= "and datereceived >=" . $dbh->quote($datefrom) . " " if ($datefrom);
 737
 738     $strsth .= "and datereceived <=" . $dbh->quote($dateto) . " " if ($dateto);
 739
 740     $strsth .= "group by aqorders.booksellerinvoicenumber,datereceived ";
 741     $strsth .= "order by $order " if ($order);
 742     my $sth = $dbh->prepare($strsth);
 743
 744     $sth->execute;
 745     my @results;
 746
 747     while ( my $data2 = $sth->fetchrow_hashref ) {
 748         push @results, $data2;
 749     }
 750
 751     $sth->finish;
 752     return @results;
 753 }
 754
 755 #------------------------------------------------------------#
 756
 757 =head3 GetLateOrders
 758
 759 =over 4
 760
 761 @results = &GetLateOrders;
 762
 763 Searches for bookseller with late orders.
 764
 765 return:
 766 the table of supplier with late issues. This table is full of hashref.
 767
 768 =back
 769
 770 =cut
 771
 772 sub GetLateOrders {
 773 ## requirse fixing for KOHA 3 API. Currently does not return publisher
 774     my $delay      = shift;
 775     my $supplierid = shift;
 776     my $branch     = shift;
 777
 778     my $dbh = C4::Context->dbh;
 779
 780     #BEWARE, order of parenthesis and LEFT JOIN is important for speed
 781     my $strsth;
 782     my $dbdriver = C4::Context->config("db_scheme") || "mysql";
 783
 784     #    warn " $dbdriver";
 785     if ( $dbdriver eq "mysql" ) {
 786         $strsth = "
 787             SELECT aqbasket.basketno,
 788                 DATE(aqbasket.closedate) AS orderdate,
 789                 aqorders.quantity - IFNULL(aqorders.quantityreceived,0) AS quantity,
 790                 aqorders.rrp AS unitpricesupplier,
 791                 aqorders.ecost AS unitpricelib,
 792                 (aqorders.quantity - IFNULL(aqorders.quantityreceived,0)) * aqorders.rrp AS subtotal,
 793                 aqbookfund.bookfundname AS budget,
 794                 borrowers.branchcode AS branch,
 795                 aqbooksellers.name AS supplier,
 796                 aqorders.title,
 797                 biblio.author,
 798
 799                 DATEDIFF(CURDATE( ),closedate) AS latesince
 800             FROM  ((
 801                 (aqorders LEFT JOIN biblio ON biblio.biblionumber = aqorders.biblionumber)
 802
 803             LEFT JOIN aqorderbreakdown ON aqorders.ordernumber = aqorderbreakdown.ordernumber)
 804             LEFT JOIN aqbookfund ON aqorderbreakdown.bookfundid = aqbookfund.bookfundid),
 805             (aqbasket LEFT JOIN borrowers ON aqbasket.authorisedby = borrowers.borrowernumber)
 806             LEFT JOIN aqbooksellers ON aqbasket.booksellerid = aqbooksellers.id
 807             WHERE aqorders.basketno = aqbasket.basketno
 808             AND (closedate < DATE_SUB(CURDATE( ),INTERVAL $delay DAY))
 809             AND ((datereceived = '' OR datereceived is null)
 810             OR (aqorders.quantityreceived < aqorders.quantity) )
 811         ";
 812         $strsth .= " AND aqbasket.booksellerid = $supplierid " if ($supplierid);
 813         $strsth .= " AND borrowers.branchcode like \'" . $branch . "\'"
 814           if ($branch);
 815         $strsth .=
 816           " AND borrowers.branchcode like \'"
 817           . C4::Context->userenv->{branch} . "\'"
 818           if ( C4::Context->preference("IndependantBranches")
 819             && C4::Context->userenv
 820             && C4::Context->userenv->{flags} != 1 );
 821         $strsth .=" HAVING quantity<>0
 822                     AND unitpricesupplier<>0
 823                     AND unitpricelib<>0
 824                     ORDER BY latesince,basketno,borrowers.branchcode, supplier
 825         ";
 826     }
 827     else {
 828         $strsth = "
 829             SELECT aqbasket.basketno,
 830                    DATE(aqbasket.closedate) AS orderdate,
 831                     aqorders.quantity, aqorders.rrp AS unitpricesupplier,
 832                     aqorders.ecost as unitpricelib,
 833                     aqorders.quantity * aqorders.rrp AS subtotal
 834                     aqbookfund.bookfundname AS budget,
 835                     borrowers.branchcode AS branch,
 836                     aqbooksellers.name AS supplier,
 837                     biblio.title,
 838                     biblio.author,
 839
 840                     (CURDATE -  closedate) AS latesince
 841                     FROM((
 842                         (aqorders LEFT JOIN biblio on biblio.biblionumber = aqorders.biblionumber)
 843
 844                         LEFT JOIN aqorderbreakdown on aqorders.ordernumber = aqorderbreakdown.ordernumber)
 845                         LEFT JOIN aqbookfund ON aqorderbreakdown.bookfundid = aqbookfund.bookfundid),
 846                         (aqbasket LEFT JOIN borrowers on aqbasket.authorisedby = borrowers.borrowernumber) LEFT JOIN aqbooksellers ON aqbasket.booksellerid = aqbooksellers.id
 847                     WHERE aqorders.basketno = aqbasket.basketno
 848                     AND (closedate < (CURDATE -(INTERVAL $delay DAY))
 849                     AND ((datereceived = '' OR datereceived is null)
 850                     OR (aqorders.quantityreceived < aqorders.quantity) ) ";
 851         $strsth .= " AND aqbasket.booksellerid = $supplierid " if ($supplierid);
 852
 853         $strsth .= " AND borrowers.branchcode like \'" . $branch . "\'" if ($branch);
 854         $strsth .=" AND borrowers.branchcode like \'". C4::Context->userenv->{branch} . "\'"
 855             if (C4::Context->preference("IndependantBranches") && C4::Context->userenv->{flags} != 1 );
 856         $strsth .=" ORDER BY latesince,basketno,borrowers.branchcode, supplier";
 857     }
 858     my $sth = $dbh->prepare($strsth);
 859     $sth->execute;
 860     my @results;
 861     my $hilighted = 1;
 862     while ( my $data = $sth->fetchrow_hashref ) {
 863         $data->{hilighted} = $hilighted if ( $hilighted > 0 );
 864         $data->{orderdate} = format_date( $data->{orderdate} );
 865         push @results, $data;
 866         $hilighted = -$hilighted;
 867     }
 868     $sth->finish;
 869     return @results;
 870 }
 871
 872 #------------------------------------------------------------#
 873
 874 =head3 GetHistory
 875
 876 =over 4
 877
 878 (\@order_loop, $total_qty, $total_price, $total_qtyreceived)=&GetHistory( $title, $author, $name, $from_placed_on, $to_placed_on )
 879
 880 this function get the search history.
 881
 882 =back
 883
 884 =cut
 885
 886 sub GetHistory {
 887     my ( $title, $author, $name, $from_placed_on, $to_placed_on ) = @_;
 888     my @order_loop;
 889     my $total_qty         = 0;
 890     my $total_qtyreceived = 0;
 891     my $total_price       = 0;
 892
 893 # don't run the query if there are no parameters (list would be too long for sure !)
 894     if ( $title || $author || $name || $from_placed_on || $to_placed_on ) {
 895         my $dbh   = C4::Context->dbh;
 896         my $query ="
 897             SELECT
 898                 biblio.title,
 899                 biblio.author,
 900                 aqorders.basketno,
 901                 name,aqbasket.creationdate,
 902                 aqorders.datereceived,
 903                 aqorders.quantity,
 904                 aqorders.quantityreceived,
 905                 aqorders.ecost,
 906                 aqorders.ordernumber
 907             FROM aqorders,aqbasket,aqbooksellers,biblio";
 908
 909         $query .= ",borrowers "
 910           if ( C4::Context->preference("IndependantBranches") );
 911
 912         $query .="
 913             WHERE aqorders.basketno=aqbasket.basketno
 914             AND   aqbasket.booksellerid=aqbooksellers.id
 915             AND   biblio.biblionumber=aqorders.biblionumber ";
 916
 917         $query .= " AND aqbasket.authorisedby=borrowers.borrowernumber"
 918           if ( C4::Context->preference("IndependantBranches") );
 919
 920         $query .= " AND biblio.title LIKE " . $dbh->quote( "%" . $title . "%" )
 921           if $title;
 922
 923         $query .=
 924           " AND biblio.author LIKE " . $dbh->quote( "%" . $author . "%" )
 925           if $author;
 926
 927         $query .= " AND name LIKE " . $dbh->quote( "%" . $name . "%" ) if $name;
 928
 929         $query .= " AND creationdate >" . $dbh->quote($from_placed_on)
 930           if $from_placed_on;
 931
 932         $query .= " AND creationdate<" . $dbh->quote($to_placed_on)
 933           if $to_placed_on;
 934
 935         if ( C4::Context->preference("IndependantBranches") ) {
 936             my $userenv = C4::Context->userenv;
 937             if ( ($userenv) && ( $userenv->{flags} != 1 ) ) {
 938                 $query .=
 939                     " AND (borrowers.branchcode = '"
 940                   . $userenv->{branch}
 941                   . "' OR borrowers.branchcode ='')";
 942             }
 943         }
 944         $query .= " ORDER BY booksellerid";
 945         my $sth = $dbh->prepare($query);
 946         $sth->execute;
 947         my $cnt = 1;
 948         while ( my $line = $sth->fetchrow_hashref ) {
 949             $line->{count} = $cnt++;
 950             $line->{toggle} = 1 if $cnt % 2;
 951             push @order_loop, $line;
 952             $line->{creationdate} = format_date( $line->{creationdate} );
 953             $line->{datereceived} = format_date( $line->{datereceived} );
 954             $total_qty         += $line->{'quantity'};
 955             $total_qtyreceived += $line->{'quantityreceived'};
 956             $total_price       += $line->{'quantity'} * $line->{'ecost'};
 957         }
 958     }
 959     return \@order_loop, $total_qty, $total_price, $total_qtyreceived;
 960 }
 961
 962 END { }    # module clean-up code here (global destructor)
 963
 964 1;
 965
 966 __END__
 967
 968 =back
 969
 970 =head1 AUTHOR
 971
 972 Koha Developement team <info@koha.org>
 973
 974 =cut