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