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