C4/Acquisition.pm

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