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