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,biblio.*,biblioitems.isbn,
 718                     aqbasket.closedate, aqbasket.creationdate, aqbasket.basketname,
 719                     aqorders.*
 720         FROM      aqorders
 721         LEFT JOIN aqbasket ON aqbasket.basketno=aqorders.basketno
 722         LEFT JOIN borrowers ON aqbasket.authorisedby=borrowers.borrowernumber
 723         LEFT JOIN biblio ON biblio.biblionumber=aqorders.biblionumber
 724         LEFT JOIN biblioitems ON biblioitems.biblionumber=biblio.biblionumber
 725         WHERE booksellerid=?
 726             AND (quantity > quantityreceived OR quantityreceived is NULL)
 727             AND datecancellationprinted IS NULL";
 728     my @query_params = ( $supplierid );
 729     my $userenv = C4::Context->userenv;
 730     if ( C4::Context->preference("IndependantBranches") ) {
 731         if ( ($userenv) && ( $userenv->{flags} != 1 ) ) {
 732             $strsth .= " and (borrowers.branchcode = ?
 733                         or borrowers.branchcode  = '')";
 734             push @query_params, $userenv->{branch};
 735         }
 736     }
 737     if ($owner) {
 738         $strsth .= " AND aqbasket.authorisedby=? ";
 739         push @query_params, $userenv->{'number'};
 740     }
 741     if ($basketno) {
 742         $strsth .= " AND aqbasket.basketno=? ";
 743         push @query_params, $basketno;
 744     }
 745     $strsth .= " group by aqbasket.basketno" if $grouped;
 746     $strsth .= " order by aqbasket.basketno";
 747
 748     my $sth = $dbh->prepare($strsth);
 749     $sth->execute( @query_params );
 750     my $results = $sth->fetchall_arrayref({});
 751     $sth->finish;
 752     return $results;
 753 }
 754
 755 #------------------------------------------------------------#
 756
 757 =head3 GetOrders
 758
 759   @orders = &GetOrders($basketnumber, $orderby);
 760
 761 Looks up the pending (non-cancelled) orders with the given basket
 762 number. If C<$booksellerID> is non-empty, only orders from that seller
 763 are returned.
 764
 765 return :
 766 C<&basket> returns a two-element array. C<@orders> is an array of
 767 references-to-hash, whose keys are the fields from the aqorders,
 768 biblio, and biblioitems tables in the Koha database.
 769
 770 =cut
 771
 772 sub GetOrders {
 773     my ( $basketno, $orderby ) = @_;
 774     my $dbh   = C4::Context->dbh;
 775     my $query  ="
 776         SELECT biblio.*,biblioitems.*,
 777                 aqorders.*,
 778                 aqbudgets.*,
 779                 biblio.title
 780         FROM    aqorders
 781             LEFT JOIN aqbudgets        ON aqbudgets.budget_id = aqorders.budget_id
 782             LEFT JOIN biblio           ON biblio.biblionumber = aqorders.biblionumber
 783             LEFT JOIN biblioitems      ON biblioitems.biblionumber =biblio.biblionumber
 784         WHERE   basketno=?
 785             AND (datecancellationprinted IS NULL OR datecancellationprinted='0000-00-00')
 786     ";
 787
 788     $orderby = "biblioitems.publishercode,biblio.title" unless $orderby;
 789     $query .= " ORDER BY $orderby";
 790     my $sth = $dbh->prepare($query);
 791     $sth->execute($basketno);
 792     my $results = $sth->fetchall_arrayref({});
 793     $sth->finish;
 794     return @$results;
 795 }
 796
 797 #------------------------------------------------------------#
 798
 799 =head3 GetOrderNumber
 800
 801   $ordernumber = &GetOrderNumber($biblioitemnumber, $biblionumber);
 802
 803 Looks up the ordernumber with the given biblionumber and biblioitemnumber.
 804
 805 Returns the number of this order.
 806
 807 =over
 808
 809 =item C<$ordernumber> is the order number.
 810
 811 =back
 812
 813 =cut
 814
 815 sub GetOrderNumber {
 816     my ( $biblionumber,$biblioitemnumber ) = @_;
 817     my $dbh = C4::Context->dbh;
 818     my $query = "
 819         SELECT ordernumber
 820         FROM   aqorders
 821         WHERE  biblionumber=?
 822         AND    biblioitemnumber=?
 823     ";
 824     my $sth = $dbh->prepare($query);
 825     $sth->execute( $biblionumber, $biblioitemnumber );
 826
 827     return $sth->fetchrow;
 828 }
 829
 830 #------------------------------------------------------------#
 831
 832 =head3 GetOrder
 833
 834   $order = &GetOrder($ordernumber);
 835
 836 Looks up an order by order number.
 837
 838 Returns a reference-to-hash describing the order. The keys of
 839 C<$order> are fields from the biblio, biblioitems, aqorders tables of the Koha database.
 840
 841 =cut
 842
 843 sub GetOrder {
 844     my ($ordernumber) = @_;
 845     my $dbh      = C4::Context->dbh;
 846     my $query = "
 847         SELECT biblioitems.*, biblio.*, aqorders.*
 848         FROM   aqorders
 849         LEFT JOIN biblio on           biblio.biblionumber=aqorders.biblionumber
 850         LEFT JOIN biblioitems on       biblioitems.biblionumber=aqorders.biblionumber
 851         WHERE aqorders.ordernumber=?
 852
 853     ";
 854     my $sth= $dbh->prepare($query);
 855     $sth->execute($ordernumber);
 856     my $data = $sth->fetchrow_hashref;
 857     $sth->finish;
 858     return $data;
 859 }
 860
 861 #------------------------------------------------------------#
 862
 863 =head3 NewOrder
 864
 865   &NewOrder(\%hashref);
 866
 867 Adds a new order to the database. Any argument that isn't described
 868 below is the new value of the field with the same name in the aqorders
 869 table of the Koha database.
 870
 871 =over
 872
 873 =item $hashref->{'basketno'} is the basketno foreign key in aqorders, it is mandatory
 874
 875 =item $hashref->{'ordernumber'} is a "minimum order number."
 876
 877 =item $hashref->{'budgetdate'} is effectively ignored.
 878 If it's undef (anything false) or the string 'now', the current day is used.
 879 Else, the upcoming July 1st is used.
 880
 881 =item $hashref->{'subscription'} may be either "yes", or anything else for "no".
 882
 883 =item $hashref->{'uncertainprice'} may be 0 for "the price is known" or 1 for "the price is uncertain"
 884
 885 =item defaults entrydate to Now
 886
 887 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".
 888
 889 =back
 890
 891 =cut
 892
 893 sub NewOrder {
 894     my $orderinfo = shift;
 895 #### ------------------------------
 896     my $dbh = C4::Context->dbh;
 897     my @params;
 898
 899
 900     # if these parameters are missing, we can't continue
 901     for my $key (qw/basketno quantity biblionumber budget_id/) {
 902         croak "Mandatory parameter $key missing" unless $orderinfo->{$key};
 903     }
 904
 905     if ( defined $orderinfo->{subscription} && $orderinfo->{'subscription'} eq 'yes' ) {
 906         $orderinfo->{'subscription'} = 1;
 907     } else {
 908         $orderinfo->{'subscription'} = 0;
 909     }
 910     $orderinfo->{'entrydate'} ||= C4::Dates->new()->output("iso");
 911     if (!$orderinfo->{quantityreceived}) {
 912         $orderinfo->{quantityreceived} = 0;
 913     }
 914
 915     my $ordernumber=InsertInTable("aqorders",$orderinfo);
 916     return ( $orderinfo->{'basketno'}, $ordernumber );
 917 }
 918
 919
 920
 921 #------------------------------------------------------------#
 922
 923 =head3 NewOrderItem
 924
 925   &NewOrderItem();
 926
 927 =cut
 928
 929 sub NewOrderItem {
 930     my ($itemnumber, $ordernumber)  = @_;
 931     my $dbh = C4::Context->dbh;
 932     my $query = qq|
 933             INSERT INTO aqorders_items
 934                 (itemnumber, ordernumber)
 935             VALUES (?,?)    |;
 936
 937     my $sth = $dbh->prepare($query);
 938     $sth->execute( $itemnumber, $ordernumber);
 939 }
 940
 941 #------------------------------------------------------------#
 942
 943 =head3 ModOrder
 944
 945   &ModOrder(\%hashref);
 946
 947 Modifies an existing order. Updates the order with order number
 948 $hashref->{'ordernumber'} and biblionumber $hashref->{'biblionumber'}. All
 949 other keys of the hash update the fields with the same name in the aqorders
 950 table of the Koha database.
 951
 952 =cut
 953
 954 sub ModOrder {
 955     my $orderinfo = shift;
 956
 957     die "Ordernumber is required"     if $orderinfo->{'ordernumber'} eq  '' ;
 958     die "Biblionumber is required"  if  $orderinfo->{'biblionumber'} eq '';
 959
 960     my $dbh = C4::Context->dbh;
 961     my @params;
 962
 963     # update uncertainprice to an integer, just in case (under FF, checked boxes have the value "ON" by default)
 964     $orderinfo->{uncertainprice}=1 if $orderinfo->{uncertainprice};
 965
 966 #    delete($orderinfo->{'branchcode'});
 967     # the hash contains a lot of entries not in aqorders, so get the columns ...
 968     my $sth = $dbh->prepare("SELECT * FROM aqorders LIMIT 1;");
 969     $sth->execute;
 970     my $colnames = $sth->{NAME};
 971     my $query = "UPDATE aqorders SET ";
 972
 973     foreach my $orderinfokey (grep(!/ordernumber/, keys %$orderinfo)){
 974         # ... and skip hash entries that are not in the aqorders table
 975         # FIXME : probably not the best way to do it (would be better to have a correct hash)
 976         next unless grep(/^$orderinfokey$/, @$colnames);
 977             $query .= "$orderinfokey=?, ";
 978             push(@params, $orderinfo->{$orderinfokey});
 979     }
 980
 981     $query .= "timestamp=NOW()  WHERE  ordernumber=?";
 982 #   push(@params, $specorderinfo{'ordernumber'});
 983     push(@params, $orderinfo->{'ordernumber'} );
 984     $sth = $dbh->prepare($query);
 985     $sth->execute(@params);
 986     $sth->finish;
 987 }
 988
 989 #------------------------------------------------------------#
 990
 991 =head3 ModOrderItem
 992
 993   &ModOrderItem(\%hashref);
 994
 995 Modifies the itemnumber in the aqorders_items table. The input hash needs three entities:
 996
 997 =over
 998
 999 =item - itemnumber: the old itemnumber
