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
  21 use strict;
  22 use C4::Context;
  23 use C4::Debug;
  24 use C4::Dates qw(format_date format_date_in_iso);
  25 use MARC::Record;
  26 use C4::Suggestions;
  27 use C4::Debug;
  28
  29 use Time::localtime;
  30 use HTML::Entities;
  31
  32 use vars qw($VERSION @ISA @EXPORT);
  33
  34 BEGIN {
  35         # set the version for version checking
  36         $VERSION = 3.01;
  37         require Exporter;
  38         @ISA    = qw(Exporter);
  39         @EXPORT = qw(
  40                 &GetBasket &NewBasket &CloseBasket &DelBasket &ModBasket
  41                 &ModBasketHeader &GetBasketsByBookseller &GetBasketsByBasketgroup
  42                 &ModBasketgroup &NewBasketgroup &DelBasketgroup &GetBasketgroup
  43                 &GetBasketgroups
  44
  45                 &GetPendingOrders &GetOrder &GetOrders
  46                 &GetOrderNumber &GetLateOrders &NewOrder &DelOrder
  47                 &SearchOrder &GetHistory &GetRecentAcqui
  48                 &ModOrder &ModOrderItem &ModReceiveOrder &ModOrderBiblioitemNumber
  49
  50         &NewOrderItem
  51
  52                 &GetParcels &GetParcel
  53                 &GetContracts &GetContract
  54
  55         &GetOrderFromItemnumber
  56         &GetItemnumbersFromOrder
  57         );
  58 }
  59
  60
  61
  62
  63
  64 sub GetOrderFromItemnumber {
  65     my ($itemnumber) = @_;
  66     my $dbh          = C4::Context->dbh;
  67     my $query        = qq|
  68
  69     SELECT  * from aqorders    LEFT JOIN aqorders_items
  70     ON (     aqorders.ordernumber = aqorders_items.ordernumber   )
  71     WHERE itemnumber = ?  |;
  72
  73     my $sth = $dbh->prepare($query);
  74
  75     $sth->trace(3);
  76
  77     $sth->execute($itemnumber);
  78
  79     my $order = $sth->fetchrow_hashref;
  80         return ( $order  );
  81
  82 }
  83
  84 # Returns the itemnumber(s) associated with the ordernumber given in parameter
  85 sub GetItemnumbersFromOrder {
  86     my ($ordernumber) = @_;
  87     my $dbh          = C4::Context->dbh;
  88     my $query        = "SELECT itemnumber FROM aqorders_items WHERE ordernumber=?";
  89     my $sth = $dbh->prepare($query);
  90     $sth->execute($ordernumber);
  91     my @tab;
  92
  93     while (my $order = $sth->fetchrow_hashref) {
  94         push @tab, $order->{'itemnumber'};
  95     }
  96
  97     return @tab;
  98
  99 }
 100
 101
 102
 103
 104
 105
 106 =head1 NAME
 107
 108 C4::Acquisition - Koha functions for dealing with orders and acquisitions
 109
 110 =head1 SYNOPSIS
 111
 112 use C4::Acquisition;
 113
 114 =head1 DESCRIPTION
 115
 116 The functions in this module deal with acquisitions, managing book
 117 orders, basket and parcels.
 118
 119 =head1 FUNCTIONS
 120
 121 =head2 FUNCTIONS ABOUT BASKETS
 122
 123 =head3 GetBasket
 124
 125 =over 4
 126
 127 $aqbasket = &GetBasket($basketnumber);
 128
 129 get all basket informations in aqbasket for a given basket
 130
 131 return :
 132 informations for a given basket returned as a hashref.
 133
 134 =back
 135
 136 =cut
 137
 138 sub GetBasket {
 139     my ($basketno) = @_;
 140     my $dbh        = C4::Context->dbh;
 141     my $query = "
 142         SELECT  aqbasket.*,
 143                 concat( b.firstname,' ',b.surname) AS authorisedbyname,
 144                 b.branchcode AS branch
 145         FROM    aqbasket
 146         LEFT JOIN borrowers b ON aqbasket.authorisedby=b.borrowernumber
 147         WHERE basketno=?
 148     ";
 149     my $sth=$dbh->prepare($query);
 150     $sth->execute($basketno);
 151     my $basket = $sth->fetchrow_hashref;
 152         return ( $basket );
 153 }
 154
 155 #------------------------------------------------------------#
 156
 157 =head3 NewBasket
 158
 159 =over 4
 160
 161 $basket = &NewBasket( $booksellerid, $authorizedby, $basketname, $basketnote, $basketbooksellernote, $basketcontractnumber );
 162
 163 Create a new basket in aqbasket table
 164
 165 =item C<$booksellerid> is a foreign key in the aqbasket table
 166
 167 =item C<$authorizedby> is the username of who created the basket
 168
 169 The other parameters are optional, see ModBasketHeader for more info on them.
 170
 171 =back
 172
 173 =cut
 174
 175 # FIXME : this function seems to be unused.
 176
 177 sub NewBasket {
 178     my ( $booksellerid, $authorisedby, $basketname, $basketnote, $basketbooksellernote, $basketcontractnumber ) = @_;
 179     my $dbh = C4::Context->dbh;
 180     my $query = "
 181         INSERT INTO aqbasket
 182                 (creationdate,booksellerid,authorisedby)
 183         VALUES  (now(),'$booksellerid','$authorisedby')
 184     ";
 185     my $sth =
 186       $dbh->do($query);
 187 #find & return basketno MYSQL dependant, but $dbh->last_insert_id always returns null :-(
 188     my $basket = $dbh->{'mysql_insertid'};
 189     ModBasketHeader($basket, $basketname || '', $basketnote || '', $basketbooksellernote || '', $basketcontractnumber || undef);
 190     return $basket;
 191 }
 192
 193 #------------------------------------------------------------#
 194
 195 =head3 CloseBasket
 196
 197 =over 4
 198
 199 &CloseBasket($basketno);
 200
 201 close a basket (becomes unmodifiable,except for recieves)
 202
 203 =back
 204
 205 =cut
 206
 207 sub CloseBasket {
 208     my ($basketno) = @_;
 209     my $dbh        = C4::Context->dbh;
 210     my $query = "
 211         UPDATE aqbasket
 212         SET    closedate=now()
 213         WHERE  basketno=?
 214     ";
 215     my $sth = $dbh->prepare($query);
 216     $sth->execute($basketno);
 217 }
 218
 219 #------------------------------------------------------------#
 220
 221 =head3 DelBasket
 222
 223 =over 4
 224
 225 &DelBasket($basketno);
 226
 227 Deletes the basket that has basketno field $basketno in the aqbasket table.
 228
 229 =over 2
 230
 231 =item C<$basketno> is the primary key of the basket in the aqbasket table.
 232
 233 =back
 234
 235 =back
 236
 237 =cut
 238 sub DelBasket {
 239     my ( $basketno ) = @_;
 240     my $query = "DELETE FROM aqbasket WHERE basketno=?";
 241     my $dbh = C4::Context->dbh;
 242     my $sth = $dbh->prepare($query);
 243     $sth->execute($basketno);
 244     $sth->finish;
 245 }
 246
 247 #------------------------------------------------------------#
 248
 249 =head3 ModBasket
 250
 251 =over 4
 252
 253 &ModBasket($basketinfo);
 254
 255 Modifies a basket, using a hashref $basketinfo for the relevant information, only $basketinfo->{'basketno'} is required.
 256
 257 =over 2
 258
 259 =item C<$basketno> is the primary key of the basket in the aqbasket table.
 260
 261 =back
 262
 263 =back
 264
 265 =cut
 266 sub ModBasket {
 267     my $basketinfo = shift;
 268     my $query = "UPDATE aqbasket SET ";
 269     my @params;
 270     foreach my $key (keys %$basketinfo){
 271         if ($key ne 'basketno'){
 272             $query .= "$key=?, ";
 273             push(@params, $basketinfo->{$key} || undef );
 274         }
 275     }
 276 # get rid of the "," at the end of $query
 277     if (substr($query, length($query)-2) eq ', '){
 278         chop($query);
 279         chop($query);
 280         $query .= ' ';
 281     }
 282     $query .= "WHERE basketno=?";
 283     push(@params, $basketinfo->{'basketno'});
 284     my $dbh = C4::Context->dbh;
 285     my $sth = $dbh->prepare($query);
 286     $sth->execute(@params);
 287     $sth->finish;
 288 }
 289
 290 #------------------------------------------------------------#
 291
 292 =head3 ModBasketHeader
 293
 294 =over 4
 295
 296 &ModBasketHeader($basketno, $basketname, $note, $booksellernote, $contractnumber);
 297
 298 Modifies a basket's header.
 299
 300 =over 2
 301
 302 =item C<$basketno> is the "basketno" field in the "aqbasket" table;
 303
 304 =item C<$basketname> is the "basketname" field in the "aqbasket" table;
 305
 306 =item C<$note> is the "note" field in the "aqbasket" table;
 307
 308 =item C<$booksellernote> is the "booksellernote" field in the "aqbasket" table;
 309
 310 =item C<$contractnumber> is the "contractnumber" (foreign) key in the "aqbasket" table.
 311
 312 =back
 313
 314 =back
 315
 316 =cut
 317 sub ModBasketHeader {
 318     my ($basketno, $basketname, $note, $booksellernote, $contractnumber) = @_;
 319     my $query = "UPDATE aqbasket SET basketname=?, note=?, booksellernote=? WHERE basketno=?";
 320     my $dbh = C4::Context->dbh;
 321     my $sth = $dbh->prepare($query);
 322     $sth->execute($basketname,$note,$booksellernote,$basketno);
 323     if ( $contractnumber ) {
 324         my $query2 ="UPDATE aqbasket SET contractnumber=? WHERE basketno=?";
 325         my $sth2 = $dbh->prepare($query2);
 326         $sth2->execute($contractnumber,$basketno);
 327         $sth2->finish;
 328     }
 329     $sth->finish;
 330 }
 331
 332 #------------------------------------------------------------#
 333
 334 =head3 GetBasketsByBookseller
 335
 336 =over 4
 337
 338 @results = &GetBasketsByBookseller($booksellerid, $extra);
 339
 340 Returns a list of hashes of all the baskets that belong to bookseller 'booksellerid'.
 341
 342 =over 2
 343
 344 =item C<$booksellerid> is the 'id' field of the bookseller in the aqbooksellers table
 345
 346 =item C<$extra> is the extra sql parameters, can be
 347
 348   - $extra->{groupby}: group baskets by column
 349        ex. $extra->{groupby} = aqbasket.basketgroupid
 350   - $extra->{orderby}: order baskets by column
 351   - $extra->{limit}: limit number of results (can be helpful for pagination)
 352
 353 =back
 354
 355 =back
 356
 357 =cut
 358
 359 sub GetBasketsByBookseller {
 360     my ($booksellerid, $extra) = @_;
 361     my $query = "SELECT * FROM aqbasket WHERE booksellerid=?";
 362     if ($extra){
 363         if ($extra->{groupby}) {
 364             $query .= " GROUP by $extra->{groupby}";
 365         }
 366         if ($extra->{orderby}){
 367             $query .= " ORDER by $extra->{orderby}";
 368         }
 369         if ($extra->{limit}){
 370             $query .= " LIMIT $extra->{limit}";
 371         }
 372     }
 373     my $dbh = C4::Context->dbh;
 374     my $sth = $dbh->prepare($query);
 375     $sth->execute($booksellerid);
 376     my $results = $sth->fetchall_arrayref({});
 377     $sth->finish;
 378     return $results
 379 }
 380
 381 #------------------------------------------------------------#
 382
 383 =head3 GetBasketsByBasketgroup
 384
 385 =over 4
 386
 387 $baskets = &GetBasketsByBasketgroup($basketgroupid);
 388
 389 =over 2
 390
 391 Returns a reference to all baskets that belong to basketgroup $basketgroupid.
 392
 393 =back
 394
 395 =back
 396
 397 =cut
 398
 399 sub GetBasketsByBasketgroup {
 400     my $basketgroupid = shift;
 401     my $query = "SELECT * FROM aqbasket
 402                 LEFT JOIN aqcontract USING(contractnumber) WHERE basketgroupid=?";
 403     my $dbh = C4::Context->dbh;
 404     my $sth = $dbh->prepare($query);
 405     $sth->execute($basketgroupid);
 406     my $results = $sth->fetchall_arrayref({});
 407     $sth->finish;
 408     return $results
 409 }
 410
 411 #------------------------------------------------------------#
 412
 413 =head3 NewBasketgroup
 414
 415 =over 4
 416
 417 $basketgroupid = NewBasketgroup(\%hashref);
 418
 419 =over 2
 420
 421 Adds a basketgroup to the aqbasketgroups table, and add the initial baskets to it.
 422
 423 $hashref->{'booksellerid'} is the 'id' field of the bookseller in the aqbooksellers table,
 424
 425 $hashref->{'name'} is the 'name' field of the basketgroup in the aqbasketgroups table,
 426
 427 $hashref->{'basketlist'} is a list reference of the 'id's of the baskets that belong to this group,
 428
 429 $hashref->{'closed'} is the 'closed' field of the aqbasketgroups table, it is false if 0, true otherwise.
 430
 431 =back
 432
 433 =back
 434
 435 =cut
 436
 437 sub NewBasketgroup {
 438     my $basketgroupinfo = shift;
 439     die "booksellerid is required to create a basketgroup" unless $basketgroupinfo->{'booksellerid'};
 440     my $query = "INSERT INTO aqbasketgroups (";
 441     my @params;
 442     foreach my $field ('name', 'closed') {
 443         if ( $basketgroupinfo->{$field} ) {
 444             $query .= "$field, ";
 445             push(@params, $basketgroupinfo->{$field});
 446         }
 447     }
 448     $query .= "booksellerid) VALUES (";
 449     foreach (@params) {
 450         $query .= "?, ";
 451     }
 452     $query .= "?)";
 453     push(@params, $basketgroupinfo->{'booksellerid'});
 454     my $dbh = C4::Context->dbh;
 455     my $sth = $dbh->prepare($query);
 456     $sth->execute(@params);
 457     my $basketgroupid = $dbh->{'mysql_insertid'};
 458     if( $basketgroupinfo->{'basketlist'} ) {
 459         foreach my $basketno (@{$basketgroupinfo->{'basketlist'}}) {
 460             my $query2 = "UPDATE aqbasket SET basketgroupid=? WHERE basketno=?";
 461             my $sth2 = $dbh->prepare($query2);
 462             $sth2->execute($basketgroupid, $basketno);
 463         }
 464     }
 465     return $basketgroupid;
 466 }
 467
 468 #------------------------------------------------------------#
 469
 470 =head3 ModBasketgroup
 471
 472 =over 4
 473
 474 ModBasketgroup(\%hashref);
 475
 476 =over 2
 477
 478 Modifies a basketgroup in the aqbasketgroups table, and add the baskets to it.
 479
 480 $hashref->{'id'} is the 'id' field of the basketgroup in the aqbasketgroup table, this parameter is mandatory,
 481
 482 $hashref->{'name'} is the 'name' field of the basketgroup in the aqbasketgroups table,
 483
 484 $hashref->{'basketlist'} is a list reference of the 'id's of the baskets that belong to this group,
 485
 486 $hashref->{'closed'} is the 'closed' field of the aqbasketgroups table, it is false if 0, true otherwise.
 487
 488 =back
 489
 490 =back
 491
 492 =cut
 493
 494 sub ModBasketgroup {
 495     my $basketgroupinfo = shift;
 496     die "basketgroup id is required to edit a basketgroup" unless $basketgroupinfo->{'id'};
 497     my $dbh = C4::Context->dbh;
 498     my $query = "UPDATE aqbasketgroups SET ";
 499     my @params;
 500     foreach my $field (qw(name closed)) {
 501         if ( $basketgroupinfo->{$field} ne undef) {
 502             $query .= "$field=?, ";
 503             push(@params, $basketgroupinfo->{$field});
 504         }
 505     }
 506     chop($query);
 507     chop($query);
 508     $query .= " WHERE id=?";
 509     push(@params, $basketgroupinfo->{'id'});
 510     my $sth = $dbh->prepare($query);
 511     $sth->execute(@params);
 512     if($basketgroupinfo->{'basketlist'} && @{$basketgroupinfo->{'basketlist'}}){
 513         foreach my $basketno (@{$basketgroupinfo->{'basketlist'}}) {
 514             my $query2 = "UPDATE aqbasket SET basketgroupid=? WHERE basketno=?";
 515             my $sth2 = $dbh->prepare($query2);
 516             $sth2->execute($basketgroupinfo->{'id'}, $basketno);
 517             $sth2->finish;
 518         }
 519     }
 520     $sth->finish;
 521 }
 522
 523 #------------------------------------------------------------#
 524
 525 =head3 DelBasketgroup
 526
 527 =over 4
 528
 529 DelBasketgroup($basketgroupid);
 530
 531 =over 2
 532
 533 Deletes a basketgroup in the aqbasketgroups table, and removes the reference to it from the baskets,
 534
 535 =item C<$basketgroupid> is the 'id' field of the basket in the aqbasketgroup table
 536
 537 =back
 538
 539 =back
 540
 541 =cut
 542
 543 sub DelBasketgroup {
 544     my $basketgroupid = shift;
 545     die "basketgroup id is required to edit a basketgroup" unless $basketgroupid;
 546     my $query = "DELETE FROM aqbasketgroups WHERE id=?";
 547     my $dbh = C4::Context->dbh;
 548     my $sth = $dbh->prepare($query);
 549     $sth->execute($basketgroupid);
 550     $sth->finish;
 551 }
 552
 553 #------------------------------------------------------------#
 554
 555 =back
 556
 557 =head2 FUNCTIONS ABOUT ORDERS
 558
 559 =over 2
 560
 561 =cut
 562
 563 =head3 GetBasketgroup
 564
 565 =over 4
 566
 567 $basketgroup = &GetBasketgroup($basketgroupid);
 568
 569 =over 2
 570
 571 Returns a reference to the hash containing all infermation about the basketgroup.
 572
 573 =back
 574
 575 =back
 576
 577 =cut
 578
 579 sub GetBasketgroup {
 580     my $basketgroupid = shift;
 581     die "basketgroup id is required to edit a basketgroup" unless $basketgroupid;
 582     my $query = "SELECT * FROM aqbasketgroups WHERE id=?";
 583     my $dbh = C4::Context->dbh;
 584     my $sth = $dbh->prepare($query);
 585     $sth->execute($basketgroupid);
 586     my $result = $sth->fetchrow_hashref;
 587     $sth->finish;
 588     return $result
 589 }
 590
 591 #------------------------------------------------------------#
 592
 593 =head3 GetBasketgroups
 594
 595 =over 4
 596
 597 $basketgroups = &GetBasketgroups($booksellerid);
 598
 599 =over 2
 600
 601 Returns a reference to the array of all the basketgroups of bookseller $booksellerid.
 602
 603 =back
 604
 605 =back
 606
 607 =cut
 608
 609 sub GetBasketgroups {
 610     my $booksellerid = shift;
 611     die "bookseller id is required to edit a basketgroup" unless $booksellerid;
 612     my $query = "SELECT * FROM aqbasketgroups WHERE booksellerid=?";
 613     my $dbh = C4::Context->dbh;
 614     my $sth = $dbh->prepare($query);
 615     $sth->execute($booksellerid);
 616     my $results = $sth->fetchall_arrayref({});
 617     $sth->finish;
 618     return $results
 619 }
 620
 621 #------------------------------------------------------------#
 622
 623 =back
 624
 625 =head2 FUNCTIONS ABOUT ORDERS
 626
 627 =over 2
 628
 629 =cut
 630
 631 #------------------------------------------------------------#
 632
 633 =head3 GetPendingOrders
 634
 635 =over 4
 636
 637 $orders = &GetPendingOrders($booksellerid, $grouped, $owner);
 638
 639 Finds pending orders from the bookseller with the given ID. Ignores
 640 completed and cancelled orders.
 641
 642 C<$booksellerid> contains the bookseller identifier
 643 C<$grouped> contains 0 or 1. 0 means returns the list, 1 means return the total
 644 C<$owner> contains 0 or 1. 0 means any owner. 1 means only the list of orders entered by the user itself.
 645
 646 C<$orders> is a reference-to-array; each element is a
 647 reference-to-hash with the following fields:
 648 C<$grouped> is a boolean that, if set to 1 will group all order lines of the same basket
 649 in a single result line
 650
 651 =over 2
 652
 653 =item C<authorizedby>
 654
 655 =item C<entrydate>
 656
 657 =item C<basketno>
 658
 659 These give the value of the corresponding field in the aqorders table
 660 of the Koha database.
 661
 662 =back
 663
 664 =back
 665
 666 Results are ordered from most to least recent.
 667
 668 =cut
 669
 670 sub GetPendingOrders {
 671     my ($supplierid,$grouped,$owner,$basketno) = @_;
 672     my $dbh = C4::Context->dbh;
 673     my $strsth = "
 674         SELECT    ".($grouped?"count(*),":"")."aqbasket.basketno,
 675                     surname,firstname,aqorders.*,biblio.*,biblioitems.isbn,
 676                     aqbasket.closedate, aqbasket.creationdate, aqbasket.basketname
 677         FROM      aqorders
 678         LEFT JOIN aqbasket ON aqbasket.basketno=aqorders.basketno
 679         LEFT JOIN borrowers ON aqbasket.authorisedby=borrowers.borrowernumber
 680         LEFT JOIN biblio ON biblio.biblionumber=aqorders.biblionumber
 681         LEFT JOIN biblioitems ON biblioitems.biblionumber=biblio.biblionumber
 682         WHERE booksellerid=?
 683             AND (quantity > quantityreceived OR quantityreceived is NULL)
 684             AND datecancellationprinted IS NULL
 685             AND (to_days(now())-to_days(closedate) < 180 OR closedate IS NULL)
 686     ";
 687     ## FIXME  Why 180 days ???
 688     my @query_params = ( $supplierid );
 689     my $userenv = C4::Context->userenv;
 690     if ( C4::Context->preference("IndependantBranches") ) {
 691         if ( ($userenv) && ( $userenv->{flags} != 1 ) ) {
 692             $strsth .= " and (borrowers.branchcode = ?
 693                           or borrowers.branchcode  = '')";
 694             push @query_params, $userenv->{branch};
 695         }
 696     }
 697     if ($owner) {
 698         $strsth .= " AND aqbasket.authorisedby=? ";
 699         push @query_params, $userenv->{'number'};
 700     }
 701     if ($basketno) {
 702         $strsth .= " AND aqbasket.basketno=? ";
 703         push @query_params, $basketno;
 704     }
 705     $strsth .= " group by aqbasket.basketno" if $grouped;
 706     $strsth .= " order by aqbasket.basketno";
 707
 708     my $sth = $dbh->prepare($strsth);
 709     $sth->execute( @query_params );
 710     my $results = $sth->fetchall_arrayref({});
 711     $sth->finish;
 712     return $results;
 713 }
 714
 715 #------------------------------------------------------------#
 716
 717 =head3 GetOrders
 718
 719 =over 4
 720
 721 @orders = &GetOrders($basketnumber, $orderby);
 722
 723 Looks up the pending (non-cancelled) orders with the given basket
 724 number. If C<$booksellerID> is non-empty, only orders from that seller
 725 are returned.
 726
 727 return :
 728 C<&basket> returns a two-element array. C<@orders> is an array of
 729 references-to-hash, whose keys are the fields from the aqorders,
 730 biblio, and biblioitems tables in the Koha database.
 731
 732 =back
 733
 734 =cut
 735
 736 sub GetOrders {
 737     my ( $basketno, $orderby ) = @_;
 738     my $dbh   = C4::Context->dbh;
 739     my $query  ="
 740          SELECT biblio.*,biblioitems.*,
 741                 aqorders.*,
 742                 aqbudgets.*,
 743                 biblio.title
 744         FROM    aqorders
 745             LEFT JOIN aqbudgets        ON aqbudgets.budget_id = aqorders.budget_id
 746             LEFT JOIN biblio           ON biblio.biblionumber = aqorders.biblionumber
 747             LEFT JOIN biblioitems      ON biblioitems.biblionumber =biblio.biblionumber
 748         WHERE   basketno=?
 749             AND (datecancellationprinted IS NULL OR datecancellationprinted='0000-00-00')
 750     ";
 751
 752     $orderby = "biblioitems.publishercode,biblio.title" unless $orderby;
 753     $query .= " ORDER BY $orderby";
 754     my $sth = $dbh->prepare($query);
 755     $sth->execute($basketno);
 756     my $results = $sth->fetchall_arrayref({});
 757     $sth->finish;
 758     return @$results;
 759 }
 760
 761 #------------------------------------------------------------#
 762
 763 =head3 GetOrderNumber
 764
 765 =over 4
 766
 767 $ordernumber = &GetOrderNumber($biblioitemnumber, $biblionumber);
 768
 769 =back
 770
 771 Looks up the ordernumber with the given biblionumber and biblioitemnumber.
 772
 773 Returns the number of this order.
 774
 775 =over 4
 776
 777 =item C<$ordernumber> is the order number.
 778
 779 =back
 780
 781 =cut
 782 sub GetOrderNumber {
 783     my ( $biblionumber,$biblioitemnumber ) = @_;
 784     my $dbh = C4::Context->dbh;
 785     my $query = "
 786         SELECT ordernumber
 787         FROM   aqorders
 788         WHERE  biblionumber=?
 789         AND    biblioitemnumber=?
 790     ";
 791     my $sth = $dbh->prepare($query);
 792     $sth->execute( $biblionumber, $biblioitemnumber );
 793
 794     return $sth->fetchrow;
 795 }
 796
 797 #------------------------------------------------------------#
 798
 799 =head3 GetOrder
 800
 801 =over 4
 802
 803 $order = &GetOrder($ordernumber);
 804
 805 Looks up an order by order number.
 806
 807 Returns a reference-to-hash describing the order. The keys of
 808 C<$order> are fields from the biblio, biblioitems, aqorders tables of the Koha database.
 809
 810 =back
 811
 812 =cut
 813
 814 sub GetOrder {
 815     my ($ordnum) = @_;
 816     my $dbh      = C4::Context->dbh;
 817     my $query = "
 818         SELECT biblioitems.*, biblio.*, aqorders.*
 819         FROM   aqorders
 820         LEFT JOIN biblio on           biblio.biblionumber=aqorders.biblionumber
 821         LEFT JOIN biblioitems on       biblioitems.biblionumber=aqorders.biblionumber
 822         WHERE aqorders.ordernumber=?
 823
 824     ";
 825     my $sth= $dbh->prepare($query);
 826     $sth->execute($ordnum);
 827     my $data = $sth->fetchrow_hashref;
 828     $sth->finish;
 829     return $data;
 830 }
 831
 832 #------------------------------------------------------------#
 833
 834 =head3 NewOrder
 835
 836 =over 4
 837
 838 &NewOrder(\%hashref);
 839
 840 Adds a new order to the database. Any argument that isn't described
 841 below is the new value of the field with the same name in the aqorders
 842 table of the Koha database.
 843
 844 =over 4
 845
 846 =item $hashref->{'basketno'} is the basketno foreign key in aqorders, it is mandatory
 847
 848
 849 =item $hashref->{'ordnum'} is a "minimum order number."
 850
 851 =item $hashref->{'budgetdate'} is effectively ignored.
 852   If it's undef (anything false) or the string 'now', the current day is used.
 853   Else, the upcoming July 1st is used.
 854
 855 =item $hashref->{'subscription'} may be either "yes", or anything else for "no".
 856
 857 =item $hashref->{'uncertainprice'} may be 0 for "the price is known" or 1 for "the price is uncertain"
 858
 859 The following keys are used: "biblionumber", "title", "basketno", "quantity", "notes", "biblioitemnumber", "rrp", "ecost", "gst", "unitprice", "subscription", "sort1", "sort2", "booksellerinvoicenumber", "listprice", "budgetdate", "purchaseordernumber", "branchcode", "booksellerinvoicenumber", "bookfundid".
 860
 861 =back
 862
 863 =back
 864
 865 =cut
 866
 867 sub NewOrder {
 868     my $orderinfo = shift;
 869 #### ------------------------------
 870     my $dbh = C4::Context->dbh;
 871     my @params;
 872
 873
 874     # if these parameters are missing, we can't continue
 875     for my $key (qw/basketno quantity biblionumber budget_id/) {
 876         die "Mandatory parameter $key missing" unless $orderinfo->{$key};
 877     }
 878
 879     if ( $orderinfo->{'subscription'} eq 'yes' ) {
 880         $orderinfo->{'subscription'} = 1;
 881     } else {
 882         $orderinfo->{'subscription'} = 0;
 883     }
 884
 885     my $query = "INSERT INTO aqorders (";
 886     foreach my $orderinfokey (keys %{$orderinfo}) {
 887         next if $orderinfokey =~ m/branchcode|entrydate/;   # skip branchcode and entrydate, branchcode isnt a vaild col, entrydate we add manually with NOW()
 888         $query .= "$orderinfokey,";
 889         push(@params, $orderinfo->{$orderinfokey});
 890     }
 891
 892     $query .= "entrydate) VALUES (";
 893     foreach (@params) {
 894         $query .= "?,";
 895     }
 896     $query .= " NOW() )";  #ADDING CURRENT DATE TO  'budgetdate, entrydate, purchaseordernumber'...
 897
 898     my $sth = $dbh->prepare($query);
 899
 900     $sth->execute(@params);
 901     $sth->finish;
 902
 903     #get ordnum MYSQL dependant, but $dbh->last_insert_id returns null
 904     my $ordnum = $dbh->{'mysql_insertid'};
 905
 906     $sth->finish;
 907     return ( $orderinfo->{'basketno'}, $ordnum );
 908 }
 909
 910
 911
 912 #------------------------------------------------------------#
 913
 914 =head3 NewOrderItem
 915
 916 =over 4
 917
 918 &NewOrderItem();
 919
 920
 921 =back
 922
 923 =cut
 924
 925 sub NewOrderItem {
 926     #my ($biblioitemnumber,$ordnum, $biblionumber) = @_;
 927     my ($itemnumber, $ordernumber)  = @_;
 928     my $dbh = C4::Context->dbh;
 929     my $query = qq|
 930             INSERT INTO aqorders_items
 931                 (itemnumber, ordernumber)
 932             VALUES (?,?)    |;
 933
 934     my $sth = $dbh->prepare($query);
 935     $sth->execute( $itemnumber, $ordernumber);
 936 }
 937
 938 #------------------------------------------------------------#
 939
 940 =head3 ModOrder
 941
 942 =over 4
 943
 944 &ModOrder(\%hashref);
 945
 946 =over 2
 947
 948 Modifies an existing order. Updates the order with order number
 949 $hashref->{'ordernumber'} and biblionumber $hashref->{'biblionumber'}. All other keys of the hash
 950 update the fields with the same name in the aqorders table of the Koha database.
 951
 952 =back
 953
 954 =back
 955
 956 =cut
 957
 958 sub ModOrder {
 959     my $orderinfo = shift;
 960
 961     die "Ordernumber is required"     if $orderinfo->{'ordernumber'} eq  '' ;
 962     die "Biblionumber is required"  if  $orderinfo->{'biblionumber'} eq '';
 963
 964     my $dbh = C4::Context->dbh;
 965     my @params;
 966 #    delete($orderinfo->{'branchcode'});
 967     # the hash contains a lot of entries not in aqorders, so get the columns ...
 968     my $sth = $dbh->prepare("SELECT * FROM aqorders LIMIT 1;");
 969     $sth->execute;
 970     my $colnames = $sth->{NAME};
 971     my $query = "UPDATE aqorders SET ";
 972
 973     foreach my $orderinfokey (grep(!/ordernumber/, keys %$orderinfo)){
 974         # ... and skip hash entries that are not in the aqorders table
 975         # FIXME : probably not the best way to do it (would be better to have a correct hash)
 976         next unless grep(/^$orderinfokey$/, @$colnames);
 977             $query .= "$orderinfokey=?, ";
 978             push(@params, $orderinfo->{$orderinfokey});
 979     }
 980
 981     $query .= "timestamp=NOW()  WHERE  ordernumber=?";
 982 #   push(@params, $specorderinfo{'ordernumber'});
 983     push(@params, $orderinfo->{'ordernumber'} );
 984     $sth = $dbh->prepare($query);
 985     $sth->execute(@params);
 986     $sth->finish;
 987 }
 988
 989 #------------------------------------------------------------#
 990
 991 =head3 ModOrderItem
 992
 993 =over 4
 994
 995 &ModOrderItem(\%hashref);
 996
 997 =over 2
 998
 999 Modifies the itemnumber in the aqorders_items table. The input hash needs three entities:
