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         ModSuggestion( {suggestionid=>$suggestionid,
1145                                                 STATUS=>'AVAILABLE',
1146                                                 biblionumber=> $biblionumber}
1147                                                 );
1148     }
1149
1150     my $sth=$dbh->prepare("
1151         SELECT * FROM   aqorders
1152         WHERE           biblionumber=? AND aqorders.ordernumber=?");
1153
1154     $sth->execute($biblionumber,$ordernumber);
1155     my $order = $sth->fetchrow_hashref();
1156     $sth->finish();
1157
1158     if ( $order->{quantity} > $quantrec ) {
1159         $sth=$dbh->prepare("
1160             UPDATE aqorders
1161             SET quantityreceived=?
1162                 , datereceived=?
1163                 , booksellerinvoicenumber=?
1164                 , unitprice=?
1165                 , freight=?
1166                 , rrp=?
1167                 , quantityreceived=?
1168             WHERE biblionumber=? AND ordernumber=?");
1169
1170         $sth->execute($quantrec,$datereceived,$invoiceno,$cost,$freight,$rrp,$quantrec,$biblionumber,$ordernumber);
1171         $sth->finish;
1172
1173         # create a new order for the remaining items, and set its bookfund.
1174         foreach my $orderkey ( "linenumber", "allocation" ) {
1175             delete($order->{'$orderkey'});
1176         }
1177         my $newOrder = NewOrder($order);
1178 } else {
1179         $sth=$dbh->prepare("update aqorders
1180                             set quantityreceived=?,datereceived=?,booksellerinvoicenumber=?,
1181                                 unitprice=?,freight=?,rrp=?
1182                             where biblionumber=? and ordernumber=?");
1183         $sth->execute($quantrec,$datereceived,$invoiceno,$cost,$freight,$rrp,$biblionumber,$ordernumber);
1184         $sth->finish;
1185     }
1186     return $datereceived;
1187 }
1188 #------------------------------------------------------------#
1189
1190 =head3 SearchOrder
1191
1192 @results = &SearchOrder($search, $biblionumber, $complete);
1193
1194 Searches for orders.
1195
1196 C<$search> may take one of several forms: if it is an ISBN,
1197 C<&ordersearch> returns orders with that ISBN. If C<$search> is an
1198 order number, C<&ordersearch> returns orders with that order number
1199 and biblionumber C<$biblionumber>. Otherwise, C<$search> is considered
1200 to be a space-separated list of search terms; in this case, all of the
1201 terms must appear in the title (matching the beginning of title
1202 words).
1203
1204 If C<$complete> is C<yes>, the results will include only completed
1205 orders. In any case, C<&ordersearch> ignores cancelled orders.
1206
1207 C<&ordersearch> returns an array.
1208 C<@results> is an array of references-to-hash with the following keys:
1209
1210 =over 4
1211
1212 =item C<author>
1213
1214 =item C<seriestitle>
1215
1216 =item C<branchcode>
1217
1218 =item C<bookfundid>
1219
1220 =back
1221
1222 =cut
1223
1224 sub SearchOrder {
1225 #### -------- SearchOrder-------------------------------
1226     my ($ordernumber, $search, $supplierid, $basket) = @_;
1227
1228     my $dbh = C4::Context->dbh;
1229     my @args = ();
1230     my $query =
1231             "SELECT *
1232             FROM aqorders
1233             LEFT JOIN biblio ON aqorders.biblionumber=biblio.biblionumber
1234             LEFT JOIN biblioitems ON biblioitems.biblionumber=biblio.biblionumber
1235             LEFT JOIN aqbasket ON aqorders.basketno = aqbasket.basketno
1236                 WHERE  (datecancellationprinted is NULL)";
1237
1238     if($ordernumber){
1239         $query .= " AND (aqorders.ordernumber=?)";
1240         push @args, $ordernumber;
1241     }
1242     if($search){
1243         $query .= " AND (biblio.title like ? OR biblio.author LIKE ? OR biblioitems.isbn like ?)";
1244         push @args, ("%$search%","%$search%","%$search%");
1245     }
1246     if($supplierid){
1247         $query .= "AND aqbasket.booksellerid = ?";
1248         push @args, $supplierid;
1249     }
1250     if($basket){
1251         $query .= "AND aqorders.basketno = ?";
1252         push @args, $basket;
1253     }
1254
1255     my $sth = $dbh->prepare($query);
1256     $sth->execute(@args);
1257     my $results = $sth->fetchall_arrayref({});
1258     $sth->finish;
1259     return $results;
1260 }
1261
1262 #------------------------------------------------------------#
1263
1264 =head3 DelOrder
1265
1266 =over 4
1267
1268 &DelOrder($biblionumber, $ordernumber);
1269
1270 Cancel the order with the given order and biblio numbers. It does not
1271 delete any entries in the aqorders table, it merely marks them as
1272 cancelled.
1273
1274 =back
1275
1276 =cut
1277
1278 sub DelOrder {
1279     my ( $bibnum, $ordernumber ) = @_;
1280     my $dbh = C4::Context->dbh;
1281     my $query = "
1282         UPDATE aqorders
1283         SET    datecancellationprinted=now()
1284         WHERE  biblionumber=? AND ordernumber=?
1285     ";
1286     my $sth = $dbh->prepare($query);
1287     $sth->execute( $bibnum, $ordernumber );
1288     $sth->finish;
1289 }
1290
1291 =head2 FUNCTIONS ABOUT PARCELS
1292
1293 =cut
1294
1295 #------------------------------------------------------------#
1296
1297 =head3 GetParcel
1298
1299 =over 4
1300
1301 @results = &GetParcel($booksellerid, $code, $date);
1302
1303 Looks up all of the received items from the supplier with the given
1304 bookseller ID at the given date, for the given code (bookseller Invoice number). Ignores cancelled and completed orders.
1305
1306 C<@results> is an array of references-to-hash. The keys of each element are fields from
1307 the aqorders, biblio, and biblioitems tables of the Koha database.
1308
1309 C<@results> is sorted alphabetically by book title.
1310
1311 =back
1312
1313 =cut
1314
1315 sub GetParcel {
1316     #gets all orders from a certain supplier, orders them alphabetically
1317     my ( $supplierid, $code, $datereceived ) = @_;
1318     my $dbh     = C4::Context->dbh;
1319     my @results = ();
1320     $code .= '%'
1321     if $code;  # add % if we search on a given code (otherwise, let him empty)
1322     my $strsth ="
1323         SELECT  authorisedby,
1324                 creationdate,
1325                 aqbasket.basketno,
1326                 closedate,surname,
1327                 firstname,
1328                 aqorders.biblionumber,
1329                 aqorders.ordernumber,
1330                 aqorders.quantity,
1331                 aqorders.quantityreceived,
1332                 aqorders.unitprice,
1333                 aqorders.listprice,
1334                 aqorders.rrp,
1335                 aqorders.ecost,
1336                 biblio.title
1337         FROM aqorders
1338         LEFT JOIN aqbasket ON aqbasket.basketno=aqorders.basketno
1339         LEFT JOIN borrowers ON aqbasket.authorisedby=borrowers.borrowernumber
1340         LEFT JOIN biblio ON aqorders.biblionumber=biblio.biblionumber
1341         WHERE
1342             aqbasket.booksellerid = ?
1343             AND aqorders.booksellerinvoicenumber LIKE ?
1344             AND aqorders.datereceived = ? ";
1345
1346     my @query_params = ( $supplierid, $code, $datereceived );
1347     if ( C4::Context->preference("IndependantBranches") ) {
1348         my $userenv = C4::Context->userenv;
1349         if ( ($userenv) && ( $userenv->{flags} != 1 ) ) {
1350             $strsth .= " and (borrowers.branchcode = ?
1351                         or borrowers.branchcode  = '')";
1352             push @query_params, $userenv->{branch};
1353         }
1354     }
1355     $strsth .= " ORDER BY aqbasket.basketno";
1356     # ## parcelinformation : $strsth
1357     my $sth = $dbh->prepare($strsth);
1358     $sth->execute( @query_params );
1359     while ( my $data = $sth->fetchrow_hashref ) {
1360         push( @results, $data );
1361     }
1362     # ## countparcelbiblio: scalar(@results)
1363     $sth->finish;
1364
1365     return @results;
1366 }
1367
1368 #------------------------------------------------------------#
1369
1370 =head3 GetParcels
1371
1372 =over 4
1373
1374 $results = &GetParcels($bookseller, $order, $code, $datefrom, $dateto);
1375 get a lists of parcels.
1376
1377 =back
1378
1379 * Input arg :
1380
1381 =over 4
1382
1383 =item $bookseller
1384 is the bookseller this function has to get parcels.
1385
1386 =item $order
1387 To know on what criteria the results list has to be ordered.
1388
1389 =item $code
1390 is the booksellerinvoicenumber.
1391
1392 =item $datefrom & $dateto
1393 to know on what date this function has to filter its search.
1394
1395 * return:
1396 a pointer on a hash list containing parcel informations as such :
1397
1398 =item Creation date
1399
1400 =item Last operation
1401
1402 =item Number of biblio
1403
1404 =item Number of items
1405
1406 =back
1407
1408 =cut
1409
1410 sub GetParcels {
1411     my ($bookseller,$order, $code, $datefrom, $dateto) = @_;
1412     my $dbh    = C4::Context->dbh;
1413     my @query_params = ();
1414     my $strsth ="
1415         SELECT  aqorders.booksellerinvoicenumber,
1416                 datereceived,purchaseordernumber,
1417                 count(DISTINCT biblionumber) AS biblio,
1418                 sum(quantity) AS itemsexpected,
1419                 sum(quantityreceived) AS itemsreceived
1420         FROM   aqorders LEFT JOIN aqbasket ON aqbasket.basketno = aqorders.basketno
1421         WHERE aqbasket.booksellerid = $bookseller and datereceived IS NOT NULL
1422     ";
1423
1424     if ( defined $code ) {
1425         $strsth .= ' and aqorders.booksellerinvoicenumber like ? ';
1426         # add a % to the end of the code to allow stemming.
1427         push @query_params, "$code%";
1428     }
1429
1430     if ( defined $datefrom ) {
1431         $strsth .= ' and datereceived >= ? ';
1432         push @query_params, $datefrom;
1433     }
1434
1435     if ( defined $dateto ) {
1436         $strsth .=  'and datereceived <= ? ';
1437         push @query_params, $dateto;
1438     }
1439
1440     $strsth .= "group by aqorders.booksellerinvoicenumber,datereceived ";
1441
1442     # can't use a placeholder to place this column name.
1443     # but, we could probably be checking to make sure it is a column that will be fetched.
1444     $strsth .= "order by $order " if ($order);
1445
1446     my $sth = $dbh->prepare($strsth);
1447
1448     $sth->execute( @query_params );
1449     my $results = $sth->fetchall_arrayref({});
1450     $sth->finish;
1451     return @$results;
1452 }
1453
1454 #------------------------------------------------------------#
1455
1456 =head3 GetLateOrders
1457
1458 =over 4
1459
1460 @results = &GetLateOrders;
1461
1462 Searches for bookseller with late orders.
1463
1464 return:
1465 the table of supplier with late issues. This table is full of hashref.
1466
1467 =back
1468
1469 =cut
1470
1471 sub GetLateOrders {
1472     my $delay      = shift;
1473     my $supplierid = shift;
1474     my $branch     = shift;
1475
1476     my $dbh = C4::Context->dbh;
1477
1478     #BEWARE, order of parenthesis and LEFT JOIN is important for speed
1479     my $dbdriver = C4::Context->config("db_scheme") || "mysql";
1480
1481     my @query_params = ($delay);        # delay is the first argument regardless
1482     my $select = "
1483     SELECT aqbasket.basketno,
1484         aqorders.ordernumber,
1485         DATE(aqbasket.closedate)  AS orderdate,
1486         aqorders.rrp              AS unitpricesupplier,
1487         aqorders.ecost            AS unitpricelib,
1488         aqbudgets.budget_name     AS budget,
1489         borrowers.branchcode      AS branch,
1490         aqbooksellers.name        AS supplier,
1491         biblio.author,
1492         biblioitems.publishercode AS publisher,
1493         biblioitems.publicationyear,
1494     ";
1495     my $from = "
1496     FROM
1497         aqorders LEFT JOIN biblio     ON biblio.biblionumber         = aqorders.biblionumber
1498         LEFT JOIN biblioitems         ON biblioitems.biblionumber    = biblio.biblionumber
1499         LEFT JOIN aqbudgets           ON aqorders.budget_id          = aqbudgets.budget_id,
1500         aqbasket LEFT JOIN borrowers  ON aqbasket.authorisedby       = borrowers.borrowernumber
1501         LEFT JOIN aqbooksellers       ON aqbasket.booksellerid       = aqbooksellers.id
1502         WHERE aqorders.basketno = aqbasket.basketno
1503         AND ( datereceived = ''
1504             OR datereceived IS NULL
1505             OR aqorders.quantityreceived < aqorders.quantity
1506         )
1507     ";
1508     my $having = "";
1509     if ($dbdriver eq "mysql") {
1510         $select .= "
1511         aqorders.quantity - IFNULL(aqorders.quantityreceived,0)                 AS quantity,
1512         (aqorders.quantity - IFNULL(aqorders.quantityreceived,0)) * aqorders.rrp AS subtotal,
1513         DATEDIFF(CURDATE( ),closedate) AS latesince
1514         ";
1515         $from .= " AND (closedate <= DATE_SUB(CURDATE( ),INTERVAL ? DAY)) ";
1516         $having = "
1517         HAVING quantity          <> 0
1518             AND unitpricesupplier <> 0
1519             AND unitpricelib      <> 0
1520         ";
1521     } else {
1522         # FIXME: account for IFNULL as above
1523         $select .= "
1524                 aqorders.quantity                AS quantity,
1525                 aqorders.quantity * aqorders.rrp AS subtotal,
1526                 (CURDATE - closedate)            AS latesince
1527         ";
1528         $from .= " AND (closedate <= (CURDATE -(INTERVAL ? DAY)) ";
1529     }
1530     if (defined $supplierid) {
1531         $from .= ' AND aqbasket.booksellerid = ? ';
1532         push @query_params, $supplierid;
1533     }
1534     if (defined $branch) {
1535         $from .= ' AND borrowers.branchcode LIKE ? ';
1536         push @query_params, $branch;
1537     }
1538     if (C4::Context->preference("IndependantBranches")
1539             && C4::Context->userenv
1540             && C4::Context->userenv->{flags} != 1 ) {
1541         $from .= ' AND borrowers.branchcode LIKE ? ';
1542         push @query_params, C4::Context->userenv->{branch};
1543     }
1544     my $query = "$select $from $having\nORDER BY latesince, basketno, borrowers.branchcode, supplier";
1545     $debug and print STDERR "GetLateOrders query: $query\nGetLateOrders args: " . join(" ",@query_params);
1546     my $sth = $dbh->prepare($query);
1547     $sth->execute(@query_params);
1548     my @results;
1549     while (my $data = $sth->fetchrow_hashref) {
1550         $data->{orderdate} = format_date($data->{orderdate});
1551         push @results, $data;
1552     }
1553     return @results;
1554 }
1555
1556 #------------------------------------------------------------#
1557
1558 =head3 GetHistory
1559
1560 =over 4
1561
1562 (\@order_loop, $total_qty, $total_price, $total_qtyreceived) = GetHistory( $title, $author, $name, $from_placed_on, $to_placed_on );
1563
1564 Retreives some acquisition history information
1565
1566 returns:
1567     $order_loop is a list of hashrefs that each look like this:
1568             {
1569                 'author'           => 'Twain, Mark',
1570                 'basketno'         => '1',
1571                 'biblionumber'     => '215',
1572                 'count'            => 1,
1573                 'creationdate'     => 'MM/DD/YYYY',
1574                 'datereceived'     => undef,
1575                 'ecost'            => '1.00',
1576                 'id'               => '1',
1577                 'invoicenumber'    => undef,
1578                 'name'             => '',
1579                 'ordernumber'      => '1',
1580                 'quantity'         => 1,
1581                 'quantityreceived' => undef,
1582                 'title'            => 'The Adventures of Huckleberry Finn'
1583             }
1584     $total_qty is the sum of all of the quantities in $order_loop
1585     $total_price is the cost of each in $order_loop times the quantity
1586     $total_qtyreceived is the sum of all of the quantityreceived entries in $order_loop
1587
1588 =back
1589
1590 =cut
1591
1592 sub GetHistory {
1593     my ( $title, $author, $name, $from_placed_on, $to_placed_on ) = @_;
1594     my @order_loop;
1595     my $total_qty         = 0;
1596     my $total_qtyreceived = 0;
1597     my $total_price       = 0;
1598
1599 # don't run the query if there are no parameters (list would be too long for sure !)
1600     if ( $title || $author || $name || $from_placed_on || $to_placed_on ) {
1601         my $dbh   = C4::Context->dbh;
1602         my $query ="
1603             SELECT
1604                 biblio.title,
1605                 biblio.author,
1606                 aqorders.basketno,
1607                 name,aqbasket.creationdate,
1608                 aqorders.datereceived,
1609                 aqorders.quantity,
1610                 aqorders.quantityreceived,
1611                 aqorders.ecost,
1612                 aqorders.ordernumber,
1613                 aqorders.booksellerinvoicenumber as invoicenumber,
1614                 aqbooksellers.id as id,
1615                 aqorders.biblionumber
1616             FROM aqorders
1617             LEFT JOIN aqbasket ON aqorders.basketno=aqbasket.basketno
1618             LEFT JOIN aqbooksellers ON aqbasket.booksellerid=aqbooksellers.id
1619             LEFT JOIN biblio ON biblio.biblionumber=aqorders.biblionumber";
1620
1621         $query .= " LEFT JOIN borrowers ON aqbasket.authorisedby=borrowers.borrowernumber"
1622         if ( C4::Context->preference("IndependantBranches") );
1623
1624         $query .= " WHERE (datecancellationprinted is NULL or datecancellationprinted='0000-00-00') ";
1625
1626         my @query_params  = ();
1627
1628         if ( defined $title ) {
1629             $query .= " AND biblio.title LIKE ? ";
1630             push @query_params, "%$title%";
1631         }
1632
1633         if ( defined $author ) {
1634             $query .= " AND biblio.author LIKE ? ";
1635             push @query_params, "%$author%";
1636         }
1637
1638         if ( defined $name ) {
1639             $query .= " AND name LIKE ? ";
1640             push @query_params, "%$name%";
1641         }
1642
1643         if ( defined $from_placed_on ) {
1644             $query .= " AND creationdate >= ? ";
1645             push @query_params, $from_placed_on;
1646         }
1647
1648         if ( defined $to_placed_on ) {
1649             $query .= " AND creationdate <= ? ";
1650             push @query_params, $to_placed_on;
1651         }
1652
1653         if ( C4::Context->preference("IndependantBranches") ) {
1654             my $userenv = C4::Context->userenv;
1655             if ( ($userenv) && ( $userenv->{flags} != 1 ) ) {
1656                 $query .= " AND (borrowers.branchcode = ? OR borrowers.branchcode ='' ) ";
1657                 push @query_params, $userenv->{branch};
1658             }
1659         }
1660         $query .= " ORDER BY booksellerid";
1661         my $sth = $dbh->prepare($query);
1662         $sth->execute( @query_params );
1663         my $cnt = 1;
1664         while ( my $line = $sth->fetchrow_hashref ) {
1665             $line->{count} = $cnt++;
1666             $line->{toggle} = 1 if $cnt % 2;
1667             push @order_loop, $line;
1668             $line->{creationdate} = format_date( $line->{creationdate} );
1669             $line->{datereceived} = format_date( $line->{datereceived} );
1670             $total_qty         += $line->{'quantity'};
1671             $total_qtyreceived += $line->{'quantityreceived'};
1672             $total_price       += $line->{'quantity'} * $line->{'ecost'};
1673         }
1674     }
1675     return \@order_loop, $total_qty, $total_price, $total_qtyreceived;
1676 }
1677
1678 =head2 GetRecentAcqui
1679
1680 $results = GetRecentAcqui($days);
1681
1682 C<$results> is a ref to a table which containts hashref
1683
1684 =cut
1685
1686 sub GetRecentAcqui {
1687     my $limit  = shift;
1688     my $dbh    = C4::Context->dbh;
1689     my $query = "
1690         SELECT *
1691         FROM   biblio
1692         ORDER BY timestamp DESC
1693         LIMIT  0,".$limit;
1694
1695     my $sth = $dbh->prepare($query);
1696     $sth->execute;
1697     my $results = $sth->fetchall_arrayref({});
1698     return $results;
1699 }
1700
1701 =head3 GetContracts
1702
1703 =over 4
1704
1705 $contractlist = &GetContracts($booksellerid, $activeonly);
1706
1707 Looks up the contracts that belong to a bookseller
1708
1709 Returns a list of contracts
1710
1711 =item C<$booksellerid> is the "id" field in the "aqbooksellers" table.
1712
1713 =item C<$activeonly> if exists get only contracts that are still active.
1714
1715 =back
1716
1717 =cut
1718 sub GetContracts {
1719     my ( $booksellerid, $activeonly ) = @_;
1720     my $dbh = C4::Context->dbh;
1721     my $query;
1722     if (! $activeonly) {
1723         $query = "
1724             SELECT *
1725             FROM   aqcontract
1726             WHERE  booksellerid=?
1727         ";
1728     } else {
1729         $query = "SELECT *
1730             FROM aqcontract
1731             WHERE booksellerid=?
1732                 AND contractenddate >= CURDATE( )";
1733     }
1734     my $sth = $dbh->prepare($query);
1735     $sth->execute( $booksellerid );
1736     my @results;
1737     while (my $data = $sth->fetchrow_hashref ) {
1738         push(@results, $data);
1739     }
1740     $sth->finish;
1741     return @results;
1742 }
1743
1744 #------------------------------------------------------------#
1745
1746 =head3 GetContract
1747
1748 =over 4
1749
1750 $contract = &GetContract($contractID);
1751
1752 Looks up the contract that has PRIMKEY (contractnumber) value $contractID
1753
1754 Returns a contract
1755
1756 =back
1757
1758 =cut
1759 sub GetContract {
1760     my ( $contractno ) = @_;
1761     my $dbh = C4::Context->dbh;
1762     my $query = "
1763         SELECT *
1764         FROM   aqcontract
1765         WHERE  contractnumber=?
1766         ";
1767
1768     my $sth = $dbh->prepare($query);
1769     $sth->execute( $contractno );
1770     my $result = $sth->fetchrow_hashref;
1771     return $result;
1772 }
1773
1774 1;
1775 __END__
1776
1777 =head1 AUTHOR
1778
1779 Koha Developement team <info@koha.org>
1780
1781 =cut