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
  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) = @_;
  96     my $dbh        = C4::Context->dbh;
  97     my $query = "
  98         SELECT  aqbasket.*,
  99                 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 = @_;
 213     my $dbh = C4::Context->dbh;
 214     my $strsth = "
 215         SELECT    count(*),authorisedby,creationdate,aqbasket.basketno,
 216                   closedate,surname,firstname,aqorders.title
 217         FROM      aqorders
 218         LEFT JOIN aqbasket ON aqbasket.basketno=aqorders.basketno
 219         LEFT JOIN borrowers ON aqbasket.authorisedby=borrowers.borrowernumber
 220         WHERE booksellerid=?
 221         AND (quantity > quantityreceived OR quantityreceived is NULL)
 222         AND datecancellationprinted IS NULL
 223         AND (to_days(now())-to_days(closedate) < 180 OR closedate IS NULL)
 224     ";
 225     if ( C4::Context->preference("IndependantBranches") ) {
 226         my $userenv = C4::Context->userenv;
 227         if ( ($userenv) && ( $userenv->{flags} != 1 ) ) {
 228             $strsth .=
 229                 " and (borrowers.branchcode = '"
 230               . $userenv->{branch}
 231               . "' or borrowers.branchcode ='')";
 232         }
 233     }
 234     $strsth .= " group by basketno order by aqbasket.basketno";
 235     my $sth = $dbh->prepare($strsth);
 236     $sth->execute($supplierid);
 237     my @results = ();
 238     while ( my $data = $sth->fetchrow_hashref ) {
 239         push( @results, $data );
 240     }
 241     $sth->finish;
 242     return \@results;
 243 }
 244
 245 #------------------------------------------------------------#
 246
 247 =head3 GetOrders
 248
 249 =over 4
 250
 251 @orders = &GetOrders($basketnumber, $orderby);
 252
 253 Looks up the pending (non-cancelled) orders with the given basket
 254 number. If C<$booksellerID> is non-empty, only orders from that seller
 255 are returned.
 256
 257 return :
 258 C<&basket> returns a two-element array. C<@orders> is an array of
 259 references-to-hash, whose keys are the fields from the aqorders,
 260 biblio, and biblioitems tables in the Koha database.
 261
 262 =back
 263
 264 =cut
 265
 266 sub GetOrders {
 267     my ( $basketno, $orderby ) = @_;
 268     my $dbh   = C4::Context->dbh;
 269     my $query ="
 270         SELECT  aqorderbreakdown.*,
 271                 biblio.*,
 272                 aqorders.*,
 273                 biblio.title
 274         FROM    aqorders,biblio
 275         LEFT JOIN aqorderbreakdown ON
 276                     aqorders.ordernumber=aqorderbreakdown.ordernumber
 277         WHERE   basketno=?
 278             AND biblio.biblionumber=aqorders.biblionumber
 279             AND (datecancellationprinted IS NULL OR datecancellationprinted='0000-00-00')
 280     ";
 281
 282     $orderby = "biblio.title" 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
 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 ) = @_;
 315     my $dbh = C4::Context->dbh;
 316     my $query = "
 317         SELECT ordernumber
 318         FROM   aqorders
 319         WHERE  biblionumber=?
 320
 321     ";
 322     my $sth = $dbh->prepare($query);
 323     $sth->execute( $biblionumber );
 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, , 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,aqorders
 352         LEFT JOIN aqorderbreakdown ON aqorders.ordernumber=aqorderbreakdown.ordernumber
 353         WHERE aqorders.ordernumber=?
 354         AND   biblio.biblionumber=aqorders.biblionumber
 355
 356     ";
 357     my $sth= $dbh->prepare($query);
 358     $sth->execute($ordnum);
 359     my $data = $sth->fetchrow_hashref;
 360     $sth->finish;
 361     return $data;
 362 }
 363
 364 #------------------------------------------------------------#
 365
 366 =head3 NewOrder
 367
 368 =over 4
 369
 370   &NewOrder($basket, $biblionumber, $title, $quantity, $listprice,
 371     $booksellerid, $who, $notes, $bookfund, $biblioitemnumber, $rrp,
 372     $ecost, $gst, $budget, $unitprice, $subscription,
 373     $booksellerinvoicenumber);
 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,  $biblionumber,       $title,        $quantity,
 396         $listprice, $booksellerid, $authorisedby, $notes,
 397         $bookfund,    $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       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         $biblionumber, $title,      $basketno, $quantity, $listprice,
 444         $notes,  $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, $biblionumber,
 487         $basketno,   $supplier, $who,      $notes,     $bookfund,
 488         $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,   $biblionumber
 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
 544 #------------------------------------------------------------#
 545
 546 =head3 ModReceiveOrder
 547
 548 =over 4
 549
 550 &ModReceiveOrder($biblionumber, $ordernumber, $quantityreceived, $user,
 551     $unitprice, $booksellerinvoicenumber, $biblioitemnumber,
 552     $freight, $bookfund, $rrp);
 553
 554 Updates an order, to reflect the fact that it was received, at least
 555 in part. All arguments not mentioned below update the fields with the
 556 same name in the aqorders table of the Koha database.
 557
 558 Updates the order with bibilionumber C<$biblionumber> and ordernumber
 559 C<$ordernumber>.
 560
 561 Also updates the book fund ID in the aqorderbreakdown table.
 562
 563 =back
 564
 565 =cut
 566
 567
 568 sub ModReceiveOrder {
 569     my (
 570         $biblionumber,    $ordnum,  $quantrec, $user, $cost,
 571         $invoiceno, $freight, $rrp,      $bookfund
 572       )
 573       = @_;
 574     my $dbh = C4::Context->dbh;
 575     my $query = "
 576         UPDATE aqorders
 577         SET    quantityreceived=?,datereceived=now(),booksellerinvoicenumber=?,
 578                unitprice=?,freight=?,rrp=?
 579         WHERE biblionumber=? AND ordernumber=?
 580     ";
 581     my $sth = $dbh->prepare($query);
 582     my $suggestionid = GetSuggestionFromBiblionumber( $dbh, $biblionumber );
 583     if ($suggestionid) {
 584         ModStatus( $suggestionid, 'AVAILABLE', '', $biblionumber );
 585     }
 586     $sth->execute( $quantrec, $invoiceno, $cost, $freight, $rrp, $biblionumber,
 587         $ordnum );
 588     $sth->finish;
 589
 590     # Allows libraries to change their bookfund during receiving orders
 591     # allows them to adjust budgets
 592     if ( C4::Context->preferene("LooseBudgets") ) {
 593         my $query = "
 594             UPDATE aqorderbreakdown
 595             SET    bookfundid=?
 596             WHERE  ordernumber=?
 597         ";
 598         my $sth = $dbh->prepare($query);
 599         $sth->execute( $bookfund, $ordnum );
 600         $sth->finish;
 601     }
 602 }
 603
 604 #------------------------------------------------------------#
 605
 606 =head3 SearchOrder
 607
 608 @results = &SearchOrder($search, $biblionumber, $complete);
 609
 610 Searches for orders.
 611
 612 C<$search> may take one of several forms: if it is an ISBN,
 613 C<&ordersearch> returns orders with that ISBN. If C<$search> is an
 614 order number, C<&ordersearch> returns orders with that order number
 615 and biblionumber C<$biblionumber>. Otherwise, C<$search> is considered
 616 to be a space-separated list of search terms; in this case, all of the
 617 terms must appear in the title (matching the beginning of title
 618 words).
 619
 620 If C<$complete> is C<yes>, the results will include only completed
 621 orders. In any case, C<&ordersearch> ignores cancelled orders.
 622
 623 C<&ordersearch> returns an array.
 624 C<@results> is an array of references-to-hash with the following keys:
 625
 626 =over 4
 627
 628 =item C<author>
 629
 630 =item C<seriestitle>
 631
 632 =item C<branchcode>
 633
 634 =item C<bookfundid>
 635
 636 =back
 637
 638 =cut
 639
 640 sub SearchOrder {
 641 ### Requires fixing for KOHA 3 API for performance. Currently just fiixed so it works
 642 ## Very CPU expensive searches seems to be repeated!!
 643 ## This search can be directed to ZEBRA for title,isbn etc. ordernumber ,booksellerid to acquiorders
 644     my ( $search, $id, $biblio, $catview ) = @_;
 645     my $dbh = C4::Context->dbh;
 646     my @data = split( ' ', $search );
 647     my @searchterms;
 648     if ($id) {
 649         @searchterms = ($id);
 650     }
 651     map { push( @searchterms, "$_%", "% $_%" ) } @data;
 652     push( @searchterms, $search, $search, $biblio );
 653     my $query;
 654     if ($id) {
 655         $query =
 656           "SELECT *,biblio.title FROM aqorders,biblio,aqbasket
 657             WHERE biblio.biblionumber=aqorders.biblionumber AND
 658             aqorders.basketno = aqbasket.basketno
 659             AND aqbasket.booksellerid = ?
 660
 661             AND ((datecancellationprinted is NULL)
 662             OR (datecancellationprinted = '0000-00-00'))
 663             AND (("
 664           . (
 665             join( " AND ",
 666                 map { "(biblio.title like ? or biblio.title like ?)" } @data )
 667           )
 668           . ") OR biblio.isbn=? OR (aqorders.ordernumber=? AND aqorders.biblionumber=?)) ";
 669
 670     }
 671     else {
 672         $query =
 673           " SELECT *,biblio.title
 674             FROM   aqorders,biblio,aqbasket
 675             WHERE  aqorders.biblionumber = biblio.biblionumber
 676             AND    aqorders.basketno = aqbasket.basketno
 677
 678             AND    ((datecancellationprinted is NULL)
 679             OR     (datecancellationprinted = '0000-00-00'))
 680             AND    (aqorders.quantityreceived < aqorders.quantity OR aqorders.quantityreceived is NULL)
 681             AND (("
 682           . (
 683             join( " AND ",
 684                 map { "(biblio.title like ? OR biblio.title like ?)" } @data )
 685           )
 686           . ") or biblio.isbn=? OR (aqorders.ordernumber=? AND aqorders.biblionumber=?)) ";
 687     }
 688     $query .= " GROUP BY aqorders.ordernumber";
 689     my $sth = $dbh->prepare($query);
 690     $sth->execute(@searchterms);
 691     my @results = ();
 692
 693
 694
 695     my $query3 = "
 696         SELECT *
 697         FROM   aqorderbreakdown
 698         WHERE  ordernumber=?
 699     ";
 700     my $sth3 = $dbh->prepare($query3);
 701
 702     while ( my $data = $sth->fetchrow_hashref ) {
 703 ## Retrieving a whole marc record just to extract seriestitle is very poor performance
 704 ## Rewrite these searches
 705 my $record=MARCgetbiblio($dbh,$data->{'biblionumber'});
 706 my $data2=MARCmarc2koha($dbh,$record,"biblios");
 707
 708         $data->{'author'}      = $data2->{'author'};
 709         $data->{'seriestitle'} = $data2->{'seriestitle'};
 710         $sth3->execute( $data->{'ordernumber'} );
 711         my $data3 = $sth3->fetchrow_hashref;
 712         $data->{'branchcode'} = $data3->{'branchcode'};
 713         $data->{'bookfundid'} = $data3->{'bookfundid'};
 714         push( @results, $data );
 715     }
 716     $sth->finish;
 717
 718     $sth3->finish;
 719     return @results;
 720 }
 721
 722 #------------------------------------------------------------#
 723
 724 =head3 DelOrder
 725
 726 =over 4
 727
 728 &DelOrder($biblionumber, $ordernumber);
 729
 730 Cancel the order with the given order and biblio numbers. It does not
 731 delete any entries in the aqorders table, it merely marks them as
 732 cancelled.
 733
 734 =back
 735
 736 =cut
 737
 738 sub DelOrder {
 739     my ( $biblionumber, $ordnum ) = @_;
 740     my $dbh = C4::Context->dbh;
 741     my $query = "
 742         UPDATE aqorders
 743         SET    datecancellationprinted=now()
 744         WHERE  biblionumber=? AND ordernumber=?
 745     ";
 746     my $sth = $dbh->prepare($query);
 747     $sth->execute( $biblionumber, $ordnum );
 748     $sth->finish;
 749 }
 750
 751
 752 =back
 753
 754 =back
 755
 756 =head2 FUNCTIONS ABOUT PARCELS
 757
 758 =over 2
 759
 760 =cut
 761
 762 #------------------------------------------------------------#
 763
 764 =head3 GetParcel
 765
 766 =over 4
 767
 768 @results = &GetParcel($booksellerid, $code, $date);
 769
 770 Looks up all of the received items from the supplier with the given
 771 bookseller ID at the given date, for the given code (bookseller Invoice number). Ignores cancelled and completed orders.
 772
 773 C<@results> is an array of references-to-hash. The keys of each element are fields from
 774 the aqorders, biblio tables of the Koha database.
 775
 776 C<@results> is sorted alphabetically by book title.
 777
 778 =back
 779
 780 =cut
 781
 782 sub GetParcel {
 783
 784     #gets all orders from a certain supplier, orders them alphabetically
 785     my ( $supplierid, $code, $datereceived ) = @_;
 786     my $dbh     = C4::Context->dbh;
 787     my @results = ();
 788     $code .= '%'
 789       if $code;  # add % if we search on a given code (otherwise, let him empty)
 790     my $strsth ="
 791         SELECT  authorisedby,
 792                 creationdate,
 793                 aqbasket.basketno,
 794                 closedate,surname,
 795                 firstname,
 796                 aqorders.biblionumber,
 797                 aqorders.title,
 798                 aqorders.ordernumber,
 799                 aqorders.quantity,
 800                 aqorders.quantityreceived,
 801                 aqorders.unitprice,
 802                 aqorders.listprice,
 803                 aqorders.rrp,
 804                 aqorders.ecost
 805         FROM aqorders,aqbasket
 806         LEFT JOIN borrowers ON aqbasket.authorisedby=borrowers.borrowernumber
 807         WHERE aqbasket.basketno=aqorders.basketno
 808             AND aqbasket.booksellerid=?
 809             AND aqorders.booksellerinvoicenumber LIKE  \"$code\"
 810             AND aqorders.datereceived= \'$datereceived\'";
 811
 812     if ( C4::Context->preference("IndependantBranches") ) {
 813         my $userenv = C4::Context->userenv;
 814         if ( ($userenv) && ( $userenv->{flags} != 1 ) ) {
 815             $strsth .=
 816                 " and (borrowers.branchcode = '"
 817               . $userenv->{branch}
 818               . "' or borrowers.branchcode ='')";
 819         }
 820     }
 821     $strsth .= " order by aqbasket.basketno";
 822     ### parcelinformation : $strsth
 823     my $sth = $dbh->prepare($strsth);
 824     $sth->execute($supplierid);
 825     while ( my $data = $sth->fetchrow_hashref ) {
 826         push( @results, $data );
 827     }
 828     ### countparcelbiblio: $count
 829     $sth->finish;
 830
 831     return @results;
 832 }
 833
 834 #------------------------------------------------------------#
 835
 836 =head3 GetParcels
 837
 838 =over 4
 839
 840 $results = &GetParcels($bookseller, $order, $code, $datefrom, $dateto);
 841 get a lists of parcels.
 842
 843 * Input arg :
 844
 845 =item $bookseller
 846 is the bookseller this function has to get parcels.
 847
 848 =item $order
 849 To know on what criteria the results list has to be ordered.
 850
 851 =item $code
 852 is the booksellerinvoicenumber.
 853
 854 =item $datefrom & $dateto
 855 to know on what date this function has to filter its search.
 856
 857 * return:
 858 a pointer on a hash list containing parcel informations as such :
 859
 860 =item Creation date
 861
 862 =item Last operation
 863
 864 =item Number of biblio
 865
 866 =item Number of items
 867
 868 =back
 869
 870 =cut
 871
 872 sub GetParcels {
 873     my ($bookseller,$order, $code, $datefrom, $dateto) = @_;
 874     my $dbh    = C4::Context->dbh;
 875     my $strsth ="
 876         SELECT  aqorders.booksellerinvoicenumber,
 877                 datereceived,
 878                 count(DISTINCT biblionumber) AS biblio,
 879                 sum(quantity) AS itemsexpected,
 880                 sum(quantityreceived) AS itemsreceived
 881         FROM   aqorders, aqbasket
 882         WHERE  aqbasket.basketno = aqorders.basketno
 883              AND aqbasket.booksellerid = $bookseller and datereceived IS NOT NULL
 884     ";
 885
 886     $strsth .= "and aqorders.booksellerinvoicenumber like \"$code%\" " if ($code);
 887
 888     $strsth .= "and datereceived >=" . $dbh->quote($datefrom) . " " if ($datefrom);
 889
 890     $strsth .= "and datereceived <=" . $dbh->quote($dateto) . " " if ($dateto);
 891
 892     $strsth .= "group by aqorders.booksellerinvoicenumber,datereceived ";
 893     $strsth .= "order by $order " if ($order);
 894     my $sth = $dbh->prepare($strsth);
 895
 896     $sth->execute;
 897     my @results;
 898
 899     while ( my $data2 = $sth->fetchrow_hashref ) {
 900         push @results, $data2;
 901     }
 902
 903     $sth->finish;
 904     return @results;
 905 }
 906
 907 #------------------------------------------------------------#
 908
 909 =head3 GetLateOrders
 910
 911 =over 4
 912
 913 @results = &GetLateOrders;
 914
 915 Searches for bookseller with late orders.
 916
 917 return:
 918 the table of supplier with late issues. This table is full of hashref.
 919
 920 =back
 921
 922 =cut
 923
 924 sub GetLateOrders {
 925 ## requirse fixing for KOHA 3 API. Currently does not return publisher
 926     my $delay      = shift;
 927     my $supplierid = shift;
 928     my $branch     = shift;
 929
 930     my $dbh = C4::Context->dbh;
 931
 932     #BEWARE, order of parenthesis and LEFT JOIN is important for speed
 933     my $strsth;
 934     my $dbdriver = C4::Context->config("db_scheme") || "mysql";
 935
 936     #    warn " $dbdriver";
 937     if ( $dbdriver eq "mysql" ) {
 938         $strsth = "
 939             SELECT aqbasket.basketno,
 940                 DATE(aqbasket.closedate) AS orderdate,
 941                 aqorders.quantity - IFNULL(aqorders.quantityreceived,0) AS quantity,
 942                 aqorders.rrp AS unitpricesupplier,
 943                 aqorders.ecost AS unitpricelib,
 944                 (aqorders.quantity - IFNULL(aqorders.quantityreceived,0)) * aqorders.rrp AS subtotal,
 945                 aqbookfund.bookfundname AS budget,
 946                 borrowers.branchcode AS branch,
 947                 aqbooksellers.name AS supplier,
 948                 aqorders.title,
 949                 biblio.author,
 950
 951                 DATEDIFF(CURDATE( ),closedate) AS latesince
 952             FROM  ((
 953                 (aqorders LEFT JOIN biblio ON biblio.biblionumber = aqorders.biblionumber)
 954
 955             LEFT JOIN aqorderbreakdown ON aqorders.ordernumber = aqorderbreakdown.ordernumber)
 956             LEFT JOIN aqbookfund ON aqorderbreakdown.bookfundid = aqbookfund.bookfundid),
 957             (aqbasket LEFT JOIN borrowers ON aqbasket.authorisedby = borrowers.borrowernumber)
 958             LEFT JOIN aqbooksellers ON aqbasket.booksellerid = aqbooksellers.id
 959             WHERE aqorders.basketno = aqbasket.basketno
 960             AND (closedate < DATE_SUB(CURDATE( ),INTERVAL $delay DAY))
 961             AND ((datereceived = '' OR datereceived is null)
 962             OR (aqorders.quantityreceived < aqorders.quantity) )
 963         ";
 964         $strsth .= " AND aqbasket.booksellerid = $supplierid " if ($supplierid);
 965         $strsth .= " AND borrowers.branchcode like \'" . $branch . "\'"
 966           if ($branch);
 967         $strsth .=
 968           " AND borrowers.branchcode like \'"
 969           . C4::Context->userenv->{branch} . "\'"
 970           if ( C4::Context->preference("IndependantBranches")
 971             && C4::Context->userenv
 972             && C4::Context->userenv->{flags} != 1 );
 973         $strsth .=" HAVING quantity<>0
 974                     AND unitpricesupplier<>0
 975                     AND unitpricelib<>0
 976                     ORDER BY latesince,basketno,borrowers.branchcode, supplier
 977         ";
 978     }
 979     else {
 980         $strsth = "
 981             SELECT aqbasket.basketno,
 982                    DATE(aqbasket.closedate) AS orderdate,
 983                     aqorders.quantity, aqorders.rrp AS unitpricesupplier,
 984                     aqorders.ecost as unitpricelib,
 985                     aqorders.quantity * aqorders.rrp AS subtotal
 986                     aqbookfund.bookfundname AS budget,
 987                     borrowers.branchcode AS branch,
 988                     aqbooksellers.name AS supplier,
 989                     biblio.title,
 990                     biblio.author,
 991
 992                     (CURDATE -  closedate) AS latesince
 993                     FROM((
 994                         (aqorders LEFT JOIN biblio on biblio.biblionumber = aqorders.biblionumber)
 995
 996                         LEFT JOIN aqorderbreakdown on aqorders.ordernumber = aqorderbreakdown.ordernumber)
 997                         LEFT JOIN aqbookfund ON aqorderbreakdown.bookfundid = aqbookfund.bookfundid),
 998                         (aqbasket LEFT JOIN borrowers on aqbasket.authorisedby = borrowers.borrowernumber) LEFT JOIN aqbooksellers ON aqbasket.booksellerid = aqbooksellers.id
 999                     WHERE aqorders.basketno = aqbasket.basketno
1000                     AND (closedate < (CURDATE -(INTERVAL $delay DAY))
1001                     AND ((datereceived = '' OR datereceived is null)
1002                     OR (aqorders.quantityreceived < aqorders.quantity) ) ";
1003         $strsth .= " AND aqbasket.booksellerid = $supplierid " if ($supplierid);
1004
1005         $strsth .= " AND borrowers.branchcode like \'" . $branch . "\'" if ($branch);
1006         $strsth .=" AND borrowers.branchcode like \'". C4::Context->userenv->{branch} . "\'"
1007             if (C4::Context->preference("IndependantBranches") && C4::Context->userenv->{flags} != 1 );
1008         $strsth .=" ORDER BY latesince,basketno,borrowers.branchcode, supplier";
1009     }
1010     my $sth = $dbh->prepare($strsth);
1011     $sth->execute;
1012     my @results;
1013     my $hilighted = 1;
1014     while ( my $data = $sth->fetchrow_hashref ) {
1015         $data->{hilighted} = $hilighted if ( $hilighted > 0 );
1016         $data->{orderdate} = format_date( $data->{orderdate} );
1017         push @results, $data;
1018         $hilighted = -$hilighted;
1019     }
1020     $sth->finish;
1021     return @results;
1022 }
1023
1024 #------------------------------------------------------------#
1025
1026 =head3 GetHistory
1027
1028 =over 4
1029
1030 (\@order_loop, $total_qty, $total_price, $total_qtyreceived)=&GetHistory( $title, $author, $name, $from_placed_on, $to_placed_on )
1031
1032 this function get the search history.
1033
1034 =back
1035
1036 =cut
1037
1038 sub GetHistory {
1039     my ( $title, $author, $name, $from_placed_on, $to_placed_on ) = @_;
1040     my @order_loop;
1041     my $total_qty         = 0;
1042     my $total_qtyreceived = 0;
1043     my $total_price       = 0;
1044
1045 # don't run the query if there are no parameters (list would be too long for sure !)
1046     if ( $title || $author || $name || $from_placed_on || $to_placed_on ) {
1047         my $dbh   = C4::Context->dbh;
1048         my $query ="
1049             SELECT
1050                 biblio.title,
1051                 biblio.author,
1052                 aqorders.basketno,
1053                 name,aqbasket.creationdate,
1054                 aqorders.datereceived,
1055                 aqorders.quantity,
1056                 aqorders.quantityreceived,
1057                 aqorders.ecost,
1058                 aqorders.ordernumber
1059             FROM aqorders,aqbasket,aqbooksellers,biblio";
1060
1061         $query .= ",borrowers "
1062           if ( C4::Context->preference("IndependantBranches") );
1063
1064         $query .="
1065             WHERE aqorders.basketno=aqbasket.basketno
1066             AND   aqbasket.booksellerid=aqbooksellers.id
1067             AND   biblio.biblionumber=aqorders.biblionumber ";
1068
1069         $query .= " AND aqbasket.authorisedby=borrowers.borrowernumber"
1070           if ( C4::Context->preference("IndependantBranches") );
1071
1072         $query .= " AND biblio.title LIKE " . $dbh->quote( "%" . $title . "%" )
1073           if $title;
1074
1075         $query .=
1076           " AND biblio.author LIKE " . $dbh->quote( "%" . $author . "%" )
1077           if $author;
1078
1079         $query .= " AND name LIKE " . $dbh->quote( "%" . $name . "%" ) if $name;
1080
1081         $query .= " AND creationdate >" . $dbh->quote($from_placed_on)
1082           if $from_placed_on;
1083
1084         $query .= " AND creationdate<" . $dbh->quote($to_placed_on)
1085           if $to_placed_on;
1086
1087         if ( C4::Context->preference("IndependantBranches") ) {
1088             my $userenv = C4::Context->userenv;
1089             if ( ($userenv) && ( $userenv->{flags} != 1 ) ) {
1090                 $query .=
1091                     " AND (borrowers.branchcode = '"
1092                   . $userenv->{branch}
1093                   . "' OR borrowers.branchcode ='')";
1094             }
1095         }
1096         $query .= " ORDER BY booksellerid";
1097         my $sth = $dbh->prepare($query);
1098         $sth->execute;
1099         my $cnt = 1;
1100         while ( my $line = $sth->fetchrow_hashref ) {
1101             $line->{count} = $cnt++;
1102             $line->{toggle} = 1 if $cnt % 2;
1103             push @order_loop, $line;
1104             $line->{creationdate} = format_date( $line->{creationdate} );
1105             $line->{datereceived} = format_date( $line->{datereceived} );
1106             $total_qty         += $line->{'quantity'};
1107             $total_qtyreceived += $line->{'quantityreceived'};
1108             $total_price       += $line->{'quantity'} * $line->{'ecost'};
1109         }
1110     }
1111     return \@order_loop, $total_qty, $total_price, $total_qtyreceived;
1112 }
1113
1114 END { }    # module clean-up code here (global destructor)
1115
1116 1;
1117
1118 __END__
1119
1120 =back
1121
1122 =head1 AUTHOR
1123
1124 Koha Developement team <info@koha.org>
1125
1126 =cut