1000   - itemnumber: the old itemnumber
1001   - ordernumber: the order this item is attached to
1002   - newitemnumber: the new itemnumber we want to attach the line to
1003
1004 =back
1005
1006 =back
1007
1008 =cut
1009
1010 sub ModOrderItem {
1011     my $orderiteminfo = shift;
1012     if (! $orderiteminfo->{'ordernumber'} || ! $orderiteminfo->{'itemnumber'} || ! $orderiteminfo->{'newitemnumber'}){
1013         die "Ordernumber, itemnumber and newitemnumber is required";
1014     }
1015
1016     my $dbh = C4::Context->dbh;
1017
1018     my $query = "UPDATE aqorders_items set itemnumber=? where itemnumber=? and ordernumber=?";
1019     my @params = ($orderiteminfo->{'newitemnumber'}, $orderiteminfo->{'itemnumber'}, $orderiteminfo->{'ordernumber'});
1020     warn $query;
1021     warn Data::Dumper::Dumper(@params);
1022     my $sth = $dbh->prepare($query);
1023     $sth->execute(@params);
1024     return 0;
1025 }
1026
1027 #------------------------------------------------------------#
1028
1029
1030 =head3 ModOrderBibliotemNumber
1031
1032 =over 4
1033
1034 &ModOrderBiblioitemNumber($biblioitemnumber,$ordnum, $biblionumber);
1035
1036 Modifies the biblioitemnumber for an existing order.
1037 Updates the order with order number C<$ordernum> and biblionumber C<$biblionumber>.
1038
1039 =back
1040
1041 =cut
1042
1043 #FIXME: is this used at all?
1044 sub ModOrderBiblioitemNumber {
1045     my ($biblioitemnumber,$ordnum, $biblionumber) = @_;
1046     my $dbh = C4::Context->dbh;
1047     my $query = "
1048       UPDATE aqorders
1049       SET    biblioitemnumber = ?
1050       WHERE  ordernumber = ?
1051       AND biblionumber =  ?";
1052     my $sth = $dbh->prepare($query);
1053     $sth->execute( $biblioitemnumber, $ordnum, $biblionumber );
1054 }
1055
1056 #------------------------------------------------------------#
1057
1058 =head3 ModReceiveOrder
1059
1060 =over 4
1061
1062 &ModReceiveOrder($biblionumber, $ordernumber, $quantityreceived, $user,
1063     $unitprice, $booksellerinvoicenumber, $biblioitemnumber,
1064     $freight, $bookfund, $rrp);
1065
1066 Updates an order, to reflect the fact that it was received, at least
1067 in part. All arguments not mentioned below update the fields with the
1068 same name in the aqorders table of the Koha database.
1069
1070 If a partial order is received, splits the order into two.  The received
1071 portion must have a booksellerinvoicenumber.
1072
1073 Updates the order with bibilionumber C<$biblionumber> and ordernumber
1074 C<$ordernumber>.
1075
1076 =back
1077
1078 =cut
1079
1080
1081 sub ModReceiveOrder {
1082     my (
1083         $biblionumber,    $ordnum,  $quantrec, $user, $cost,
1084         $invoiceno, $freight, $rrp, $budget_id, $datereceived
1085       )
1086       = @_;
1087     my $dbh = C4::Context->dbh;
1088 #     warn "DATE BEFORE : $daterecieved";
1089 #    $daterecieved=POSIX::strftime("%Y-%m-%d",CORE::localtime) unless $daterecieved;
1090 #     warn "DATE REC : $daterecieved";
1091         $datereceived = C4::Dates->output('iso') unless $datereceived;
1092     my $suggestionid = GetSuggestionFromBiblionumber( $dbh, $biblionumber );
1093     if ($suggestionid) {
1094         ModStatus( $suggestionid, 'AVAILABLE', '', $biblionumber );
1095     }
1096
1097         my $sth=$dbh->prepare("
1098         SELECT * FROM   aqorders
1099             WHERE           biblionumber=? AND aqorders.ordernumber=?");
1100
1101     $sth->execute($biblionumber,$ordnum);
1102     my $order = $sth->fetchrow_hashref();
1103     $sth->finish();
1104
1105         if ( $order->{quantity} > $quantrec ) {
1106         $sth=$dbh->prepare("
1107             UPDATE aqorders
1108             SET quantityreceived=?
1109                 , datereceived=?
1110                 , booksellerinvoicenumber=?
1111                 , unitprice=?
1112                 , freight=?
1113                 , rrp=?
1114                 , quantityreceived=?
1115             WHERE biblionumber=? AND ordernumber=?");
1116
1117         $sth->execute($quantrec,$datereceived,$invoiceno,$cost,$freight,$rrp,$quantrec,$biblionumber,$ordnum);
1118         $sth->finish;
1119
1120         # create a new order for the remaining items, and set its bookfund.
1121         foreach my $orderkey ( "linenumber", "allocation" ) {
1122             delete($order->{'$orderkey'});
1123         }
1124         my $newOrder = NewOrder($order);
1125   } else {
1126         $sth=$dbh->prepare("update aqorders
1127                                                         set quantityreceived=?,datereceived=?,booksellerinvoicenumber=?,
1128                                                                 unitprice=?,freight=?,rrp=?
1129                             where biblionumber=? and ordernumber=?");
1130         $sth->execute($quantrec,$datereceived,$invoiceno,$cost,$freight,$rrp,$biblionumber,$ordnum);
1131         $sth->finish;
1132     }
1133     return $datereceived;
1134 }
1135 #------------------------------------------------------------#
1136
1137 =head3 SearchOrder
1138
1139 @results = &SearchOrder($search, $biblionumber, $complete);
1140
1141 Searches for orders.
1142
1143 C<$search> may take one of several forms: if it is an ISBN,
1144 C<&ordersearch> returns orders with that ISBN. If C<$search> is an
1145 order number, C<&ordersearch> returns orders with that order number
1146 and biblionumber C<$biblionumber>. Otherwise, C<$search> is considered
1147 to be a space-separated list of search terms; in this case, all of the
1148 terms must appear in the title (matching the beginning of title
1149 words).
1150
1151 If C<$complete> is C<yes>, the results will include only completed
1152 orders. In any case, C<&ordersearch> ignores cancelled orders.
1153
1154 C<&ordersearch> returns an array.
1155 C<@results> is an array of references-to-hash with the following keys:
1156
1157 =over 4
1158
1159 =item C<author>
1160
1161 =item C<seriestitle>
1162
1163 =item C<branchcode>
1164
1165 =item C<bookfundid>
1166
1167 =back
1168
1169 =cut
1170
1171 sub SearchOrder {
1172 #### -------- SearchOrder-------------------------------
1173     my ($ordernumber, $search) = @_;
1174
1175     if ($ordernumber) {
1176         my $dbh = C4::Context->dbh;
1177         my $query =
1178             "SELECT *
1179             FROM aqorders
1180             LEFT JOIN biblio ON aqorders.biblionumber=biblio.biblionumber
1181             LEFT JOIN biblioitems ON biblioitems.biblionumber=biblio.biblionumber
1182             LEFT JOIN aqbasket ON aqorders.basketno = aqbasket.basketno
1183                 WHERE  ((datecancellationprinted is NULL)
1184                 AND (aqorders.ordernumber=?))";
1185         my $sth = $dbh->prepare($query);
1186         $sth->execute($ordernumber);
1187         my $results = $sth->fetchall_arrayref({});
1188         $sth->finish;
1189         return $results;
1190     } else {
1191         my $dbh = C4::Context->dbh;
1192         my $query =
1193             "SELECT *
1194             FROM aqorders
1195             LEFT JOIN biblio ON aqorders.biblionumber=biblio.biblionumber
1196             LEFT JOIN biblioitems ON biblioitems.biblionumber=biblio.biblionumber
1197             LEFT JOIN aqbasket ON aqorders.basketno = aqbasket.basketno
1198                 WHERE  ((datecancellationprinted is NULL)
1199                 AND (biblio.title like ? OR biblioitems.isbn like ?))";
1200         my $sth = $dbh->prepare($query);
1201         $sth->execute("%$search%","%$search%");
1202         my $results = $sth->fetchall_arrayref({});
1203         $sth->finish;
1204         return $results;
1205     }
1206 }
1207
1208 #------------------------------------------------------------#
1209
1210 =head3 DelOrder
1211
1212 =over 4
1213
1214 &DelOrder($biblionumber, $ordernumber);
1215
1216 Cancel the order with the given order and biblio numbers. It does not
1217 delete any entries in the aqorders table, it merely marks them as
1218 cancelled.
1219
1220 =back
1221
1222 =cut
1223
1224 sub DelOrder {
1225     my ( $bibnum, $ordnum ) = @_;
1226     my $dbh = C4::Context->dbh;
1227     my $query = "
1228         UPDATE aqorders
1229         SET    datecancellationprinted=now()
1230         WHERE  biblionumber=? AND ordernumber=?
1231     ";
1232     my $sth = $dbh->prepare($query);
1233     $sth->execute( $bibnum, $ordnum );
1234     $sth->finish;
1235 }
1236
1237 =head2 FUNCTIONS ABOUT PARCELS
1238
1239 =cut
1240
1241 #------------------------------------------------------------#
1242
1243 =head3 GetParcel
1244
1245 =over 4
1246
1247 @results = &GetParcel($booksellerid, $code, $date);
1248
1249 Looks up all of the received items from the supplier with the given
1250 bookseller ID at the given date, for the given code (bookseller Invoice number). Ignores cancelled and completed orders.
1251
1252 C<@results> is an array of references-to-hash. The keys of each element are fields from
1253 the aqorders, biblio, and biblioitems tables of the Koha database.
1254
1255 C<@results> is sorted alphabetically by book title.
1256
1257 =back
1258
1259 =cut
1260
1261 sub GetParcel {
1262     #gets all orders from a certain supplier, orders them alphabetically
1263     my ( $supplierid, $code, $datereceived ) = @_;
1264     my $dbh     = C4::Context->dbh;
1265     my @results = ();
1266     $code .= '%'
1267       if $code;  # add % if we search on a given code (otherwise, let him empty)
1268     my $strsth ="
1269         SELECT  authorisedby,
1270                 creationdate,
1271                 aqbasket.basketno,
1272                 closedate,surname,
1273                 firstname,
1274                 aqorders.biblionumber,
1275                 aqorders.ordernumber,
1276                 aqorders.quantity,
1277                 aqorders.quantityreceived,
1278                 aqorders.unitprice,
1279                 aqorders.listprice,
1280                 aqorders.rrp,
1281                 aqorders.ecost,
1282                 biblio.title
1283         FROM aqorders
1284         LEFT JOIN aqbasket ON aqbasket.basketno=aqorders.basketno
1285         LEFT JOIN borrowers ON aqbasket.authorisedby=borrowers.borrowernumber
1286         LEFT JOIN biblio ON aqorders.biblionumber=biblio.biblionumber
1287         WHERE
1288             aqbasket.booksellerid = ?
1289             AND aqorders.booksellerinvoicenumber LIKE ?
1290             AND aqorders.datereceived = ? ";
1291
1292     my @query_params = ( $supplierid, $code, $datereceived );
1293     if ( C4::Context->preference("IndependantBranches") ) {
1294         my $userenv = C4::Context->userenv;
1295         if ( ($userenv) && ( $userenv->{flags} != 1 ) ) {
1296             $strsth .= " and (borrowers.branchcode = ?
1297                           or borrowers.branchcode  = '')";
1298             push @query_params, $userenv->{branch};
1299         }
1300     }
1301     $strsth .= " ORDER BY aqbasket.basketno";
1302     # ## parcelinformation : $strsth
1303     my $sth = $dbh->prepare($strsth);
1304     $sth->execute( @query_params );
1305     while ( my $data = $sth->fetchrow_hashref ) {
1306         push( @results, $data );
1307     }
1308     # ## countparcelbiblio: scalar(@results)
1309     $sth->finish;
1310
1311     return @results;
1312 }
1313
1314 #------------------------------------------------------------#
1315
1316 =head3 GetParcels
1317
1318 =over 4
1319
1320 $results = &GetParcels($bookseller, $order, $code, $datefrom, $dateto);
1321 get a lists of parcels.
1322
1323 =back
1324
1325 * Input arg :
1326
1327 =over 4
1328
1329 =item $bookseller
1330 is the bookseller this function has to get parcels.
1331
1332 =item $order
1333 To know on what criteria the results list has to be ordered.
1334
1335 =item $code
1336 is the booksellerinvoicenumber.
1337
1338 =item $datefrom & $dateto
1339 to know on what date this function has to filter its search.
1340
1341 * return:
1342 a pointer on a hash list containing parcel informations as such :
1343
1344 =item Creation date
1345
1346 =item Last operation
1347
1348 =item Number of biblio
1349
1350 =item Number of items
1351
1352 =back
1353
1354 =cut
1355
1356 sub GetParcels {
1357     my ($bookseller,$order, $code, $datefrom, $dateto) = @_;
1358     my $dbh    = C4::Context->dbh;
1359     my @query_params = ();
1360     my $strsth ="
1361         SELECT  aqorders.booksellerinvoicenumber,
1362                 datereceived,purchaseordernumber,
1363                 count(DISTINCT biblionumber) AS biblio,
1364                 sum(quantity) AS itemsexpected,
1365                 sum(quantityreceived) AS itemsreceived
1366         FROM   aqorders LEFT JOIN aqbasket ON aqbasket.basketno = aqorders.basketno
1367         WHERE aqbasket.booksellerid = $bookseller and datereceived IS NOT NULL
1368     ";
1369
1370     if ( defined $code ) {
1371         $strsth .= ' and aqorders.booksellerinvoicenumber like ? ';
1372         # add a % to the end of the code to allow stemming.
1373         push @query_params, "$code%";
1374     }
1375
1376     if ( defined $datefrom ) {
1377         $strsth .= ' and datereceived >= ? ';
1378         push @query_params, $datefrom;
1379     }
1380
1381     if ( defined $dateto ) {
1382         $strsth .=  'and datereceived <= ? ';
1383         push @query_params, $dateto;
1384     }
1385
1386     $strsth .= "group by aqorders.booksellerinvoicenumber,datereceived ";
1387
1388     # can't use a placeholder to place this column name.
1389     # but, we could probably be checking to make sure it is a column that will be fetched.
1390     $strsth .= "order by $order " if ($order);
1391
1392     my $sth = $dbh->prepare($strsth);
1393
1394     $sth->execute( @query_params );
1395     my $results = $sth->fetchall_arrayref({});
1396     $sth->finish;
1397     return @$results;
1398 }
1399
1400 #------------------------------------------------------------#
1401
1402 =head3 GetLateOrders
1403
1404 =over 4
1405
1406 @results = &GetLateOrders;
1407
1408 Searches for bookseller with late orders.
1409
1410 return:
1411 the table of supplier with late issues. This table is full of hashref.
1412
1413 =back
1414
1415 =cut
1416
1417 sub GetLateOrders {
1418     my $delay      = shift;
1419     my $supplierid = shift;
1420     my $branch     = shift;
1421
1422     my $dbh = C4::Context->dbh;
1423
1424     #BEWARE, order of parenthesis and LEFT JOIN is important for speed
1425     my $dbdriver = C4::Context->config("db_scheme") || "mysql";
1426
1427     my @query_params = ($delay);        # delay is the first argument regardless
1428         my $select = "
1429       SELECT aqbasket.basketno,
1430           aqorders.ordernumber,
1431           DATE(aqbasket.closedate)  AS orderdate,
1432           aqorders.rrp              AS unitpricesupplier,
1433           aqorders.ecost            AS unitpricelib,
1434           aqbudgets.budget_name     AS budget,
1435           borrowers.branchcode      AS branch,
1436           aqbooksellers.name        AS supplier,
1437           biblio.author,
1438           biblioitems.publishercode AS publisher,
1439           biblioitems.publicationyear,
1440         ";
1441         my $from = "
1442       FROM (((
1443           (aqorders LEFT JOIN biblio     ON biblio.biblionumber         = aqorders.biblionumber)
1444           LEFT JOIN biblioitems          ON biblioitems.biblionumber    = biblio.biblionumber)
1445           LEFT JOIN aqbudgets            ON aqorders.budget_id          = aqbudgets.budget_id),
1446           (aqbasket LEFT JOIN borrowers  ON aqbasket.authorisedby       = borrowers.borrowernumber)
1447           LEFT JOIN aqbooksellers        ON aqbasket.booksellerid       = aqbooksellers.id
1448           WHERE aqorders.basketno = aqbasket.basketno
1449           AND ( (datereceived = '' OR datereceived IS NULL)
1450               OR (aqorders.quantityreceived < aqorders.quantity)
1451           )
1452     ";
1453         my $having = "";
1454     if ($dbdriver eq "mysql") {
1455                 $select .= "
1456            aqorders.quantity - IFNULL(aqorders.quantityreceived,0)                 AS quantity,
1457           (aqorders.quantity - IFNULL(aqorders.quantityreceived,0)) * aqorders.rrp AS subtotal,
1458           DATEDIFF(CURDATE( ),closedate) AS latesince
1459                 ";
1460         $from .= " AND (closedate <= DATE_SUB(CURDATE( ),INTERVAL ? DAY)) ";
1461                 $having = "
1462          HAVING quantity          <> 0
1463             AND unitpricesupplier <> 0
1464             AND unitpricelib      <> 0
1465                 ";
1466     } else {
1467                 # FIXME: account for IFNULL as above
1468         $select .= "
1469                 aqorders.quantity                AS quantity,
1470                 aqorders.quantity * aqorders.rrp AS subtotal,
1471                 (CURDATE - closedate)            AS latesince
1472                 ";
1473         $from .= " AND (closedate <= (CURDATE -(INTERVAL ? DAY)) ";
1474     }
1475     if (defined $supplierid) {
1476                 $from .= ' AND aqbasket.booksellerid = ? ';
1477         push @query_params, $supplierid;
1478     }
1479     if (defined $branch) {
1480         $from .= ' AND borrowers.branchcode LIKE ? ';
1481         push @query_params, $branch;
1482     }
1483     if (C4::Context->preference("IndependantBranches")
1484              && C4::Context->userenv
1485              && C4::Context->userenv->{flags} != 1 ) {
1486         $from .= ' AND borrowers.branchcode LIKE ? ';
1487         push @query_params, C4::Context->userenv->{branch};
1488     }
1489         my $query = "$select $from $having\nORDER BY latesince, basketno, borrowers.branchcode, supplier";
1490         $debug and print STDERR "GetLateOrders query: $query\nGetLateOrders args: " . join(" ",@query_params);
1491     my $sth = $dbh->prepare($query);
1492     $sth->execute(@query_params);
1493     my @results;
1494     while (my $data = $sth->fetchrow_hashref) {
1495         $data->{orderdate} = format_date($data->{orderdate});
1496         push @results, $data;
1497     }
1498     return @results;
1499 }
1500
1501 #------------------------------------------------------------#
1502
1503 =head3 GetHistory
1504
1505 =over 4
1506
1507 (\@order_loop, $total_qty, $total_price, $total_qtyreceived) = GetHistory( $title, $author, $name, $from_placed_on, $to_placed_on );
1508
1509   Retreives some acquisition history information
1510
1511   returns:
1512     $order_loop is a list of hashrefs that each look like this:
1513               {
1514                 'author'           => 'Twain, Mark',
1515                 'basketno'         => '1',
1516                 'biblionumber'     => '215',
1517                 'count'            => 1,
1518                 'creationdate'     => 'MM/DD/YYYY',
1519                 'datereceived'     => undef,
1520                 'ecost'            => '1.00',
1521                 'id'               => '1',
1522                 'invoicenumber'    => undef,
1523                 'name'             => '',
1524                 'ordernumber'      => '1',
1525                 'quantity'         => 1,
1526                 'quantityreceived' => undef,
1527                 'title'            => 'The Adventures of Huckleberry Finn'
1528               }
1529     $total_qty is the sum of all of the quantities in $order_loop
1530     $total_price is the cost of each in $order_loop times the quantity
1531     $total_qtyreceived is the sum of all of the quantityreceived entries in $order_loop
1532
1533 =back
1534
1535 =cut
1536
1537 sub GetHistory {
1538     my ( $title, $author, $name, $from_placed_on, $to_placed_on ) = @_;
1539     my @order_loop;
1540     my $total_qty         = 0;
1541     my $total_qtyreceived = 0;
1542     my $total_price       = 0;
1543
1544 # don't run the query if there are no parameters (list would be too long for sure !)
1545     if ( $title || $author || $name || $from_placed_on || $to_placed_on ) {
1546         my $dbh   = C4::Context->dbh;
1547         my $query ="
1548             SELECT
1549                 biblio.title,
1550                 biblio.author,
1551                 aqorders.basketno,
1552                 name,aqbasket.creationdate,
1553                 aqorders.datereceived,
1554                 aqorders.quantity,
1555                 aqorders.quantityreceived,
1556                 aqorders.ecost,
1557                 aqorders.ordernumber,
1558                 aqorders.booksellerinvoicenumber as invoicenumber,
1559                 aqbooksellers.id as id,
1560                 aqorders.biblionumber
1561             FROM aqorders
1562             LEFT JOIN aqbasket ON aqorders.basketno=aqbasket.basketno
1563             LEFT JOIN aqbooksellers ON aqbasket.booksellerid=aqbooksellers.id
1564             LEFT JOIN biblio ON biblio.biblionumber=aqorders.biblionumber";
1565
1566         $query .= " LEFT JOIN borrowers ON aqbasket.authorisedby=borrowers.borrowernumber"
1567           if ( C4::Context->preference("IndependantBranches") );
1568
1569         $query .= " WHERE (datecancellationprinted is NULL or datecancellationprinted='0000-00-00') ";
1570
1571         my @query_params  = ();
1572
1573         if ( defined $title ) {
1574             $query .= " AND biblio.title LIKE ? ";
1575             push @query_params, "%$title%";
1576         }
1577
1578         if ( defined $author ) {
1579             $query .= " AND biblio.author LIKE ? ";
1580             push @query_params, "%$author%";
1581         }
1582
1583         if ( defined $name ) {
1584             $query .= " AND name LIKE ? ";
1585             push @query_params, "%$name%";
1586         }
1587
1588         if ( defined $from_placed_on ) {
1589             $query .= " AND creationdate >= ? ";
1590             push @query_params, $from_placed_on;
1591         }
1592
1593         if ( defined $to_placed_on ) {
1594             $query .= " AND creationdate <= ? ";
1595             push @query_params, $to_placed_on;
1596         }
1597
1598         if ( C4::Context->preference("IndependantBranches") ) {
1599             my $userenv = C4::Context->userenv;
1600             if ( ($userenv) && ( $userenv->{flags} != 1 ) ) {
1601                 $query .= " AND (borrowers.branchcode = ? OR borrowers.branchcode ='' ) ";
1602                 push @query_params, $userenv->{branch};
1603             }
1604         }
1605         $query .= " ORDER BY booksellerid";
1606         my $sth = $dbh->prepare($query);
1607         $sth->execute( @query_params );
1608         my $cnt = 1;
1609         while ( my $line = $sth->fetchrow_hashref ) {
1610             $line->{count} = $cnt++;
1611             $line->{toggle} = 1 if $cnt % 2;
1612             push @order_loop, $line;
1613             $line->{creationdate} = format_date( $line->{creationdate} );
1614             $line->{datereceived} = format_date( $line->{datereceived} );
1615             $total_qty         += $line->{'quantity'};
1616             $total_qtyreceived += $line->{'quantityreceived'};
1617             $total_price       += $line->{'quantity'} * $line->{'ecost'};
1618         }
1619     }
1620     return \@order_loop, $total_qty, $total_price, $total_qtyreceived;
1621 }
1622
1623 =head2 GetRecentAcqui
1624
1625    $results = GetRecentAcqui($days);
1626
1627    C<$results> is a ref to a table which containts hashref
1628
1629 =cut
1630
1631 sub GetRecentAcqui {
1632     my $limit  = shift;
1633     my $dbh    = C4::Context->dbh;
1634     my $query = "
1635         SELECT *
1636         FROM   biblio
1637         ORDER BY timestamp DESC
1638         LIMIT  0,".$limit;
1639
1640     my $sth = $dbh->prepare($query);
1641     $sth->execute;
1642     my $results = $sth->fetchall_arrayref({});
1643     return $results;
1644 }
1645
1646 =head3 GetContracts
1647
1648 =over 4
1649
1650 $contractlist = &GetContracts($booksellerid, $activeonly);
1651
1652 Looks up the contracts that belong to a bookseller
1653
1654 Returns a list of contracts
1655
1656 =item C<$booksellerid> is the "id" field in the "aqbooksellers" table.
1657
1658 =item C<$activeonly> if exists get only contracts that are still active.
1659
1660 =back
1661
1662 =cut
1663 sub GetContracts {
1664     my ( $booksellerid, $activeonly ) = @_;
1665     my $dbh = C4::Context->dbh;
1666     my $query;
1667     if (! $activeonly) {
1668         $query = "
1669             SELECT *
1670             FROM   aqcontract
1671             WHERE  booksellerid=?
1672         ";
1673     } else {
1674         $query = "SELECT *
1675             FROM aqcontract
1676             WHERE booksellerid=?
1677                 AND contractenddate >= CURDATE( )";
1678     }
1679     my $sth = $dbh->prepare($query);
1680     $sth->execute( $booksellerid );
1681     my @results;
1682     while (my $data = $sth->fetchrow_hashref ) {
1683         push(@results, $data);
1684     }
1685     $sth->finish;
1686     return @results;
1687 }
1688
1689 #------------------------------------------------------------#
1690
1691 =head3 GetContract
1692
1693 =over 4
1694
1695 $contract = &GetContract($contractID);
1696
1697 Looks up the contract that has PRIMKEY (contractnumber) value $contractID
1698
1699 Returns a contract
1700
1701 =back
1702
1703 =cut
1704 sub GetContract {
1705     my ( $contractno ) = @_;
1706     my $dbh = C4::Context->dbh;
1707     my $query = "
1708         SELECT *
1709         FROM   aqcontract
1710         WHERE  contractnumber=?
1711         ";
1712
1713     my $sth = $dbh->prepare($query);
1714     $sth->execute( $contractno );
1715     my $result = $sth->fetchrow_hashref;
1716     return $result;
1717 }
1718
1719 1;
1720 __END__
1721
1722 =head1 AUTHOR
1723
1724 Koha Developement team <info@koha.org>
1725
1726 =cut