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