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