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