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