1000 =item - ordernumber: the order this item is attached to
1001 =item - newitemnumber: the new itemnumber we want to attach the line to
1002
1003 =back
1004
1005 =cut
1006
1007 sub ModOrderItem {
1008     my $orderiteminfo = shift;
1009     if (! $orderiteminfo->{'ordernumber'} || ! $orderiteminfo->{'itemnumber'} || ! $orderiteminfo->{'newitemnumber'}){
1010         die "Ordernumber, itemnumber and newitemnumber is required";
1011     }
1012
1013     my $dbh = C4::Context->dbh;
1014
1015     my $query = "UPDATE aqorders_items set itemnumber=? where itemnumber=? and ordernumber=?";
1016     my @params = ($orderiteminfo->{'newitemnumber'}, $orderiteminfo->{'itemnumber'}, $orderiteminfo->{'ordernumber'});
1017     my $sth = $dbh->prepare($query);
1018     $sth->execute(@params);
1019     return 0;
1020 }
1021
1022 #------------------------------------------------------------#
1023
1024
1025 =head3 ModOrderBibliotemNumber
1026
1027   &ModOrderBiblioitemNumber($biblioitemnumber,$ordernumber, $biblionumber);
1028
1029 Modifies the biblioitemnumber for an existing order.
1030 Updates the order with order number C<$ordernum> and biblionumber C<$biblionumber>.
1031
1032 =cut
1033
1034 #FIXME: is this used at all?
1035 sub ModOrderBiblioitemNumber {
1036     my ($biblioitemnumber,$ordernumber, $biblionumber) = @_;
1037     my $dbh = C4::Context->dbh;
1038     my $query = "
1039     UPDATE aqorders
1040     SET    biblioitemnumber = ?
1041     WHERE  ordernumber = ?
1042     AND biblionumber =  ?";
1043     my $sth = $dbh->prepare($query);
1044     $sth->execute( $biblioitemnumber, $ordernumber, $biblionumber );
1045 }
1046
1047 =head3 GetCancelledOrders
1048
1049   my @orders = GetCancelledOrders($basketno, $orderby);
1050
1051 Returns cancelled orders for a basket
1052
1053 =cut
1054
1055 sub GetCancelledOrders {
1056     my ( $basketno, $orderby ) = @_;
1057
1058     return () unless $basketno;
1059
1060     my $dbh   = C4::Context->dbh;
1061     my $query = "
1062         SELECT biblio.*, biblioitems.*, aqorders.*, aqbudgets.*
1063         FROM aqorders
1064           LEFT JOIN aqbudgets   ON aqbudgets.budget_id = aqorders.budget_id
1065           LEFT JOIN biblio      ON biblio.biblionumber = aqorders.biblionumber
1066           LEFT JOIN biblioitems ON biblioitems.biblionumber = biblio.biblionumber
1067         WHERE basketno = ?
1068           AND (datecancellationprinted IS NOT NULL
1069                AND datecancellationprinted <> '0000-00-00')
1070     ";
1071
1072     $orderby = "aqorders.datecancellationprinted desc, aqorders.timestamp desc"
1073         unless $orderby;
1074     $query .= " ORDER BY $orderby";
1075     my $sth = $dbh->prepare($query);
1076     $sth->execute($basketno);
1077     my $results = $sth->fetchall_arrayref( {} );
1078
1079     return @$results;
1080 }
1081
1082
1083 #------------------------------------------------------------#
1084
1085 =head3 ModReceiveOrder
1086
1087   &ModReceiveOrder($biblionumber, $ordernumber, $quantityreceived, $user,
1088     $unitprice, $booksellerinvoicenumber, $biblioitemnumber,
1089     $freight, $bookfund, $rrp);
1090
1091 Updates an order, to reflect the fact that it was received, at least
1092 in part. All arguments not mentioned below update the fields with the
1093 same name in the aqorders table of the Koha database.
1094
1095 If a partial order is received, splits the order into two.  The received
1096 portion must have a booksellerinvoicenumber.
1097
1098 Updates the order with bibilionumber C<$biblionumber> and ordernumber
1099 C<$ordernumber>.
1100
1101 =cut
1102
1103
1104 sub ModReceiveOrder {
1105     my (
1106         $biblionumber,    $ordernumber,  $quantrec, $user, $cost,
1107         $invoiceno, $freight, $rrp, $budget_id, $datereceived
1108     )
1109     = @_;
1110     my $dbh = C4::Context->dbh;
1111     $datereceived = C4::Dates->output('iso') unless $datereceived;
1112     my $suggestionid = GetSuggestionFromBiblionumber( $dbh, $biblionumber );
1113     if ($suggestionid) {
1114         ModSuggestion( {suggestionid=>$suggestionid,
1115                         STATUS=>'AVAILABLE',
1116                         biblionumber=> $biblionumber}
1117                         );
1118     }
1119
1120     my $sth=$dbh->prepare("
1121         SELECT * FROM   aqorders
1122         WHERE           biblionumber=? AND aqorders.ordernumber=?");
1123
1124     $sth->execute($biblionumber,$ordernumber);
1125     my $order = $sth->fetchrow_hashref();
1126     $sth->finish();
1127
1128     if ( $order->{quantity} > $quantrec ) {
1129         $sth=$dbh->prepare("
1130             UPDATE aqorders
1131             SET quantityreceived=?
1132                 , datereceived=?
1133                 , booksellerinvoicenumber=?
1134                 , unitprice=?
1135                 , freight=?
1136                 , rrp=?
1137                 , quantity=?
1138             WHERE biblionumber=? AND ordernumber=?");
1139
1140         $sth->execute($quantrec,$datereceived,$invoiceno,$cost,$freight,$rrp,$quantrec,$biblionumber,$ordernumber);
1141         $sth->finish;
1142
1143         # create a new order for the remaining items, and set its bookfund.
1144         foreach my $orderkey ( "linenumber", "allocation" ) {
1145             delete($order->{'$orderkey'});
1146         }
1147         $order->{'quantity'} -= $quantrec;
1148         $order->{'quantityreceived'} = 0;
1149         my $newOrder = NewOrder($order);
1150 } else {
1151         $sth=$dbh->prepare("update aqorders
1152                             set quantityreceived=?,datereceived=?,booksellerinvoicenumber=?,
1153                                 unitprice=?,freight=?,rrp=?
1154                             where biblionumber=? and ordernumber=?");
1155         $sth->execute($quantrec,$datereceived,$invoiceno,$cost,$freight,$rrp,$biblionumber,$ordernumber);
1156         $sth->finish;
1157     }
1158     return $datereceived;
1159 }
1160 #------------------------------------------------------------#
1161
1162 =head3 SearchOrder
1163
1164 @results = &SearchOrder($search, $biblionumber, $complete);
1165
1166 Searches for orders.
1167
1168 C<$search> may take one of several forms: if it is an ISBN,
1169 C<&ordersearch> returns orders with that ISBN. If C<$search> is an
1170 order number, C<&ordersearch> returns orders with that order number
1171 and biblionumber C<$biblionumber>. Otherwise, C<$search> is considered
1172 to be a space-separated list of search terms; in this case, all of the
1173 terms must appear in the title (matching the beginning of title
1174 words).
1175
1176 If C<$complete> is C<yes>, the results will include only completed
1177 orders. In any case, C<&ordersearch> ignores cancelled orders.
1178
1179 C<&ordersearch> returns an array.
1180 C<@results> is an array of references-to-hash with the following keys:
1181
1182 =over 4
1183
1184 =item C<author>
1185
1186 =item C<seriestitle>
1187
1188 =item C<branchcode>
1189
1190 =item C<bookfundid>
1191
1192 =back
1193
1194 =cut
1195
1196 sub SearchOrder {
1197 #### -------- SearchOrder-------------------------------
1198     my ($ordernumber, $search, $supplierid, $basket) = @_;
1199
1200     my $dbh = C4::Context->dbh;
1201     my @args = ();
1202     my $query =
1203             "SELECT *
1204             FROM aqorders
1205             LEFT JOIN biblio ON aqorders.biblionumber=biblio.biblionumber
1206             LEFT JOIN biblioitems ON biblioitems.biblionumber=biblio.biblionumber
1207             LEFT JOIN aqbasket ON aqorders.basketno = aqbasket.basketno
1208                 WHERE  (datecancellationprinted is NULL)";
1209
1210     if($ordernumber){
1211         $query .= " AND (aqorders.ordernumber=?)";
1212         push @args, $ordernumber;
1213     }
1214     if($search){
1215         $query .= " AND (biblio.title like ? OR biblio.author LIKE ? OR biblioitems.isbn like ?)";
1216         push @args, ("%$search%","%$search%","%$search%");
1217     }
1218     if($supplierid){
1219         $query .= "AND aqbasket.booksellerid = ?";
1220         push @args, $supplierid;
1221     }
1222     if($basket){
1223         $query .= "AND aqorders.basketno = ?";
1224         push @args, $basket;
1225     }
1226
1227     my $sth = $dbh->prepare($query);
1228     $sth->execute(@args);
1229     my $results = $sth->fetchall_arrayref({});
1230     $sth->finish;
1231     return $results;
1232 }
1233
1234 #------------------------------------------------------------#
1235
1236 =head3 DelOrder
1237
1238   &DelOrder($biblionumber, $ordernumber);
1239
1240 Cancel the order with the given order and biblio numbers. It does not
1241 delete any entries in the aqorders table, it merely marks them as
1242 cancelled.
1243
1244 =cut
1245
1246 sub DelOrder {
1247     my ( $bibnum, $ordernumber ) = @_;
1248     my $dbh = C4::Context->dbh;
1249     my $query = "
1250         UPDATE aqorders
1251         SET    datecancellationprinted=now()
1252         WHERE  biblionumber=? AND ordernumber=?
1253     ";
1254     my $sth = $dbh->prepare($query);
1255     $sth->execute( $bibnum, $ordernumber );
1256     $sth->finish;
1257     my @itemnumbers = GetItemnumbersFromOrder( $ordernumber );
1258     foreach my $itemnumber (@itemnumbers){
1259         C4::Items::DelItem( $dbh, $bibnum, $itemnumber );
1260     }
1261
1262 }
1263
1264 =head2 FUNCTIONS ABOUT PARCELS
1265
1266 =cut
1267
1268 #------------------------------------------------------------#
1269
1270 =head3 GetParcel
1271
1272   @results = &GetParcel($booksellerid, $code, $date);
1273
1274 Looks up all of the received items from the supplier with the given
1275 bookseller ID at the given date, for the given code (bookseller Invoice number). Ignores cancelled and completed orders.
1276
1277 C<@results> is an array of references-to-hash. The keys of each element are fields from
1278 the aqorders, biblio, and biblioitems tables of the Koha database.
1279
1280 C<@results> is sorted alphabetically by book title.
1281
1282 =cut
1283
1284 sub GetParcel {
1285     #gets all orders from a certain supplier, orders them alphabetically
1286     my ( $supplierid, $code, $datereceived ) = @_;
1287     my $dbh     = C4::Context->dbh;
1288     my @results = ();
1289     $code .= '%'
1290     if $code;  # add % if we search on a given code (otherwise, let him empty)
1291     my $strsth ="
1292         SELECT  authorisedby,
1293                 creationdate,
1294                 aqbasket.basketno,
1295                 closedate,surname,
1296                 firstname,
1297                 aqorders.biblionumber,
1298                 aqorders.ordernumber,
1299                 aqorders.quantity,
1300                 aqorders.quantityreceived,
1301                 aqorders.unitprice,
1302                 aqorders.listprice,
1303                 aqorders.rrp,
1304                 aqorders.ecost,
1305                 biblio.title
1306         FROM aqorders
1307         LEFT JOIN aqbasket ON aqbasket.basketno=aqorders.basketno
1308         LEFT JOIN borrowers ON aqbasket.authorisedby=borrowers.borrowernumber
1309         LEFT JOIN biblio ON aqorders.biblionumber=biblio.biblionumber
1310         WHERE
1311             aqbasket.booksellerid = ?
1312             AND aqorders.booksellerinvoicenumber LIKE ?
1313             AND aqorders.datereceived = ? ";
1314
1315     my @query_params = ( $supplierid, $code, $datereceived );
1316     if ( C4::Context->preference("IndependantBranches") ) {
1317         my $userenv = C4::Context->userenv;
1318         if ( ($userenv) && ( $userenv->{flags} != 1 ) ) {
1319             $strsth .= " and (borrowers.branchcode = ?
1320                         or borrowers.branchcode  = '')";
1321             push @query_params, $userenv->{branch};
1322         }
1323     }
1324     $strsth .= " ORDER BY aqbasket.basketno";
1325     # ## parcelinformation : $strsth
1326     my $sth = $dbh->prepare($strsth);
1327     $sth->execute( @query_params );
1328     while ( my $data = $sth->fetchrow_hashref ) {
1329         push( @results, $data );
1330     }
1331     # ## countparcelbiblio: scalar(@results)
1332     $sth->finish;
1333
1334     return @results;
1335 }
1336
1337 #------------------------------------------------------------#
1338
1339 =head3 GetParcels
1340
1341   $results = &GetParcels($bookseller, $order, $code, $datefrom, $dateto);
1342
1343 get a lists of parcels.
1344
1345 * Input arg :
1346
1347 =over
1348
1349 =item $bookseller
1350 is the bookseller this function has to get parcels.
1351
1352 =item $order
1353 To know on what criteria the results list has to be ordered.
1354
1355 =item $code
1356 is the booksellerinvoicenumber.
1357
1358 =item $datefrom & $dateto
1359 to know on what date this function has to filter its search.
1360
1361 =back
1362
1363 * return:
1364 a pointer on a hash list containing parcel informations as such :
1365
1366 =over
1367
1368 =item Creation date
1369
1370 =item Last operation
1371
1372 =item Number of biblio
1373
1374 =item Number of items
1375
1376 =back
1377
1378 =cut
1379
1380 sub GetParcels {
1381     my ($bookseller,$order, $code, $datefrom, $dateto) = @_;
1382     my $dbh    = C4::Context->dbh;
1383     my @query_params = ();
1384     my $strsth ="
1385         SELECT  aqorders.booksellerinvoicenumber,
1386                 datereceived,purchaseordernumber,
1387                 count(DISTINCT biblionumber) AS biblio,
1388                 sum(quantity) AS itemsexpected,
1389                 sum(quantityreceived) AS itemsreceived
1390         FROM   aqorders LEFT JOIN aqbasket ON aqbasket.basketno = aqorders.basketno
1391         WHERE aqbasket.booksellerid = ? and datereceived IS NOT NULL
1392     ";
1393     push @query_params, $bookseller;
1394
1395     if ( defined $code ) {
1396         $strsth .= ' and aqorders.booksellerinvoicenumber like ? ';
1397         # add a % to the end of the code to allow stemming.
1398         push @query_params, "$code%";
1399     }
1400
1401     if ( defined $datefrom ) {
1402         $strsth .= ' and datereceived >= ? ';
1403         push @query_params, $datefrom;
1404     }
1405
1406     if ( defined $dateto ) {
1407         $strsth .=  'and datereceived <= ? ';
1408         push @query_params, $dateto;
1409     }
1410
1411     $strsth .= "group by aqorders.booksellerinvoicenumber,datereceived ";
1412
1413     # can't use a placeholder to place this column name.
1414     # but, we could probably be checking to make sure it is a column that will be fetched.
1415     $strsth .= "order by $order " if ($order);
1416
1417     my $sth = $dbh->prepare($strsth);
1418
1419     $sth->execute( @query_params );
1420     my $results = $sth->fetchall_arrayref({});
1421     $sth->finish;
1422     return @$results;
1423 }
1424
1425 #------------------------------------------------------------#
1426
1427 =head3 GetLateOrders
1428
1429   @results = &GetLateOrders;
1430
1431 Searches for bookseller with late orders.
1432
1433 return:
1434 the table of supplier with late issues. This table is full of hashref.
1435
1436 =cut
1437
1438 sub GetLateOrders {
1439     my $delay      = shift;
1440     my $supplierid = shift;
1441     my $branch     = shift;
1442
1443     my $dbh = C4::Context->dbh;
1444
1445     #BEWARE, order of parenthesis and LEFT JOIN is important for speed
1446     my $dbdriver = C4::Context->config("db_scheme") || "mysql";
1447
1448     my @query_params = ($delay);        # delay is the first argument regardless
1449     my $select = "
1450     SELECT aqbasket.basketno,
1451         aqorders.ordernumber,
1452         DATE(aqbasket.closedate)  AS orderdate,
1453         aqorders.rrp              AS unitpricesupplier,
1454         aqorders.ecost            AS unitpricelib,
1455         aqorders.claims_count     AS claims_count,
1456         aqorders.claimed_date     AS claimed_date,
1457         aqbudgets.budget_name     AS budget,
1458         borrowers.branchcode      AS branch,
1459         aqbooksellers.name        AS supplier,
1460         aqbooksellers.id          AS supplierid,
1461         biblio.author, biblio.title,
1462         biblioitems.publishercode AS publisher,
1463         biblioitems.publicationyear,
1464     ";
1465     my $from = "
1466     FROM
1467         aqorders LEFT JOIN biblio     ON biblio.biblionumber         = aqorders.biblionumber
1468         LEFT JOIN biblioitems         ON biblioitems.biblionumber    = biblio.biblionumber
1469         LEFT JOIN aqbudgets           ON aqorders.budget_id          = aqbudgets.budget_id,
1470         aqbasket LEFT JOIN borrowers  ON aqbasket.authorisedby       = borrowers.borrowernumber
1471         LEFT JOIN aqbooksellers       ON aqbasket.booksellerid       = aqbooksellers.id
1472         WHERE aqorders.basketno = aqbasket.basketno
1473         AND ( datereceived = ''
1474             OR datereceived IS NULL
1475             OR aqorders.quantityreceived < aqorders.quantity
1476         )
1477         AND (aqorders.datecancellationprinted IS NULL OR aqorders.datecancellationprinted='0000-00-00')
1478     ";
1479     my $having = "";
1480     if ($dbdriver eq "mysql") {
1481         $select .= "
1482         aqorders.quantity - IFNULL(aqorders.quantityreceived,0)                 AS quantity,
1483         (aqorders.quantity - IFNULL(aqorders.quantityreceived,0)) * aqorders.rrp AS subtotal,
1484         DATEDIFF(CURDATE( ),closedate) AS latesince
1485         ";
1486         $from .= " AND (closedate <= DATE_SUB(CURDATE( ),INTERVAL ? DAY)) ";
1487         $having = "
1488         HAVING quantity          <> 0
1489             AND unitpricesupplier <> 0
1490             AND unitpricelib      <> 0
1491         ";
1492     } else {
1493         # FIXME: account for IFNULL as above
1494         $select .= "
1495                 aqorders.quantity                AS quantity,
1496                 aqorders.quantity * aqorders.rrp AS subtotal,
1497                 (CURDATE - closedate)            AS latesince
1498         ";
1499         $from .= " AND (closedate <= (CURDATE -(INTERVAL ? DAY)) ";
1500     }
1501     if (defined $supplierid) {
1502         $from .= ' AND aqbasket.booksellerid = ? ';
1503         push @query_params, $supplierid;
1504     }
1505     if (defined $branch) {
1506         $from .= ' AND borrowers.branchcode LIKE ? ';
1507         push @query_params, $branch;
1508     }
1509     if (C4::Context->preference("IndependantBranches")
1510             && C4::Context->userenv
1511             && C4::Context->userenv->{flags} != 1 ) {
1512         $from .= ' AND borrowers.branchcode LIKE ? ';
1513         push @query_params, C4::Context->userenv->{branch};
1514     }
1515     my $query = "$select $from $having\nORDER BY latesince, basketno, borrowers.branchcode, supplier";
1516     $debug and print STDERR "GetLateOrders query: $query\nGetLateOrders args: " . join(" ",@query_params);
1517     my $sth = $dbh->prepare($query);
1518     $sth->execute(@query_params);
1519     my @results;
1520     while (my $data = $sth->fetchrow_hashref) {
1521         $data->{orderdate} = format_date($data->{orderdate});
1522         $data->{claimed_date} = format_date($data->{claimed_date});
1523         push @results, $data;
1524     }
1525     return @results;
1526 }
1527
1528 #------------------------------------------------------------#
1529
1530 =head3 GetHistory
1531
1532   (\@order_loop, $total_qty, $total_price, $total_qtyreceived) = GetHistory( %params );
1533
1534 Retreives some acquisition history information
1535
1536 params:
1537   title
1538   author
1539   name
1540   from_placed_on
1541   to_placed_on
1542   basket                  - search both basket name and number
1543   booksellerinvoicenumber
1544
1545 returns:
1546     $order_loop is a list of hashrefs that each look like this:
1547             {
1548                 'author'           => 'Twain, Mark',
1549                 'basketno'         => '1',
1550                 'biblionumber'     => '215',
1551                 'count'            => 1,
1552                 'creationdate'     => 'MM/DD/YYYY',
1553                 'datereceived'     => undef,
1554                 'ecost'            => '1.00',
1555                 'id'               => '1',
1556                 'invoicenumber'    => undef,
1557                 'name'             => '',
1558                 'ordernumber'      => '1',
1559                 'quantity'         => 1,
1560                 'quantityreceived' => undef,
1561                 'title'            => 'The Adventures of Huckleberry Finn'
1562             }
1563     $total_qty is the sum of all of the quantities in $order_loop
1564     $total_price is the cost of each in $order_loop times the quantity
1565     $total_qtyreceived is the sum of all of the quantityreceived entries in $order_loop
1566
1567 =cut
1568
1569 sub GetHistory {
1570 # don't run the query if there are no parameters (list would be too long for sure !)
1571     croak "No search params" unless @_;
1572     my %params = @_;
1573     my $title = $params{title};
1574     my $author = $params{author};
1575     my $isbn   = $params{isbn};
1576     my $name = $params{name};
1577     my $from_placed_on = $params{from_placed_on};
1578     my $to_placed_on = $params{to_placed_on};
1579     my $basket = $params{basket};
1580     my $booksellerinvoicenumber = $params{booksellerinvoicenumber};
1581
1582     my @order_loop;
1583     my $total_qty         = 0;
1584     my $total_qtyreceived = 0;
1585     my $total_price       = 0;
1586
1587     my $dbh   = C4::Context->dbh;
1588     my $query ="
1589         SELECT
1590             biblio.title,
1591             biblio.author,
1592             biblioitems.isbn,
1593             aqorders.basketno,
1594     aqbasket.basketname,
1595     aqbasket.basketgroupid,
1596     aqbasketgroups.name as groupname,
1597             aqbooksellers.name,
1598     aqbasket.creationdate,
1599             aqorders.datereceived,
1600             aqorders.quantity,
1601             aqorders.quantityreceived,
1602             aqorders.ecost,
1603             aqorders.ordernumber,
1604             aqorders.booksellerinvoicenumber as invoicenumber,
1605             aqbooksellers.id as id,
1606             aqorders.biblionumber
1607         FROM aqorders
1608         LEFT JOIN aqbasket ON aqorders.basketno=aqbasket.basketno
1609     LEFT JOIN aqbasketgroups ON aqbasket.basketgroupid=aqbasketgroups.id
1610         LEFT JOIN aqbooksellers ON aqbasket.booksellerid=aqbooksellers.id
1611         LEFT JOIN biblioitems ON biblioitems.biblionumber=aqorders.biblionumber
1612         LEFT JOIN biblio ON biblio.biblionumber=aqorders.biblionumber";
1613
1614     $query .= " LEFT JOIN borrowers ON aqbasket.authorisedby=borrowers.borrowernumber"
1615     if ( C4::Context->preference("IndependantBranches") );
1616
1617     $query .= " WHERE (datecancellationprinted is NULL or datecancellationprinted='0000-00-00') ";
1618
1619     my @query_params  = ();
1620
1621     if ( $title ) {
1622         $query .= " AND biblio.title LIKE ? ";
1623         $title =~ s/\s+/%/g;
1624         push @query_params, "%$title%";
1625     }
1626
1627     if ( $author ) {
1628         $query .= " AND biblio.author LIKE ? ";
1629         push @query_params, "%$author%";
1630     }
1631
1632     if ( $isbn ) {
1633         $query .= " AND biblioitems.isbn LIKE ? ";
1634         push @query_params, "%$isbn%";
1635     }
1636
1637     if ( $name ) {
1638         $query .= " AND aqbooksellers.name LIKE ? ";
1639         push @query_params, "%$name%";
1640     }
1641
1642     if ( $from_placed_on ) {
1643         $query .= " AND creationdate >= ? ";
1644         push @query_params, $from_placed_on;
1645     }
1646
1647     if ( $to_placed_on ) {
1648         $query .= " AND creationdate <= ? ";
1649         push @query_params, $to_placed_on;
1650     }
1651
1652     if ($basket) {
1653         if ($basket =~ m/^\d+$/) {
1654             $query .= " AND aqorders.basketno = ? ";
1655             push @query_params, $basket;
1656         } else {
1657             $query .= " AND aqbasket.basketname LIKE ? ";
1658             push @query_params, "%$basket%";
1659         }
1660     }
1661
1662     if ($booksellerinvoicenumber) {
1663         $query .= " AND (aqorders.booksellerinvoicenumber LIKE ? OR aqbasket.booksellerinvoicenumber LIKE ?)";
1664         push @query_params, "%$booksellerinvoicenumber%", "%$booksellerinvoicenumber%";
1665     }
1666
1667     if ( C4::Context->preference("IndependantBranches") ) {
1668         my $userenv = C4::Context->userenv;
1669         if ( $userenv && ($userenv->{flags} || 0) != 1 ) {
1670             $query .= " AND (borrowers.branchcode = ? OR borrowers.branchcode ='' ) ";
1671             push @query_params, $userenv->{branch};
1672         }
1673     }
1674     $query .= " ORDER BY id";
1675     my $sth = $dbh->prepare($query);
1676     $sth->execute( @query_params );
1677     my $cnt = 1;
1678     while ( my $line = $sth->fetchrow_hashref ) {
1679         $line->{count} = $cnt++;
1680         $line->{toggle} = 1 if $cnt % 2;
1681         push @order_loop, $line;
1682         $total_qty         += $line->{'quantity'};
1683         $total_qtyreceived += $line->{'quantityreceived'};
1684         $total_price       += $line->{'quantity'} * $line->{'ecost'};
1685     }
1686     return \@order_loop, $total_qty, $total_price, $total_qtyreceived;
1687 }
1688
1689 =head2 GetRecentAcqui
1690
1691   $results = GetRecentAcqui($days);
1692
1693 C<$results> is a ref to a table which containts hashref
1694
1695 =cut
1696
1697 sub GetRecentAcqui {
1698     my $limit  = shift;
1699     my $dbh    = C4::Context->dbh;
1700     my $query = "
1701         SELECT *
1702         FROM   biblio
1703         ORDER BY timestamp DESC
1704         LIMIT  0,".$limit;
1705
1706     my $sth = $dbh->prepare($query);
1707     $sth->execute;
1708     my $results = $sth->fetchall_arrayref({});
1709     return $results;
1710 }
1711
1712 =head3 GetContracts
1713
1714   $contractlist = &GetContracts($booksellerid, $activeonly);
1715
1716 Looks up the contracts that belong to a bookseller
1717
1718 Returns a list of contracts
1719
1720 =over
1721
1722 =item C<$booksellerid> is the "id" field in the "aqbooksellers" table.
1723
1724 =item C<$activeonly> if exists get only contracts that are still active.
1725
1726 =back
1727
1728 =cut
1729
1730 sub GetContracts {
1731     my ( $booksellerid, $activeonly ) = @_;
1732     my $dbh = C4::Context->dbh;
1733     my $query;
1734     if (! $activeonly) {
1735         $query = "
1736             SELECT *
1737             FROM   aqcontract
1738             WHERE  booksellerid=?
1739         ";
1740     } else {
1741         $query = "SELECT *
1742             FROM aqcontract
1743             WHERE booksellerid=?
1744                 AND contractenddate >= CURDATE( )";
1745     }
1746     my $sth = $dbh->prepare($query);
1747     $sth->execute( $booksellerid );
1748     my @results;
1749     while (my $data = $sth->fetchrow_hashref ) {
1750         push(@results, $data);
1751     }
1752     $sth->finish;
1753     return @results;
1754 }
1755
1756 #------------------------------------------------------------#
1757
1758 =head3 GetContract
1759
1760   $contract = &GetContract($contractID);
1761
1762 Looks up the contract that has PRIMKEY (contractnumber) value $contractID
1763
1764 Returns a contract
1765
1766 =cut
1767
1768 sub GetContract {
1769     my ( $contractno ) = @_;
1770     my $dbh = C4::Context->dbh;
1771     my $query = "
1772         SELECT *
1773         FROM   aqcontract
1774         WHERE  contractnumber=?
1775         ";
1776
1777     my $sth = $dbh->prepare($query);
1778     $sth->execute( $contractno );
1779     my $result = $sth->fetchrow_hashref;
1780     return $result;
1781 }
1782
1783 =head3 AddClaim
1784
1785 =over 4
1786
1787 &AddClaim($ordernumber);
1788
1789 Add a claim for an order
1790
1791 =back
1792
1793 =cut
1794 sub AddClaim {
1795     my ($ordernumber) = @_;
1796     my $dbh          = C4::Context->dbh;
1797     my $query        = "
1798         UPDATE aqorders SET
1799             claims_count = claims_count + 1,
1800             claimed_date = CURDATE()
1801         WHERE ordernumber = ?
1802         ";
1803     my $sth = $dbh->prepare($query);
1804     $sth->execute($ordernumber);
1805
1806 }
1807
1808 1;
1809 __END__
1810
1811 =head1 AUTHOR
1812
1813 Koha Development Team <http://koha-community.org/>
1814
1815 =cut