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 use C4::Bookseller qw(GetBookSellerFromId);
  33 use C4::Templates qw(gettemplate);
  34
  35 use Time::localtime;
  36 use HTML::Entities;
  37
  38 use vars qw($VERSION @ISA @EXPORT);
  39
  40 BEGIN {
  41     # set the version for version checking
  42     $VERSION = 3.07.00.049;
  43     require Exporter;
  44     @ISA    = qw(Exporter);
  45     @EXPORT = qw(
  46         &GetBasket &NewBasket &CloseBasket &DelBasket &ModBasket
  47         &GetBasketAsCSV &GetBasketGroupAsCSV
  48         &GetBasketsByBookseller &GetBasketsByBasketgroup
  49         &GetBasketsInfosByBookseller
  50
  51         &ModBasketHeader
  52
  53         &ModBasketgroup &NewBasketgroup &DelBasketgroup &GetBasketgroup &CloseBasketgroup
  54         &GetBasketgroups &ReOpenBasketgroup
  55
  56         &NewOrder &DelOrder &ModOrder &GetPendingOrders &GetOrder &GetOrders &GetOrdersByBiblionumber
  57         &SearchOrder &GetHistory &GetRecentAcqui
  58         &ModReceiveOrder &CancelReceipt &ModOrderBiblioitemNumber
  59         &GetCancelledOrders
  60         &GetLastOrderNotReceivedFromSubscriptionid &GetLastOrderReceivedFromSubscriptionid
  61         &NewOrderItem &ModOrderItem &ModItemOrder
  62
  63         &GetParcels &GetParcel
  64         &GetContracts &GetContract
  65
  66         &GetInvoices
  67         &GetInvoice
  68         &GetInvoiceDetails
  69         &AddInvoice
  70         &ModInvoice
  71         &CloseInvoice
  72         &ReopenInvoice
  73
  74         &GetItemnumbersFromOrder
  75
  76         &AddClaim
  77     );
  78 }
  79
  80
  81
  82
  83
  84 sub GetOrderFromItemnumber {
  85     my ($itemnumber) = @_;
  86     my $dbh          = C4::Context->dbh;
  87     my $query        = qq|
  88
  89     SELECT  * from aqorders    LEFT JOIN aqorders_items
  90     ON (     aqorders.ordernumber = aqorders_items.ordernumber   )
  91     WHERE itemnumber = ?  |;
  92
  93     my $sth = $dbh->prepare($query);
  94
  95 #    $sth->trace(3);
  96
  97     $sth->execute($itemnumber);
  98
  99     my $order = $sth->fetchrow_hashref;
 100     return ( $order  );
 101
 102 }
 103
 104 # Returns the itemnumber(s) associated with the ordernumber given in parameter
 105 sub GetItemnumbersFromOrder {
 106     my ($ordernumber) = @_;
 107     my $dbh          = C4::Context->dbh;
 108     my $query        = "SELECT itemnumber FROM aqorders_items WHERE ordernumber=?";
 109     my $sth = $dbh->prepare($query);
 110     $sth->execute($ordernumber);
 111     my @tab;
 112
 113     while (my $order = $sth->fetchrow_hashref) {
 114     push @tab, $order->{'itemnumber'};
 115     }
 116
 117     return @tab;
 118
 119 }
 120
 121
 122
 123
 124
 125
 126 =head1 NAME
 127
 128 C4::Acquisition - Koha functions for dealing with orders and acquisitions
 129
 130 =head1 SYNOPSIS
 131
 132 use C4::Acquisition;
 133
 134 =head1 DESCRIPTION
 135
 136 The functions in this module deal with acquisitions, managing book
 137 orders, basket and parcels.
 138
 139 =head1 FUNCTIONS
 140
 141 =head2 FUNCTIONS ABOUT BASKETS
 142
 143 =head3 GetBasket
 144
 145   $aqbasket = &GetBasket($basketnumber);
 146
 147 get all basket informations in aqbasket for a given basket
 148
 149 B<returns:> informations for a given basket returned as a hashref.
 150
 151 =cut
 152
 153 sub GetBasket {
 154     my ($basketno) = @_;
 155     my $dbh        = C4::Context->dbh;
 156     my $query = "
 157         SELECT  aqbasket.*,
 158                 concat( b.firstname,' ',b.surname) AS authorisedbyname,
 159                 b.branchcode AS branch
 160         FROM    aqbasket
 161         LEFT JOIN borrowers b ON aqbasket.authorisedby=b.borrowernumber
 162         WHERE basketno=?
 163     ";
 164     my $sth=$dbh->prepare($query);
 165     $sth->execute($basketno);
 166     my $basket = $sth->fetchrow_hashref;
 167     return ( $basket );
 168 }
 169
 170 #------------------------------------------------------------#
 171
 172 =head3 NewBasket
 173
 174   $basket = &NewBasket( $booksellerid, $authorizedby, $basketname,
 175       $basketnote, $basketbooksellernote, $basketcontractnumber, $deliveryplace, $billingplace );
 176
 177 Create a new basket in aqbasket table
 178
 179 =over
 180
 181 =item C<$booksellerid> is a foreign key in the aqbasket table
 182
 183 =item C<$authorizedby> is the username of who created the basket
 184
 185 =back
 186
 187 The other parameters are optional, see ModBasketHeader for more info on them.
 188
 189 =cut
 190
 191 sub NewBasket {
 192     my ( $booksellerid, $authorisedby, $basketname, $basketnote,
 193         $basketbooksellernote, $basketcontractnumber, $deliveryplace,
 194         $billingplace ) = @_;
 195     my $dbh = C4::Context->dbh;
 196     my $query =
 197         'INSERT INTO aqbasket (creationdate,booksellerid,authorisedby) '
 198       . 'VALUES  (now(),?,?)';
 199     $dbh->do( $query, {}, $booksellerid, $authorisedby );
 200
 201     my $basket = $dbh->{mysql_insertid};
 202     $basketname           ||= q{}; # default to empty strings
 203     $basketnote           ||= q{};
 204     $basketbooksellernote ||= q{};
 205     ModBasketHeader( $basket, $basketname, $basketnote, $basketbooksellernote,
 206         $basketcontractnumber, $booksellerid, $deliveryplace, $billingplace );
 207     return $basket;
 208 }
 209
 210 #------------------------------------------------------------#
 211
 212 =head3 CloseBasket
 213
 214   &CloseBasket($basketno);
 215
 216 close a basket (becomes unmodifiable,except for recieves)
 217
 218 =cut
 219
 220 sub CloseBasket {
 221     my ($basketno) = @_;
 222     my $dbh        = C4::Context->dbh;
 223     my $query = "
 224         UPDATE aqbasket
 225         SET    closedate=now()
 226         WHERE  basketno=?
 227     ";
 228     my $sth = $dbh->prepare($query);
 229     $sth->execute($basketno);
 230 }
 231
 232 #------------------------------------------------------------#
 233
 234 =head3 GetBasketAsCSV
 235
 236   &GetBasketAsCSV($basketno);
 237
 238 Export a basket as CSV
 239
 240 $cgi parameter is needed for column name translation
 241
 242 =cut
 243
 244 sub GetBasketAsCSV {
 245     my ($basketno, $cgi) = @_;
 246     my $basket = GetBasket($basketno);
 247     my @orders = GetOrders($basketno);
 248     my $contract = GetContract($basket->{'contractnumber'});
 249
 250     my $template = C4::Templates::gettemplate("acqui/csv/basket.tmpl", "intranet", $cgi);
 251
 252     my @rows;
 253     foreach my $order (@orders) {
 254         my $bd = GetBiblioData( $order->{'biblionumber'} );
 255         my $row = {
 256             contractname => $contract->{'contractname'},
 257             ordernumber => $order->{'ordernumber'},
 258             entrydate => $order->{'entrydate'},
 259             isbn => $order->{'isbn'},
 260             author => $bd->{'author'},
 261             title => $bd->{'title'},
 262             publicationyear => $bd->{'publicationyear'},
 263             publishercode => $bd->{'publishercode'},
 264             collectiontitle => $bd->{'collectiontitle'},
 265             notes => $order->{'notes'},
 266             quantity => $order->{'quantity'},
 267             rrp => $order->{'rrp'},
 268             deliveryplace => C4::Branch::GetBranchName( $basket->{'deliveryplace'} ),
 269             billingplace => C4::Branch::GetBranchName( $basket->{'billingplace'} ),
 270         };
 271         foreach(qw(
 272             contractname author title publishercode collectiontitle notes
 273             deliveryplace billingplace
 274         ) ) {
 275             # Double the quotes to not be interpreted as a field end
 276             $row->{$_} =~ s/"/""/g if $row->{$_};
 277         }
 278         push @rows, $row;
 279     }
 280
 281     @rows = sort {
 282         if(defined $a->{publishercode} and defined $b->{publishercode}) {
 283             $a->{publishercode} cmp $b->{publishercode};
 284         }
 285     } @rows;
 286
 287     $template->param(rows => \@rows);
 288
 289     return $template->output;
 290 }
 291
 292
 293 =head3 GetBasketGroupAsCSV
 294
 295 =over 4
 296
 297 &GetBasketGroupAsCSV($basketgroupid);
 298
 299 Export a basket group as CSV
 300
 301 $cgi parameter is needed for column name translation
 302
 303 =back
 304
 305 =cut
 306
 307 sub GetBasketGroupAsCSV {
 308     my ($basketgroupid, $cgi) = @_;
 309     my $baskets = GetBasketsByBasketgroup($basketgroupid);
 310
 311     my $template = C4::Templates::gettemplate('acqui/csv/basketgroup.tmpl', 'intranet', $cgi);
 312
 313     my @rows;
 314     for my $basket (@$baskets) {
 315         my @orders     = GetOrders( $$basket{basketno} );
 316         my $contract   = GetContract( $$basket{contractnumber} );
 317         my $bookseller = GetBookSellerFromId( $$basket{booksellerid} );
 318         my $basketgroup = GetBasketgroup( $$basket{basketgroupid} );
 319
 320         foreach my $order (@orders) {
 321             my $bd = GetBiblioData( $order->{'biblionumber'} );
 322             my $row = {
 323                 clientnumber => $bookseller->{accountnumber},
 324                 basketname => $basket->{basketname},
 325                 ordernumber => $order->{ordernumber},
 326                 author => $bd->{author},
 327                 title => $bd->{title},
 328                 publishercode => $bd->{publishercode},
 329                 publicationyear => $bd->{publicationyear},
 330                 collectiontitle => $bd->{collectiontitle},
 331                 isbn => $order->{isbn},
 332                 quantity => $order->{quantity},
 333                 rrp => $order->{rrp},
 334                 discount => $bookseller->{discount},
 335                 ecost => $order->{ecost},
 336                 notes => $order->{notes},
 337                 entrydate => $order->{entrydate},
 338                 booksellername => $bookseller->{name},
 339                 bookselleraddress => $bookseller->{address1},
 340                 booksellerpostal => $bookseller->{postal},
 341                 contractnumber => $contract->{contractnumber},
 342                 contractname => $contract->{contractname},
 343                 basketgroupdeliveryplace => C4::Branch::GetBranchName( $basketgroup->{deliveryplace} ),
 344                 basketgroupbillingplace => C4::Branch::GetBranchName( $basketgroup->{billingplace} ),
 345                 basketdeliveryplace => C4::Branch::GetBranchName( $basket->{deliveryplace} ),
 346                 basketbillingplace => C4::Branch::GetBranchName( $basket->{billingplace} ),
 347             };
 348             foreach(qw(
 349                 basketname author title publishercode collectiontitle notes
 350                 booksellername bookselleraddress booksellerpostal contractname
 351                 basketgroupdeliveryplace basketgroupbillingplace
 352                 basketdeliveryplace basketbillingplace
 353             ) ) {
 354                 # Double the quotes to not be interpreted as a field end
 355                 $row->{$_} =~ s/"/""/g if $row->{$_};
 356             }
 357             push @rows, $row;
 358          }
 359      }
 360     $template->param(rows => \@rows);
 361
 362     return $template->output;
 363
 364 }
 365
 366 =head3 CloseBasketgroup
 367
 368   &CloseBasketgroup($basketgroupno);
 369
 370 close a basketgroup
 371
 372 =cut
 373
 374 sub CloseBasketgroup {
 375     my ($basketgroupno) = @_;
 376     my $dbh        = C4::Context->dbh;
 377     my $sth = $dbh->prepare("
 378         UPDATE aqbasketgroups
 379         SET    closed=1
 380         WHERE  id=?
 381     ");
 382     $sth->execute($basketgroupno);
 383 }
 384
 385 #------------------------------------------------------------#
 386
 387 =head3 ReOpenBaskergroup($basketgroupno)
 388
 389   &ReOpenBaskergroup($basketgroupno);
 390
 391 reopen a basketgroup
 392
 393 =cut
 394
 395 sub ReOpenBasketgroup {
 396     my ($basketgroupno) = @_;
 397     my $dbh        = C4::Context->dbh;
 398     my $sth = $dbh->prepare("
 399         UPDATE aqbasketgroups
 400         SET    closed=0
 401         WHERE  id=?
 402     ");
 403     $sth->execute($basketgroupno);
 404 }
 405
 406 #------------------------------------------------------------#
 407
 408
 409 =head3 DelBasket
 410
 411   &DelBasket($basketno);
 412
 413 Deletes the basket that has basketno field $basketno in the aqbasket table.
 414
 415 =over
 416
 417 =item C<$basketno> is the primary key of the basket in the aqbasket table.
 418
 419 =back
 420
 421 =cut
 422
 423 sub DelBasket {
 424     my ( $basketno ) = @_;
 425     my $query = "DELETE FROM aqbasket WHERE basketno=?";
 426     my $dbh = C4::Context->dbh;
 427     my $sth = $dbh->prepare($query);
 428     $sth->execute($basketno);
 429     $sth->finish;
 430 }
 431
 432 #------------------------------------------------------------#
 433
 434 =head3 ModBasket
 435
 436   &ModBasket($basketinfo);
 437
 438 Modifies a basket, using a hashref $basketinfo for the relevant information, only $basketinfo->{'basketno'} is required.
 439
 440 =over
 441
 442 =item C<$basketno> is the primary key of the basket in the aqbasket table.
 443
 444 =back
 445
 446 =cut
 447
 448 sub ModBasket {
 449     my $basketinfo = shift;
 450     my $query = "UPDATE aqbasket SET ";
 451     my @params;
 452     foreach my $key (keys %$basketinfo){
 453         if ($key ne 'basketno'){
 454             $query .= "$key=?, ";
 455             push(@params, $basketinfo->{$key} || undef );
 456         }
 457     }
 458 # get rid of the "," at the end of $query
 459     if (substr($query, length($query)-2) eq ', '){
 460         chop($query);
 461         chop($query);
 462         $query .= ' ';
 463     }
 464     $query .= "WHERE basketno=?";
 465     push(@params, $basketinfo->{'basketno'});
 466     my $dbh = C4::Context->dbh;
 467     my $sth = $dbh->prepare($query);
 468     $sth->execute(@params);
 469     $sth->finish;
 470 }
 471
 472 #------------------------------------------------------------#
 473
 474 =head3 ModBasketHeader
 475
 476   &ModBasketHeader($basketno, $basketname, $note, $booksellernote, $contractnumber, $booksellerid);
 477
 478 Modifies a basket's header.
 479
 480 =over
 481
 482 =item C<$basketno> is the "basketno" field in the "aqbasket" table;
 483
 484 =item C<$basketname> is the "basketname" field in the "aqbasket" table;
 485
 486 =item C<$note> is the "note" field in the "aqbasket" table;
 487
 488 =item C<$booksellernote> is the "booksellernote" field in the "aqbasket" table;
 489
 490 =item C<$contractnumber> is the "contractnumber" (foreign) key in the "aqbasket" table.
 491
 492 =item C<$booksellerid> is the id (foreign) key in the "aqbooksellers" table for the vendor.
 493
 494 =item C<$deliveryplace> is the "deliveryplace" field in the aqbasket table.
 495
 496 =item C<$billingplace> is the "billingplace" field in the aqbasket table.
 497
 498 =back
 499
 500 =cut
 501
 502 sub ModBasketHeader {
 503     my ($basketno, $basketname, $note, $booksellernote, $contractnumber, $booksellerid, $deliveryplace, $billingplace) = @_;
 504     my $query = qq{
 505         UPDATE aqbasket
 506         SET basketname=?, note=?, booksellernote=?, booksellerid=?, deliveryplace=?, billingplace=?
 507         WHERE basketno=?
 508     };
 509
 510     my $dbh = C4::Context->dbh;
 511     my $sth = $dbh->prepare($query);
 512     $sth->execute($basketname, $note, $booksellernote, $booksellerid, $deliveryplace, $billingplace, $basketno);
 513
 514     if ( $contractnumber ) {
 515         my $query2 ="UPDATE aqbasket SET contractnumber=? WHERE basketno=?";
 516         my $sth2 = $dbh->prepare($query2);
 517         $sth2->execute($contractnumber,$basketno);
 518         $sth2->finish;
 519     }
 520     $sth->finish;
 521 }
 522
 523 #------------------------------------------------------------#
 524
 525 =head3 GetBasketsByBookseller
 526
 527   @results = &GetBasketsByBookseller($booksellerid, $extra);
 528
 529 Returns a list of hashes of all the baskets that belong to bookseller 'booksellerid'.
 530
 531 =over
 532
 533 =item C<$booksellerid> is the 'id' field of the bookseller in the aqbooksellers table
 534
 535 =item C<$extra> is the extra sql parameters, can be
 536
 537  $extra->{groupby}: group baskets by column
 538     ex. $extra->{groupby} = aqbasket.basketgroupid
 539  $extra->{orderby}: order baskets by column
 540  $extra->{limit}: limit number of results (can be helpful for pagination)
 541
 542 =back
 543
 544 =cut
 545
 546 sub GetBasketsByBookseller {
 547     my ($booksellerid, $extra) = @_;
 548     my $query = "SELECT * FROM aqbasket WHERE booksellerid=?";
 549     if ($extra){
 550         if ($extra->{groupby}) {
 551             $query .= " GROUP by $extra->{groupby}";
 552         }
 553         if ($extra->{orderby}){
 554             $query .= " ORDER by $extra->{orderby}";
 555         }
 556         if ($extra->{limit}){
 557             $query .= " LIMIT $extra->{limit}";
 558         }
 559     }
 560     my $dbh = C4::Context->dbh;
 561     my $sth = $dbh->prepare($query);
 562     $sth->execute($booksellerid);
 563     my $results = $sth->fetchall_arrayref({});
 564     $sth->finish;
 565     return $results
 566 }
 567
 568 =head3 GetBasketsInfosByBookseller
 569
 570     my $baskets = GetBasketsInfosByBookseller($supplierid);
 571
 572 Returns in a arrayref of hashref all about booksellers baskets, plus:
 573     total_biblios: Number of distinct biblios in basket
 574     total_items: Number of items in basket
 575     expected_items: Number of non-received items in basket
 576
 577 =cut
 578
 579 sub GetBasketsInfosByBookseller {
 580     my ($supplierid) = @_;
 581
 582     return unless $supplierid;
 583
 584     my $dbh = C4::Context->dbh;
 585     my $query = qq{
 586         SELECT aqbasket.*,
 587           SUM(aqorders.quantity) AS total_items,
 588           COUNT(DISTINCT aqorders.biblionumber) AS total_biblios,
 589           SUM(
 590             IF(aqorders.datereceived IS NULL
 591               AND aqorders.datecancellationprinted IS NULL
 592             , aqorders.quantity
 593             , 0)
 594           ) AS expected_items
 595         FROM aqbasket
 596           LEFT JOIN aqorders ON aqorders.basketno = aqbasket.basketno
 597         WHERE booksellerid = ?
 598         GROUP BY aqbasket.basketno
 599     };
 600     my $sth = $dbh->prepare($query);
 601     $sth->execute($supplierid);
 602     return $sth->fetchall_arrayref({});
 603 }
 604
 605
 606 #------------------------------------------------------------#
 607
 608 =head3 GetBasketsByBasketgroup
 609
 610   $baskets = &GetBasketsByBasketgroup($basketgroupid);
 611
 612 Returns a reference to all baskets that belong to basketgroup $basketgroupid.
 613
 614 =cut
 615
 616 sub GetBasketsByBasketgroup {
 617     my $basketgroupid = shift;
 618     my $query = qq{
 619         SELECT *, aqbasket.booksellerid as booksellerid
 620         FROM aqbasket
 621         LEFT JOIN aqcontract USING(contractnumber) WHERE basketgroupid=?
 622     };
 623     my $dbh = C4::Context->dbh;
 624     my $sth = $dbh->prepare($query);
 625     $sth->execute($basketgroupid);
 626     my $results = $sth->fetchall_arrayref({});
 627     $sth->finish;
 628     return $results
 629 }
 630
 631 #------------------------------------------------------------#
 632
 633 =head3 NewBasketgroup
 634
 635   $basketgroupid = NewBasketgroup(\%hashref);
 636
 637 Adds a basketgroup to the aqbasketgroups table, and add the initial baskets to it.
 638
 639 $hashref->{'booksellerid'} is the 'id' field of the bookseller in the aqbooksellers table,
 640
 641 $hashref->{'name'} is the 'name' field of the basketgroup in the aqbasketgroups table,
 642
 643 $hashref->{'basketlist'} is a list reference of the 'id's of the baskets that belong to this group,
 644
 645 $hashref->{'billingplace'} is the 'billingplace' field of the basketgroup in the aqbasketgroups table,
 646
 647 $hashref->{'deliveryplace'} is the 'deliveryplace' field of the basketgroup in the aqbasketgroups table,
 648
 649 $hashref->{'freedeliveryplace'} is the 'freedeliveryplace' field of the basketgroup in the aqbasketgroups table,
 650
 651 $hashref->{'deliverycomment'} is the 'deliverycomment' field of the basketgroup in the aqbasketgroups table,
 652
 653 $hashref->{'closed'} is the 'closed' field of the aqbasketgroups table, it is false if 0, true otherwise.
 654
 655 =cut
 656
 657 sub NewBasketgroup {
 658     my $basketgroupinfo = shift;
 659     die "booksellerid is required to create a basketgroup" unless $basketgroupinfo->{'booksellerid'};
 660     my $query = "INSERT INTO aqbasketgroups (";
 661     my @params;
 662     foreach my $field (qw(name billingplace deliveryplace freedeliveryplace deliverycomment closed)) {
 663         if ( defined $basketgroupinfo->{$field} ) {
 664             $query .= "$field, ";
 665             push(@params, $basketgroupinfo->{$field});
 666         }
 667     }
 668     $query .= "booksellerid) VALUES (";
 669     foreach (@params) {
 670         $query .= "?, ";
 671     }
 672     $query .= "?)";
 673     push(@params, $basketgroupinfo->{'booksellerid'});
 674     my $dbh = C4::Context->dbh;
 675     my $sth = $dbh->prepare($query);
 676     $sth->execute(@params);
 677     my $basketgroupid = $dbh->{'mysql_insertid'};
 678     if( $basketgroupinfo->{'basketlist'} ) {
 679         foreach my $basketno (@{$basketgroupinfo->{'basketlist'}}) {
 680             my $query2 = "UPDATE aqbasket SET basketgroupid=? WHERE basketno=?";
 681             my $sth2 = $dbh->prepare($query2);
 682             $sth2->execute($basketgroupid, $basketno);
 683         }
 684     }
 685     return $basketgroupid;
 686 }
 687
 688 #------------------------------------------------------------#
 689
 690 =head3 ModBasketgroup
 691
 692   ModBasketgroup(\%hashref);
 693
 694 Modifies a basketgroup in the aqbasketgroups table, and add the baskets to it.
 695
 696 $hashref->{'id'} is the 'id' field of the basketgroup in the aqbasketgroup table, this parameter is mandatory,
 697
 698 $hashref->{'name'} is the 'name' field of the basketgroup in the aqbasketgroups table,
 699
 700 $hashref->{'basketlist'} is a list reference of the 'id's of the baskets that belong to this group,
 701
 702 $hashref->{'billingplace'} is the 'billingplace' field of the basketgroup in the aqbasketgroups table,
 703
 704 $hashref->{'deliveryplace'} is the 'deliveryplace' field of the basketgroup in the aqbasketgroups table,
 705
 706 $hashref->{'freedeliveryplace'} is the 'freedeliveryplace' field of the basketgroup in the aqbasketgroups table,
 707
 708 $hashref->{'deliverycomment'} is the 'deliverycomment' field of the basketgroup in the aqbasketgroups table,
 709
 710 $hashref->{'closed'} is the 'closed' field of the aqbasketgroups table, it is false if 0, true otherwise.
 711
 712 =cut
 713
 714 sub ModBasketgroup {
 715     my $basketgroupinfo = shift;
 716     die "basketgroup id is required to edit a basketgroup" unless $basketgroupinfo->{'id'};
 717     my $dbh = C4::Context->dbh;
 718     my $query = "UPDATE aqbasketgroups SET ";
 719     my @params;
 720     foreach my $field (qw(name billingplace deliveryplace freedeliveryplace deliverycomment closed)) {
 721         if ( defined $basketgroupinfo->{$field} ) {
 722             $query .= "$field=?, ";
 723             push(@params, $basketgroupinfo->{$field});
 724         }
 725     }
 726     chop($query);
 727     chop($query);
 728     $query .= " WHERE id=?";
 729     push(@params, $basketgroupinfo->{'id'});
 730     my $sth = $dbh->prepare($query);
 731     $sth->execute(@params);
 732
 733     $sth = $dbh->prepare('UPDATE aqbasket SET basketgroupid = NULL WHERE basketgroupid = ?');
 734     $sth->execute($basketgroupinfo->{'id'});
 735
 736     if($basketgroupinfo->{'basketlist'} && @{$basketgroupinfo->{'basketlist'}}){
 737         $sth = $dbh->prepare("UPDATE aqbasket SET basketgroupid=? WHERE basketno=?");
 738         foreach my $basketno (@{$basketgroupinfo->{'basketlist'}}) {
 739             $sth->execute($basketgroupinfo->{'id'}, $basketno);
 740             $sth->finish;
 741         }
 742     }
 743     $sth->finish;
 744 }
 745
 746 #------------------------------------------------------------#
 747
 748 =head3 DelBasketgroup
 749
 750   DelBasketgroup($basketgroupid);
 751
 752 Deletes a basketgroup in the aqbasketgroups table, and removes the reference to it from the baskets,
 753
 754 =over
 755
 756 =item C<$basketgroupid> is the 'id' field of the basket in the aqbasketgroup table
 757
 758 =back
 759
 760 =cut
 761
 762 sub DelBasketgroup {
 763     my $basketgroupid = shift;
 764     die "basketgroup id is required to edit a basketgroup" unless $basketgroupid;
 765     my $query = "DELETE FROM aqbasketgroups WHERE id=?";
 766     my $dbh = C4::Context->dbh;
 767     my $sth = $dbh->prepare($query);
 768     $sth->execute($basketgroupid);
 769     $sth->finish;
 770 }
 771
 772 #------------------------------------------------------------#
 773
 774
 775 =head2 FUNCTIONS ABOUT ORDERS
 776
 777 =head3 GetBasketgroup
 778
 779   $basketgroup = &GetBasketgroup($basketgroupid);
 780
 781 Returns a reference to the hash containing all infermation about the basketgroup.
 782
 783 =cut
 784
 785 sub GetBasketgroup {
 786     my $basketgroupid = shift;
 787     die "basketgroup id is required to edit a basketgroup" unless $basketgroupid;
 788     my $query = "SELECT * FROM aqbasketgroups WHERE id=?";
 789     my $dbh = C4::Context->dbh;
 790     my $sth = $dbh->prepare($query);
 791     $sth->execute($basketgroupid);
 792     my $result = $sth->fetchrow_hashref;
 793     $sth->finish;
 794     return $result
 795 }
 796
 797 #------------------------------------------------------------#
 798
 799 =head3 GetBasketgroups
 800
 801   $basketgroups = &GetBasketgroups($booksellerid);
 802
 803 Returns a reference to the array of all the basketgroups of bookseller $booksellerid.
 804
 805 =cut
 806
 807 sub GetBasketgroups {
 808     my $booksellerid = shift;
 809     die 'bookseller id is required to edit a basketgroup' unless $booksellerid;
 810     my $query = 'SELECT * FROM aqbasketgroups WHERE booksellerid=? ORDER BY id DESC';
 811     my $dbh = C4::Context->dbh;
 812     my $sth = $dbh->prepare($query);
 813     $sth->execute($booksellerid);
 814     return $sth->fetchall_arrayref({});
 815 }
 816
 817 #------------------------------------------------------------#
 818
 819 =head2 FUNCTIONS ABOUT ORDERS
 820
 821 =cut
 822
 823 #------------------------------------------------------------#
 824
 825 =head3 GetPendingOrders
 826
 827 $orders = &GetPendingOrders($supplierid,$grouped,$owner,$basketno,$ordernumber,$search,$ean);
 828
 829 Finds pending orders from the bookseller with the given ID. Ignores
 830 completed and cancelled orders.
 831
 832 C<$booksellerid> contains the bookseller identifier
 833 C<$owner> contains 0 or 1. 0 means any owner. 1 means only the list of orders entered by the user itself.
 834 C<$grouped> is a boolean that, if set to 1 will group all order lines of the same basket
 835 in a single result line
 836 C<$orders> is a reference-to-array; each element is a reference-to-hash.
 837
 838 Used also by the filter in parcel.pl
 839 I have added:
 840
 841 C<$ordernumber>
 842 C<$search>
 843 C<$ean>
 844
 845 These give the value of the corresponding field in the aqorders table
 846 of the Koha database.
 847
 848 Results are ordered from most to least recent.
 849
 850 =cut
 851
 852 sub GetPendingOrders {
 853     my ($supplierid,$grouped,$owner,$basketno,$ordernumber,$search,$ean) = @_;
 854     my $dbh = C4::Context->dbh;
 855     my $strsth = "
 856         SELECT ".($grouped?"count(*),":"")."aqbasket.basketno,
 857                surname,firstname,biblio.*,biblioitems.isbn,
 858                aqbasket.closedate, aqbasket.creationdate, aqbasket.basketname,
 859                aqorders.*
 860         FROM aqorders
 861         LEFT JOIN aqbasket ON aqbasket.basketno=aqorders.basketno
 862         LEFT JOIN borrowers ON aqbasket.authorisedby=borrowers.borrowernumber
 863         LEFT JOIN biblio ON biblio.biblionumber=aqorders.biblionumber
 864         LEFT JOIN biblioitems ON biblioitems.biblionumber=biblio.biblionumber
 865         WHERE (quantity > quantityreceived OR quantityreceived is NULL)
 866         AND datecancellationprinted IS NULL";
 867     my @query_params;
 868     my $userenv = C4::Context->userenv;
 869     if ( C4::Context->preference("IndependantBranches") ) {
 870         if ( ($userenv) && ( $userenv->{flags} != 1 ) ) {
 871             $strsth .= " AND (borrowers.branchcode = ?
 872                         or borrowers.branchcode  = '')";
 873             push @query_params, $userenv->{branch};
 874         }
 875     }
 876     if ($supplierid) {
 877         $strsth .= " AND aqbasket.booksellerid = ?";
 878         push @query_params, $supplierid;
 879     }
 880     if($ordernumber){
 881         $strsth .= " AND (aqorders.ordernumber=?)";
 882         push @query_params, $ordernumber;
 883     }
 884     if($search){
 885         $strsth .= " AND (biblio.title like ? OR biblio.author LIKE ? OR biblioitems.isbn like ?)";
 886         push @query_params, ("%$search%","%$search%","%$search%");
 887     }
 888     if ($ean) {
 889         $strsth .= " AND biblioitems.ean = ?";
 890         push @query_params, $ean;
 891     }
 892     if ($basketno) {
 893         $strsth .= " AND aqbasket.basketno=? ";
 894         push @query_params, $basketno;
 895     }
 896     if ($owner) {
 897         $strsth .= " AND aqbasket.authorisedby=? ";
 898         push @query_params, $userenv->{'number'};
 899     }
 900     $strsth .= " group by aqbasket.basketno" if $grouped;
 901     $strsth .= " order by aqbasket.basketno";
 902     my $sth = $dbh->prepare($strsth);
 903     $sth->execute( @query_params );
 904     my $results = $sth->fetchall_arrayref({});
 905     $sth->finish;
 906     return $results;
 907 }
 908
 909 #------------------------------------------------------------#
 910
 911 =head3 GetOrders
 912
 913   @orders = &GetOrders($basketnumber, $orderby);
 914
 915 Looks up the pending (non-cancelled) orders with the given basket
 916 number. If C<$booksellerID> is non-empty, only orders from that seller
 917 are returned.
 918
 919 return :
 920 C<&basket> returns a two-element array. C<@orders> is an array of
 921 references-to-hash, whose keys are the fields from the aqorders,
 922 biblio, and biblioitems tables in the Koha database.
 923
 924 =cut
 925
 926 sub GetOrders {
 927     my ( $basketno, $orderby ) = @_;
 928     my $dbh   = C4::Context->dbh;
 929     my $query  ="
 930         SELECT biblio.*,biblioitems.*,
 931                 aqorders.*,
 932                 aqbudgets.*,
 933                 biblio.title
 934         FROM    aqorders
 935             LEFT JOIN aqbudgets        ON aqbudgets.budget_id = aqorders.budget_id
 936             LEFT JOIN biblio           ON biblio.biblionumber = aqorders.biblionumber
 937             LEFT JOIN biblioitems      ON biblioitems.biblionumber =biblio.biblionumber
 938         WHERE   basketno=?
 939             AND (datecancellationprinted IS NULL OR datecancellationprinted='0000-00-00')
 940     ";
 941
 942     $orderby = "biblioitems.publishercode,biblio.title" unless $orderby;
 943     $query .= " ORDER BY $orderby";
 944     my $sth = $dbh->prepare($query);
 945     $sth->execute($basketno);
 946     my $results = $sth->fetchall_arrayref({});
 947     $sth->finish;
 948     return @$results;
 949 }
 950
 951 #------------------------------------------------------------#
 952 =head3 GetOrdersByBiblionumber
 953
 954   @orders = &GetOrdersByBiblionumber($biblionumber);
 955
 956 Looks up the orders with linked to a specific $biblionumber, including
 957 cancelled orders and received orders.
 958
 959 return :
 960 C<@orders> is an array of references-to-hash, whose keys are the
 961 fields from the aqorders, biblio, and biblioitems tables in the Koha database.
 962
 963 =cut
 964
 965 sub GetOrdersByBiblionumber {
 966     my $biblionumber = shift;
 967     return unless $biblionumber;
 968     my $dbh   = C4::Context->dbh;
 969     my $query  ="
 970         SELECT biblio.*,biblioitems.*,
 971                 aqorders.*,
 972                 aqbudgets.*
 973         FROM    aqorders
 974             LEFT JOIN aqbudgets        ON aqbudgets.budget_id = aqorders.budget_id
 975             LEFT JOIN biblio           ON biblio.biblionumber = aqorders.biblionumber
 976             LEFT JOIN biblioitems      ON biblioitems.biblionumber =biblio.biblionumber
 977         WHERE   aqorders.biblionumber=?
 978     ";
 979     my $sth = $dbh->prepare($query);
 980     $sth->execute($biblionumber);
 981     my $results = $sth->fetchall_arrayref({});
 982     $sth->finish;
 983     return @$results;
 984 }
 985
 986 #------------------------------------------------------------#
 987
 988 =head3 GetOrderNumber
 989
 990   $ordernumber = &GetOrderNumber($biblioitemnumber, $biblionumber);
 991
 992 Looks up the ordernumber with the given biblionumber and biblioitemnumber.
 993
 994 Returns the number of this order.
 995
 996 =over
 997
 998 =item C<$ordernumber> is the order number.
 999
1000 =back
1001
1002 =cut
1003
1004 sub GetOrderNumber {
1005     my ( $biblionumber,$biblioitemnumber ) = @_;
1006     my $dbh = C4::Context->dbh;
1007     my $query = "
1008         SELECT ordernumber
1009         FROM   aqorders
1010         WHERE  biblionumber=?
1011         AND    biblioitemnumber=?
1012     ";
1013     my $sth = $dbh->prepare($query);
1014     $sth->execute( $biblionumber, $biblioitemnumber );
1015
1016     return $sth->fetchrow;
1017 }
1018
1019 #------------------------------------------------------------#
1020
1021 =head3 GetOrder
1022
1023   $order = &GetOrder($ordernumber);
1024
1025 Looks up an order by order number.
1026
1027 Returns a reference-to-hash describing the order. The keys of
1028 C<$order> are fields from the biblio, biblioitems, aqorders tables of the Koha database.
1029
1030 =cut
1031
1032 sub GetOrder {
1033     my ($ordernumber) = @_;
1034     my $dbh      = C4::Context->dbh;
1035     my $query = "
1036         SELECT biblioitems.*, biblio.*, aqorders.*
1037         FROM   aqorders
1038         LEFT JOIN biblio on           biblio.biblionumber=aqorders.biblionumber
1039         LEFT JOIN biblioitems on       biblioitems.biblionumber=aqorders.biblionumber
1040         WHERE aqorders.ordernumber=?
1041
1042     ";
1043     my $sth= $dbh->prepare($query);
1044     $sth->execute($ordernumber);
1045     my $data = $sth->fetchrow_hashref;
1046     $sth->finish;
1047     return $data;
1048 }
1049
1050 =head3 GetLastOrderNotReceivedFromSubscriptionid
1051
1052   $order = &GetLastOrderNotReceivedFromSubscriptionid($subscriptionid);
1053
1054 Returns a reference-to-hash describing the last order not received for a subscription.
1055
1056 =cut
1057
1058 sub GetLastOrderNotReceivedFromSubscriptionid {
1059     my ( $subscriptionid ) = @_;
1060     my $dbh                = C4::Context->dbh;
1061     my $query              = qq|
1062         SELECT * FROM aqorders
1063         LEFT JOIN subscription
1064             ON ( aqorders.subscriptionid = subscription.subscriptionid )
1065         WHERE aqorders.subscriptionid = ?
1066             AND aqorders.datereceived IS NULL
1067         LIMIT 1
1068     |;
1069     my $sth = $dbh->prepare( $query );
1070     $sth->execute( $subscriptionid );
1071     my $order = $sth->fetchrow_hashref;
1072     return $order;
1073 }
1074
1075 =head3 GetLastOrderReceivedFromSubscriptionid
1076
1077   $order = &GetLastOrderReceivedFromSubscriptionid($subscriptionid);
1078
1079 Returns a reference-to-hash describing the last order received for a subscription.
1080
1081 =cut
1082
1083 sub GetLastOrderReceivedFromSubscriptionid {
1084     my ( $subscriptionid ) = @_;
1085     my $dbh                = C4::Context->dbh;
1086     my $query              = qq|
1087         SELECT * FROM aqorders
1088         LEFT JOIN subscription
1089             ON ( aqorders.subscriptionid = subscription.subscriptionid )
1090         WHERE aqorders.subscriptionid = ?
1091             AND aqorders.datereceived =
1092                 (
1093                     SELECT MAX( aqorders.datereceived )
1094                     FROM aqorders
1095                     LEFT JOIN subscription
1096                         ON ( aqorders.subscriptionid = subscription.subscriptionid )
1097                         WHERE aqorders.subscriptionid = ?
1098                             AND aqorders.datereceived IS NOT NULL
1099                 )
1100         ORDER BY ordernumber DESC
1101         LIMIT 1
1102     |;
1103     my $sth = $dbh->prepare( $query );
1104     $sth->execute( $subscriptionid, $subscriptionid );
1105     my $order = $sth->fetchrow_hashref;
1106     return $order;
1107
1108 }
1109
1110
1111 #------------------------------------------------------------#
1112
1113 =head3 NewOrder
1114
1115   &NewOrder(\%hashref);
1116
1117 Adds a new order to the database. Any argument that isn't described
1118 below is the new value of the field with the same name in the aqorders
1119 table of the Koha database.
1120
1121 =over
1122
1123 =item $hashref->{'basketno'} is the basketno foreign key in aqorders, it is mandatory
1124
1125 =item $hashref->{'ordernumber'} is a "minimum order number."
1126
1127 =item $hashref->{'budgetdate'} is effectively ignored.
1128 If it's undef (anything false) or the string 'now', the current day is used.
1129 Else, the upcoming July 1st is used.
1130
1131 =item $hashref->{'subscription'} may be either "yes", or anything else for "no".
1132
1133 =item $hashref->{'uncertainprice'} may be 0 for "the price is known" or 1 for "the price is uncertain"
1134
1135 =item defaults entrydate to Now
1136
1137 The following keys are used: "biblionumber", "title", "basketno", "quantity", "notes", "biblioitemnumber", "rrp", "ecost", "gstrate", "unitprice", "subscription", "sort1", "sort2", "booksellerinvoicenumber", "listprice", "budgetdate", "purchaseordernumber", "branchcode", "booksellerinvoicenumber", "budget_id".
1138
1139 =back
1140
1141 =cut
1142
1143 sub NewOrder {
1144     my $orderinfo = shift;
1145 #### ------------------------------
1146     my $dbh = C4::Context->dbh;
1147     my @params;
1148
1149
1150     # if these parameters are missing, we can't continue
1151     for my $key (qw/basketno quantity biblionumber budget_id/) {
1152         croak "Mandatory parameter $key missing" unless $orderinfo->{$key};
1153     }
1154
1155     if ( defined $orderinfo->{subscription} && $orderinfo->{'subscription'} eq 'yes' ) {
1156         $orderinfo->{'subscription'} = 1;
1157     } else {
1158         $orderinfo->{'subscription'} = 0;
1159     }
1160     $orderinfo->{'entrydate'} ||= C4::Dates->new()->output("iso");
1161     if (!$orderinfo->{quantityreceived}) {
1162         $orderinfo->{quantityreceived} = 0;
1163     }
1164
1165     my $ordernumber=InsertInTable("aqorders",$orderinfo);
1166     if (not $orderinfo->{parent_ordernumber}) {
1167         my $sth = $dbh->prepare("
1168             UPDATE aqorders
1169             SET parent_ordernumber = ordernumber
1170             WHERE ordernumber = ?
1171         ");
1172         $sth->execute($ordernumber);
1173     }
1174     return ( $orderinfo->{'basketno'}, $ordernumber );
1175 }
1176
1177
1178
1179 #------------------------------------------------------------#
1180
1181 =head3 NewOrderItem
1182
1183   &NewOrderItem();
1184
1185 =cut
1186
1187 sub NewOrderItem {
1188     my ($itemnumber, $ordernumber)  = @_;
1189     my $dbh = C4::Context->dbh;
1190     my $query = qq|
1191             INSERT INTO aqorders_items
1192                 (itemnumber, ordernumber)
1193             VALUES (?,?)    |;
1194
1195     my $sth = $dbh->prepare($query);
1196     $sth->execute( $itemnumber, $ordernumber);
1197 }
1198
1199 #------------------------------------------------------------#
1200
1201 =head3 ModOrder
1202
1203   &ModOrder(\%hashref);
1204
1205 Modifies an existing order. Updates the order with order number
1206 $hashref->{'ordernumber'} and biblionumber $hashref->{'biblionumber'}. All
1207 other keys of the hash update the fields with the same name in the aqorders
1208 table of the Koha database.
1209
1210 =cut
1211
1212 sub ModOrder {
1213     my $orderinfo = shift;
1214
1215     die "Ordernumber is required"     if $orderinfo->{'ordernumber'} eq  '' ;
1216     die "Biblionumber is required"  if  $orderinfo->{'biblionumber'} eq '';
1217
1218     my $dbh = C4::Context->dbh;
1219     my @params;
1220
1221     # update uncertainprice to an integer, just in case (under FF, checked boxes have the value "ON" by default)
1222     $orderinfo->{uncertainprice}=1 if $orderinfo->{uncertainprice};
1223
1224 #    delete($orderinfo->{'branchcode'});
1225     # the hash contains a lot of entries not in aqorders, so get the columns ...
1226     my $sth = $dbh->prepare("SELECT * FROM aqorders LIMIT 1;");
1227     $sth->execute;
1228     my $colnames = $sth->{NAME};
1229         #FIXME Be careful. If aqorders would have columns with diacritics,
1230         #you should need to decode what you get back from NAME.
1231         #See report 10110 and guided_reports.pl
1232     my $query = "UPDATE aqorders SET ";
1233
1234     foreach my $orderinfokey (grep(!/ordernumber/, keys %$orderinfo)){
1235         # ... and skip hash entries that are not in the aqorders table
1236         # FIXME : probably not the best way to do it (would be better to have a correct hash)
1237         next unless grep(/^$orderinfokey$/, @$colnames);
1238             $query .= "$orderinfokey=?, ";
1239             push(@params, $orderinfo->{$orderinfokey});
1240     }
1241
1242     $query .= "timestamp=NOW()  WHERE  ordernumber=?";
1243 #   push(@params, $specorderinfo{'ordernumber'});
1244     push(@params, $orderinfo->{'ordernumber'} );
1245     $sth = $dbh->prepare($query);
1246     $sth->execute(@params);
1247     $sth->finish;
1248 }
1249
1250 #------------------------------------------------------------#
1251
1252 =head3 ModOrderItem
1253
1254   &ModOrderItem(\%hashref);
1255
1256 Modifies the itemnumber in the aqorders_items table. The input hash needs three entities:
1257
1258 =over
1259
1260 =item - itemnumber: the old itemnumber
1261 =item - ordernumber: the order this item is attached to
1262 =item - newitemnumber: the new itemnumber we want to attach the line to
1263
1264 =back
1265
1266 =cut
1267
1268 sub ModOrderItem {
1269     my $orderiteminfo = shift;
1270     if (! $orderiteminfo->{'ordernumber'} || ! $orderiteminfo->{'itemnumber'} || ! $orderiteminfo->{'newitemnumber'}){
1271         die "Ordernumber, itemnumber and newitemnumber is required";
1272     }
1273
1274     my $dbh = C4::Context->dbh;
1275
1276     my $query = "UPDATE aqorders_items set itemnumber=? where itemnumber=? and ordernumber=?";
1277     my @params = ($orderiteminfo->{'newitemnumber'}, $orderiteminfo->{'itemnumber'}, $orderiteminfo->{'ordernumber'});
1278     my $sth = $dbh->prepare($query);
1279     $sth->execute(@params);
1280     return 0;
1281 }
1282
1283 =head3 ModItemOrder
1284
1285     ModItemOrder($itemnumber, $ordernumber);
1286
1287 Modifies the ordernumber of an item in aqorders_items.
1288
1289 =cut
1290
1291 sub ModItemOrder {
1292     my ($itemnumber, $ordernumber) = @_;
1293
1294     return unless ($itemnumber and $ordernumber);
1295
1296     my $dbh = C4::Context->dbh;
1297     my $query = qq{
1298         UPDATE aqorders_items
1299         SET ordernumber = ?
1300         WHERE itemnumber = ?
1301     };
1302     my $sth = $dbh->prepare($query);
1303     return $sth->execute($ordernumber, $itemnumber);
1304 }
1305
1306 #------------------------------------------------------------#
1307
1308
1309 =head3 ModOrderBibliotemNumber
1310
1311   &ModOrderBiblioitemNumber($biblioitemnumber,$ordernumber, $biblionumber);
1312
1313 Modifies the biblioitemnumber for an existing order.
1314 Updates the order with order number C<$ordernum> and biblionumber C<$biblionumber>.
1315
1316 =cut
1317
1318 #FIXME: is this used at all?
1319 sub ModOrderBiblioitemNumber {
1320     my ($biblioitemnumber,$ordernumber, $biblionumber) = @_;
1321     my $dbh = C4::Context->dbh;
1322     my $query = "
1323     UPDATE aqorders
1324     SET    biblioitemnumber = ?
1325     WHERE  ordernumber = ?
1326     AND biblionumber =  ?";
1327     my $sth = $dbh->prepare($query);
1328     $sth->execute( $biblioitemnumber, $ordernumber, $biblionumber );
1329 }
1330
1331 =head3 GetCancelledOrders
1332
1333   my @orders = GetCancelledOrders($basketno, $orderby);
1334
1335 Returns cancelled orders for a basket
1336
1337 =cut
1338
1339 sub GetCancelledOrders {
1340     my ( $basketno, $orderby ) = @_;
1341
1342     return () unless $basketno;
1343
1344     my $dbh   = C4::Context->dbh;
1345     my $query = "
1346         SELECT biblio.*, biblioitems.*, aqorders.*, aqbudgets.*
1347         FROM aqorders
1348           LEFT JOIN aqbudgets   ON aqbudgets.budget_id = aqorders.budget_id
1349           LEFT JOIN biblio      ON biblio.biblionumber = aqorders.biblionumber
1350           LEFT JOIN biblioitems ON biblioitems.biblionumber = biblio.biblionumber
1351         WHERE basketno = ?
1352           AND (datecancellationprinted IS NOT NULL
1353                AND datecancellationprinted <> '0000-00-00')
1354     ";
1355
1356     $orderby = "aqorders.datecancellationprinted desc, aqorders.timestamp desc"
1357         unless $orderby;
1358     $query .= " ORDER BY $orderby";
1359     my $sth = $dbh->prepare($query);
1360     $sth->execute($basketno);
1361     my $results = $sth->fetchall_arrayref( {} );
1362
1363     return @$results;
1364 }
1365
1366
1367 #------------------------------------------------------------#
1368
1369 =head3 ModReceiveOrder
1370
1371   &ModReceiveOrder($biblionumber, $ordernumber, $quantityreceived, $user,
1372     $unitprice, $invoiceid, $biblioitemnumber,
1373     $bookfund, $rrp, \@received_itemnumbers);
1374
1375 Updates an order, to reflect the fact that it was received, at least
1376 in part. All arguments not mentioned below update the fields with the
1377 same name in the aqorders table of the Koha database.
1378
1379 If a partial order is received, splits the order into two.
1380
1381 Updates the order with bibilionumber C<$biblionumber> and ordernumber
1382 C<$ordernumber>.
1383
1384 =cut
1385
1386
1387 sub ModReceiveOrder {
1388     my (
1389         $biblionumber,    $ordernumber,  $quantrec, $user, $cost, $ecost,
1390         $invoiceid, $rrp, $budget_id, $datereceived, $received_items
1391     )
1392     = @_;
1393
1394     my $dbh = C4::Context->dbh;
1395     $datereceived = C4::Dates->output('iso') unless $datereceived;
1396     my $suggestionid = GetSuggestionFromBiblionumber( $biblionumber );
1397     if ($suggestionid) {
1398         ModSuggestion( {suggestionid=>$suggestionid,
1399                         STATUS=>'AVAILABLE',
1400                         biblionumber=> $biblionumber}
1401                         );
1402     }
1403
1404     my $sth=$dbh->prepare("
1405         SELECT * FROM   aqorders
1406         WHERE           biblionumber=? AND aqorders.ordernumber=?");
1407
1408     $sth->execute($biblionumber,$ordernumber);
1409     my $order = $sth->fetchrow_hashref();
1410     $sth->finish();
1411
1412     my $new_ordernumber = $ordernumber;
1413     if ( $order->{quantity} > $quantrec ) {
1414         # Split order line in two parts: the first is the original order line
1415         # without received items (the quantity is decreased),
1416         # the second part is a new order line with quantity=quantityrec
1417         # (entirely received)
1418         $sth=$dbh->prepare("
1419             UPDATE aqorders
1420             SET quantity = ?
1421             WHERE ordernumber = ?
1422         ");
1423
1424         $sth->execute($order->{quantity} - $quantrec, $ordernumber);
1425
1426         $sth->finish;
1427
1428         delete $order->{'ordernumber'};
1429         $order->{'quantity'} = $quantrec;
1430         $order->{'quantityreceived'} = $quantrec;
1431         $order->{'datereceived'} = $datereceived;
1432         $order->{'invoiceid'} = $invoiceid;
1433         $order->{'unitprice'} = $cost;
1434         $order->{'rrp'} = $rrp;
1435         $order->{ecost} = $ecost;
1436         $order->{'orderstatus'} = 3;    # totally received
1437         $new_ordernumber = NewOrder($order);
1438
1439         if ($received_items) {
1440             foreach my $itemnumber (@$received_items) {
1441                 ModItemOrder($itemnumber, $new_ordernumber);
1442             }
1443         }
1444     } else {
1445         $sth=$dbh->prepare("update aqorders
1446                             set quantityreceived=?,datereceived=?,invoiceid=?,
1447                                 unitprice=?,rrp=?,ecost=?
1448                             where biblionumber=? and ordernumber=?");
1449         $sth->execute($quantrec,$datereceived,$invoiceid,$cost,$rrp,$ecost,$biblionumber,$ordernumber);
1450         $sth->finish;
1451     }
1452     return ($datereceived, $new_ordernumber);
1453 }
1454
1455 =head3 CancelReceipt
1456
1457     my $parent_ordernumber = CancelReceipt($ordernumber);
1458
1459     Cancel an order line receipt and update the parent order line, as if no
1460     receipt was made.
1461     If items are created at receipt (AcqCreateItem = receiving) then delete
1462     these items.
1463
1464 =cut
1465
1466 sub CancelReceipt {
1467     my $ordernumber = shift;
1468
1469     return unless $ordernumber;
1470
1471     my $dbh = C4::Context->dbh;
1472     my $query = qq{
1473         SELECT datereceived, parent_ordernumber, quantity
1474         FROM aqorders
1475         WHERE ordernumber = ?
1476     };
1477     my $sth = $dbh->prepare($query);
1478     $sth->execute($ordernumber);
1479     my $order = $sth->fetchrow_hashref;
1480     unless($order) {
1481         warn "CancelReceipt: order $ordernumber does not exist";
1482         return;
1483     }
1484     unless($order->{'datereceived'}) {
1485         warn "CancelReceipt: order $ordernumber is not received";
1486         return;
1487     }
1488
1489     my $parent_ordernumber = $order->{'parent_ordernumber'};
1490
1491     if($parent_ordernumber == $ordernumber || not $parent_ordernumber) {
1492         # The order line has no parent, just mark it as not received
1493         $query = qq{
1494             UPDATE aqorders
1495             SET quantityreceived = ?,
1496                 datereceived = ?,
1497                 invoiceid = ?
1498             WHERE ordernumber = ?
1499         };
1500         $sth = $dbh->prepare($query);
1501         $sth->execute(0, undef, undef, $ordernumber);
1502     } else {
1503         # The order line has a parent, increase parent quantity and delete
1504         # the order line.
1505         $query = qq{
1506             SELECT quantity, datereceived
1507             FROM aqorders
1508             WHERE ordernumber = ?
1509         };
1510         $sth = $dbh->prepare($query);
1511         $sth->execute($parent_ordernumber);
1512         my $parent_order = $sth->fetchrow_hashref;
1513         unless($parent_order) {
1514             warn "Parent order $parent_ordernumber does not exist.";
1515             return;
1516         }
1517         if($parent_order->{'datereceived'}) {
1518             warn "CancelReceipt: parent order is received.".
1519                 " Can't cancel receipt.";
1520             return;
1521         }
1522         $query = qq{
1523             UPDATE aqorders
1524             SET quantity = ?
1525             WHERE ordernumber = ?
1526         };
1527         $sth = $dbh->prepare($query);
1528         my $rv = $sth->execute(
1529             $order->{'quantity'} + $parent_order->{'quantity'},
1530             $parent_ordernumber
1531         );
1532         unless($rv) {
1533             warn "Cannot update parent order line, so do not cancel".
1534                 " receipt";
1535             return;
1536         }
1537         if(C4::Context->preference('AcqCreateItem') eq 'receiving') {
1538             # Remove items that were created at receipt
1539             $query = qq{
1540                 DELETE FROM items, aqorders_items
1541                 USING items, aqorders_items
1542                 WHERE items.itemnumber = ? AND aqorders_items.itemnumber = ?
1543             };
1544             $sth = $dbh->prepare($query);
1545             my @itemnumbers = GetItemnumbersFromOrder($ordernumber);
1546             foreach my $itemnumber (@itemnumbers) {
1547                 $sth->execute($itemnumber, $itemnumber);
1548             }
1549         } else {
1550             # Update items
1551             my @itemnumbers = GetItemnumbersFromOrder($ordernumber);
1552             foreach my $itemnumber (@itemnumbers) {
1553                 ModItemOrder($itemnumber, $parent_ordernumber);
1554             }
1555         }
1556         # Delete order line
1557         $query = qq{
1558             DELETE FROM aqorders
1559             WHERE ordernumber = ?
1560         };
1561         $sth = $dbh->prepare($query);
1562         $sth->execute($ordernumber);
1563
1564     }
1565
1566     return $parent_ordernumber;
1567 }
1568
1569 #------------------------------------------------------------#
1570
1571 =head3 SearchOrder
1572
1573 @results = &SearchOrder($search, $biblionumber, $complete);
1574
1575 Searches for orders.
1576
1577 C<$search> may take one of several forms: if it is an ISBN,
1578 C<&ordersearch> returns orders with that ISBN. If C<$search> is an
1579 order number, C<&ordersearch> returns orders with that order number
1580 and biblionumber C<$biblionumber>. Otherwise, C<$search> is considered
1581 to be a space-separated list of search terms; in this case, all of the
1582 terms must appear in the title (matching the beginning of title
1583 words).
1584
1585 If C<$complete> is C<yes>, the results will include only completed
1586 orders. In any case, C<&ordersearch> ignores cancelled orders.
1587
1588 C<&ordersearch> returns an array.
1589 C<@results> is an array of references-to-hash with the following keys:
1590
1591 =over 4
1592
1593 =item C<author>
1594
1595 =item C<seriestitle>
1596
1597 =item C<branchcode>
1598
1599 =item C<budget_id>
1600
1601 =back
1602
1603 =cut
1604
1605 sub SearchOrder {
1606 #### -------- SearchOrder-------------------------------
1607     my ( $ordernumber, $search, $ean, $supplierid, $basket ) = @_;
1608
1609     my $dbh = C4::Context->dbh;
1610     my @args = ();
1611     my $query =
1612             "SELECT *
1613             FROM aqorders
1614             LEFT JOIN biblio ON aqorders.biblionumber=biblio.biblionumber
1615             LEFT JOIN biblioitems ON biblioitems.biblionumber=biblio.biblionumber
1616             LEFT JOIN aqbasket ON aqorders.basketno = aqbasket.basketno
1617                 WHERE  (datecancellationprinted is NULL)";
1618
1619     if($ordernumber){
1620         $query .= " AND (aqorders.ordernumber=?)";
1621         push @args, $ordernumber;
1622     }
1623     if($search){
1624         $query .= " AND (biblio.title like ? OR biblio.author LIKE ? OR biblioitems.isbn like ?)";
1625         push @args, ("%$search%","%$search%","%$search%");
1626     }
1627     if ($ean) {
1628         $query .= " AND biblioitems.ean = ?";
1629         push @args, $ean;
1630     }
1631     if ($supplierid) {
1632         $query .= "AND aqbasket.booksellerid = ?";
1633         push @args, $supplierid;
1634     }
1635     if($basket){
1636         $query .= "AND aqorders.basketno = ?";
1637         push @args, $basket;
1638     }
1639
1640     my $sth = $dbh->prepare($query);
1641     $sth->execute(@args);
1642     my $results = $sth->fetchall_arrayref({});
1643     $sth->finish;
1644     return $results;
1645 }
1646
1647 #------------------------------------------------------------#
1648
1649 =head3 DelOrder
1650
1651   &DelOrder($biblionumber, $ordernumber);
1652
1653 Cancel the order with the given order and biblio numbers. It does not
1654 delete any entries in the aqorders table, it merely marks them as
1655 cancelled.
1656
1657 =cut
1658
1659 sub DelOrder {
1660     my ( $bibnum, $ordernumber ) = @_;
1661     my $dbh = C4::Context->dbh;
1662     my $query = "
1663         UPDATE aqorders
1664         SET    datecancellationprinted=now()
1665         WHERE  biblionumber=? AND ordernumber=?
1666     ";
1667     my $sth = $dbh->prepare($query);
1668     $sth->execute( $bibnum, $ordernumber );
1669     $sth->finish;
1670     my @itemnumbers = GetItemnumbersFromOrder( $ordernumber );
1671     foreach my $itemnumber (@itemnumbers){
1672         C4::Items::DelItem( $dbh, $bibnum, $itemnumber );
1673     }
1674
1675 }
1676
1677 =head2 FUNCTIONS ABOUT PARCELS
1678
1679 =cut
1680
1681 #------------------------------------------------------------#
1682
1683 =head3 GetParcel
1684
1685   @results = &GetParcel($booksellerid, $code, $date);
1686
1687 Looks up all of the received items from the supplier with the given
1688 bookseller ID at the given date, for the given code (bookseller Invoice number). Ignores cancelled and completed orders.
1689
1690 C<@results> is an array of references-to-hash. The keys of each element are fields from
1691 the aqorders, biblio, and biblioitems tables of the Koha database.
1692
1693 C<@results> is sorted alphabetically by book title.
1694
1695 =cut
1696
1697 sub GetParcel {
1698     #gets all orders from a certain supplier, orders them alphabetically
1699     my ( $supplierid, $code, $datereceived ) = @_;
1700     my $dbh     = C4::Context->dbh;
1701     my @results = ();
1702     $code .= '%'
1703     if $code;  # add % if we search on a given code (otherwise, let him empty)
1704     my $strsth ="
1705         SELECT  authorisedby,
1706                 creationdate,
1707                 aqbasket.basketno,
1708                 closedate,surname,
1709                 firstname,
1710                 aqorders.biblionumber,
1711                 aqorders.ordernumber,
1712                 aqorders.parent_ordernumber,
1713                 aqorders.quantity,
1714                 aqorders.quantityreceived,
1715                 aqorders.unitprice,
1716                 aqorders.listprice,
1717                 aqorders.rrp,
1718                 aqorders.ecost,
1719                 aqorders.gstrate,
1720                 biblio.title
1721         FROM aqorders
1722         LEFT JOIN aqbasket ON aqbasket.basketno=aqorders.basketno
1723         LEFT JOIN borrowers ON aqbasket.authorisedby=borrowers.borrowernumber
1724         LEFT JOIN biblio ON aqorders.biblionumber=biblio.biblionumber
1725         LEFT JOIN aqinvoices ON aqorders.invoiceid = aqinvoices.invoiceid
1726         WHERE
1727             aqbasket.booksellerid = ?
1728             AND aqinvoices.invoicenumber LIKE ?
1729             AND aqorders.datereceived = ? ";
1730
1731     my @query_params = ( $supplierid, $code, $datereceived );
1732     if ( C4::Context->preference("IndependantBranches") ) {
1733         my $userenv = C4::Context->userenv;
1734         if ( ($userenv) && ( $userenv->{flags} != 1 ) ) {
1735             $strsth .= " and (borrowers.branchcode = ?
1736                         or borrowers.branchcode  = '')";
1737             push @query_params, $userenv->{branch};
1738         }
1739     }
1740     $strsth .= " ORDER BY aqbasket.basketno";
1741     # ## parcelinformation : $strsth
1742     my $sth = $dbh->prepare($strsth);
1743     $sth->execute( @query_params );
1744     while ( my $data = $sth->fetchrow_hashref ) {
1745         push( @results, $data );
1746     }
1747     # ## countparcelbiblio: scalar(@results)
1748     $sth->finish;
1749
1750     return @results;
1751 }
1752
1753 #------------------------------------------------------------#
1754
1755 =head3 GetParcels
1756
1757   $results = &GetParcels($bookseller, $order, $code, $datefrom, $dateto);
1758
1759 get a lists of parcels.
1760
1761 * Input arg :
1762
1763 =over
1764
1765 =item $bookseller
1766 is the bookseller this function has to get parcels.
1767
1768 =item $order
1769 To know on what criteria the results list has to be ordered.
1770
1771 =item $code
1772 is the booksellerinvoicenumber.
1773
1774 =item $datefrom & $dateto
1775 to know on what date this function has to filter its search.
1776
1777 =back
1778
1779 * return:
1780 a pointer on a hash list containing parcel informations as such :
1781
1782 =over
1783
1784 =item Creation date
1785
1786 =item Last operation
1787
1788 =item Number of biblio
1789
1790 =item Number of items
1791
1792 =back
1793
1794 =cut
1795
1796 sub GetParcels {
1797     my ($bookseller,$order, $code, $datefrom, $dateto) = @_;
1798     my $dbh    = C4::Context->dbh;
1799     my @query_params = ();
1800     my $strsth ="
1801         SELECT  aqinvoices.invoicenumber,
1802                 datereceived,purchaseordernumber,
1803                 count(DISTINCT biblionumber) AS biblio,
1804                 sum(quantity) AS itemsexpected,
1805                 sum(quantityreceived) AS itemsreceived
1806         FROM   aqorders LEFT JOIN aqbasket ON aqbasket.basketno = aqorders.basketno
1807         LEFT JOIN aqinvoices ON aqorders.invoiceid = aqinvoices.invoiceid
1808         WHERE aqbasket.booksellerid = ? and datereceived IS NOT NULL
1809     ";
1810     push @query_params, $bookseller;
1811
1812     if ( defined $code ) {
1813         $strsth .= ' and aqinvoices.invoicenumber like ? ';
1814         # add a % to the end of the code to allow stemming.
1815         push @query_params, "$code%";
1816     }
1817
1818     if ( defined $datefrom ) {
1819         $strsth .= ' and datereceived >= ? ';
1820         push @query_params, $datefrom;
1821     }
1822
1823     if ( defined $dateto ) {
1824         $strsth .=  'and datereceived <= ? ';
1825         push @query_params, $dateto;
1826     }
1827
1828     $strsth .= "group by aqinvoices.invoicenumber,datereceived ";
1829
1830     # can't use a placeholder to place this column name.
1831     # but, we could probably be checking to make sure it is a column that will be fetched.
1832     $strsth .= "order by $order " if ($order);
1833
1834     my $sth = $dbh->prepare($strsth);
1835
1836     $sth->execute( @query_params );
1837     my $results = $sth->fetchall_arrayref({});
1838     $sth->finish;
1839     return @$results;
1840 }
1841
1842 #------------------------------------------------------------#
1843
1844 =head3 GetLateOrders
1845
1846   @results = &GetLateOrders;
1847
1848 Searches for bookseller with late orders.
1849
1850 return:
1851 the table of supplier with late issues. This table is full of hashref.
1852
1853 =cut
1854
1855 sub GetLateOrders {
1856     my $delay      = shift;
1857     my $supplierid = shift;
1858     my $branch     = shift;
1859     my $estimateddeliverydatefrom = shift;
1860     my $estimateddeliverydateto = shift;
1861
1862     my $dbh = C4::Context->dbh;
1863
1864     #BEWARE, order of parenthesis and LEFT JOIN is important for speed
1865     my $dbdriver = C4::Context->config("db_scheme") || "mysql";
1866
1867     my @query_params = ();
1868     my $select = "
1869     SELECT aqbasket.basketno,
1870         aqorders.ordernumber,
1871         DATE(aqbasket.closedate)  AS orderdate,
1872         aqorders.rrp              AS unitpricesupplier,
1873         aqorders.ecost            AS unitpricelib,
1874         aqorders.claims_count     AS claims_count,
1875         aqorders.claimed_date     AS claimed_date,
1876         aqbudgets.budget_name     AS budget,
1877         borrowers.branchcode      AS branch,
1878         aqbooksellers.name        AS supplier,
1879         aqbooksellers.id          AS supplierid,
1880         biblio.author, biblio.title,
1881         biblioitems.publishercode AS publisher,
1882         biblioitems.publicationyear,
1883         ADDDATE(aqbasket.closedate, INTERVAL aqbooksellers.deliverytime DAY) AS estimateddeliverydate,
1884     ";
1885     my $from = "
1886     FROM
1887         aqorders LEFT JOIN biblio     ON biblio.biblionumber         = aqorders.biblionumber
1888         LEFT JOIN biblioitems         ON biblioitems.biblionumber    = biblio.biblionumber
1889         LEFT JOIN aqbudgets           ON aqorders.budget_id          = aqbudgets.budget_id,
1890         aqbasket LEFT JOIN borrowers  ON aqbasket.authorisedby       = borrowers.borrowernumber
1891         LEFT JOIN aqbooksellers       ON aqbasket.booksellerid       = aqbooksellers.id
1892         WHERE aqorders.basketno = aqbasket.basketno
1893         AND ( datereceived = ''
1894             OR datereceived IS NULL
1895             OR aqorders.quantityreceived < aqorders.quantity
1896         )
1897         AND aqbasket.closedate IS NOT NULL
1898         AND (aqorders.datecancellationprinted IS NULL OR aqorders.datecancellationprinted='0000-00-00')
1899     ";
1900     my $having = "";
1901     if ($dbdriver eq "mysql") {
1902         $select .= "
1903         aqorders.quantity - COALESCE(aqorders.quantityreceived,0)                 AS quantity,
1904         (aqorders.quantity - COALESCE(aqorders.quantityreceived,0)) * aqorders.rrp AS subtotal,
1905         DATEDIFF(CAST(now() AS date),closedate) AS latesince
1906         ";
1907         if ( defined $delay ) {
1908             $from .= " AND (closedate <= DATE_SUB(CAST(now() AS date),INTERVAL ? DAY)) " ;
1909             push @query_params, $delay;
1910         }
1911         $having = "
1912         HAVING quantity          <> 0
1913             AND unitpricesupplier <> 0
1914             AND unitpricelib      <> 0
1915         ";
1916     } else {
1917         # FIXME: account for IFNULL as above
1918         $select .= "
1919                 aqorders.quantity                AS quantity,
1920                 aqorders.quantity * aqorders.rrp AS subtotal,
1921                 (CAST(now() AS date) - closedate)            AS latesince
1922         ";
1923         if ( defined $delay ) {
1924             $from .= " AND (closedate <= (CAST(now() AS date) -(INTERVAL ? DAY)) ";
1925             push @query_params, $delay;
1926         }
1927     }
1928     if (defined $supplierid) {
1929         $from .= ' AND aqbasket.booksellerid = ? ';
1930         push @query_params, $supplierid;
1931     }
1932     if (defined $branch) {
1933         $from .= ' AND borrowers.branchcode LIKE ? ';
1934         push @query_params, $branch;
1935     }
1936
1937     if ( defined $estimateddeliverydatefrom or defined $estimateddeliverydateto ) {
1938         $from .= ' AND aqbooksellers.deliverytime IS NOT NULL ';
1939     }
1940     if ( defined $estimateddeliverydatefrom ) {
1941         $from .= ' AND ADDDATE(aqbasket.closedate, INTERVAL aqbooksellers.deliverytime DAY) >= ?';
1942         push @query_params, $estimateddeliverydatefrom;
1943     }
1944     if ( defined $estimateddeliverydateto ) {
1945         $from .= ' AND ADDDATE(aqbasket.closedate, INTERVAL aqbooksellers.deliverytime DAY) <= ?';
1946         push @query_params, $estimateddeliverydateto;
1947     }
1948     if ( defined $estimateddeliverydatefrom and not defined $estimateddeliverydateto ) {
1949         $from .= ' AND ADDDATE(aqbasket.closedate, INTERVAL aqbooksellers.deliverytime DAY) <= CAST(now() AS date)';
1950     }
1951     if (C4::Context->preference("IndependantBranches")
1952             && C4::Context->userenv
1953             && C4::Context->userenv->{flags} != 1 ) {
1954         $from .= ' AND borrowers.branchcode LIKE ? ';
1955         push @query_params, C4::Context->userenv->{branch};
1956     }
1957     my $query = "$select $from $having\nORDER BY latesince, basketno, borrowers.branchcode, supplier";
1958     $debug and print STDERR "GetLateOrders query: $query\nGetLateOrders args: " . join(" ",@query_params);
1959     my $sth = $dbh->prepare($query);
1960     $sth->execute(@query_params);
1961     my @results;
1962     while (my $data = $sth->fetchrow_hashref) {
1963         $data->{orderdate} = format_date($data->{orderdate});
1964         $data->{claimed_date} = format_date($data->{claimed_date});
1965         push @results, $data;
1966     }
1967     return @results;
1968 }
1969
1970 #------------------------------------------------------------#
1971
1972 =head3 GetHistory
1973
1974   (\@order_loop, $total_qty, $total_price, $total_qtyreceived) = GetHistory( %params );
1975
1976 Retreives some acquisition history information
1977
1978 params:
1979   title
1980   author
1981   name
1982   from_placed_on
1983   to_placed_on
1984   basket                  - search both basket name and number
1985   booksellerinvoicenumber
1986
1987 returns:
1988     $order_loop is a list of hashrefs that each look like this:
1989             {
1990                 'author'           => 'Twain, Mark',
1991                 'basketno'         => '1',
1992                 'biblionumber'     => '215',
1993                 'count'            => 1,
1994                 'creationdate'     => 'MM/DD/YYYY',
1995                 'datereceived'     => undef,
1996                 'ecost'            => '1.00',
1997                 'id'               => '1',
1998                 'invoicenumber'    => undef,
1999                 'name'             => '',
2000                 'ordernumber'      => '1',
2001                 'quantity'         => 1,
2002                 'quantityreceived' => undef,
2003                 'title'            => 'The Adventures of Huckleberry Finn'
2004             }
2005     $total_qty is the sum of all of the quantities in $order_loop
2006     $total_price is the cost of each in $order_loop times the quantity
2007     $total_qtyreceived is the sum of all of the quantityreceived entries in $order_loop
2008
2009 =cut
2010
2011 sub GetHistory {
2012 # don't run the query if there are no parameters (list would be too long for sure !)
2013     croak "No search params" unless @_;
2014     my %params = @_;
2015     my $title = $params{title};
2016     my $author = $params{author};
2017     my $isbn   = $params{isbn};
2018     my $ean    = $params{ean};
2019     my $name = $params{name};
2020     my $from_placed_on = $params{from_placed_on};
2021     my $to_placed_on = $params{to_placed_on};
2022     my $basket = $params{basket};
2023     my $booksellerinvoicenumber = $params{booksellerinvoicenumber};
2024     my $basketgroupname = $params{basketgroupname};
2025     my @order_loop;
2026     my $total_qty         = 0;
2027     my $total_qtyreceived = 0;
2028     my $total_price       = 0;
2029
2030     my $dbh   = C4::Context->dbh;
2031     my $query ="
2032         SELECT
2033             biblio.title,
2034             biblio.author,
2035             biblioitems.isbn,
2036         biblioitems.ean,
2037             aqorders.basketno,
2038             aqbasket.basketname,
2039             aqbasket.basketgroupid,
2040             aqbasketgroups.name as groupname,
2041             aqbooksellers.name,
2042             aqbasket.creationdate,
2043             aqorders.datereceived,
2044             aqorders.quantity,
2045             aqorders.quantityreceived,
2046             aqorders.ecost,
2047             aqorders.ordernumber,
2048             aqinvoices.invoicenumber,
2049             aqbooksellers.id as id,
2050             aqorders.biblionumber
2051         FROM aqorders
2052         LEFT JOIN aqbasket ON aqorders.basketno=aqbasket.basketno
2053         LEFT JOIN aqbasketgroups ON aqbasket.basketgroupid=aqbasketgroups.id
2054         LEFT JOIN aqbooksellers ON aqbasket.booksellerid=aqbooksellers.id
2055         LEFT JOIN biblioitems ON biblioitems.biblionumber=aqorders.biblionumber
2056         LEFT JOIN biblio ON biblio.biblionumber=aqorders.biblionumber
2057     LEFT JOIN aqinvoices ON aqorders.invoiceid = aqinvoices.invoiceid";
2058
2059     $query .= " LEFT JOIN borrowers ON aqbasket.authorisedby=borrowers.borrowernumber"
2060     if ( C4::Context->preference("IndependantBranches") );
2061
2062     $query .= " WHERE (datecancellationprinted is NULL or datecancellationprinted='0000-00-00') ";
2063
2064     my @query_params  = ();
2065
2066     if ( $title ) {
2067         $query .= " AND biblio.title LIKE ? ";
2068         $title =~ s/\s+/%/g;
2069         push @query_params, "%$title%";
2070     }
2071
2072     if ( $author ) {
2073         $query .= " AND biblio.author LIKE ? ";
2074         push @query_params, "%$author%";
2075     }
2076
2077     if ( $isbn ) {
2078         $query .= " AND biblioitems.isbn LIKE ? ";
2079         push @query_params, "%$isbn%";
2080     }
2081     if ( defined $ean and $ean ) {
2082         $query .= " AND biblioitems.ean = ? ";
2083         push @query_params, "$ean";
2084     }
2085     if ( $name ) {
2086         $query .= " AND aqbooksellers.name LIKE ? ";
2087         push @query_params, "%$name%";
2088     }
2089
2090     if ( $from_placed_on ) {
2091         $query .= " AND creationdate >= ? ";
2092         push @query_params, $from_placed_on;
2093     }
2094
2095     if ( $to_placed_on ) {
2096         $query .= " AND creationdate <= ? ";
2097         push @query_params, $to_placed_on;
2098     }
2099
2100     if ($basket) {
2101         if ($basket =~ m/^\d+$/) {
2102             $query .= " AND aqorders.basketno = ? ";
2103             push @query_params, $basket;
2104         } else {
2105             $query .= " AND aqbasket.basketname LIKE ? ";
2106             push @query_params, "%$basket%";
2107         }
2108     }
2109
2110     if ($booksellerinvoicenumber) {
2111         $query .= " AND aqinvoices.invoicenumber LIKE ? ";
2112         push @query_params, "%$booksellerinvoicenumber%";
2113     }
2114
2115     if ($basketgroupname) {
2116         $query .= " AND aqbasketgroups.name LIKE ? ";
2117         push @query_params, "%$basketgroupname%";
2118     }
2119
2120     if ( C4::Context->preference("IndependantBranches") ) {
2121         my $userenv = C4::Context->userenv;
2122         if ( $userenv && ($userenv->{flags} || 0) != 1 ) {
2123             $query .= " AND (borrowers.branchcode = ? OR borrowers.branchcode ='' ) ";
2124             push @query_params, $userenv->{branch};
2125         }
2126     }
2127     $query .= " ORDER BY id";
2128     my $sth = $dbh->prepare($query);
2129     $sth->execute( @query_params );
2130     my $cnt = 1;
2131     while ( my $line = $sth->fetchrow_hashref ) {
2132         $line->{count} = $cnt++;
2133         $line->{toggle} = 1 if $cnt % 2;
2134         push @order_loop, $line;
2135         $total_qty         += $line->{'quantity'};
2136         $total_qtyreceived += $line->{'quantityreceived'};
2137         $total_price       += $line->{'quantity'} * $line->{'ecost'};
2138     }
2139     return \@order_loop, $total_qty, $total_price, $total_qtyreceived;
2140 }
2141
2142 =head2 GetRecentAcqui
2143
2144   $results = GetRecentAcqui($days);
2145
2146 C<$results> is a ref to a table which containts hashref
2147
2148 =cut
2149
2150 sub GetRecentAcqui {
2151     my $limit  = shift;
2152     my $dbh    = C4::Context->dbh;
2153     my $query = "
2154         SELECT *
2155         FROM   biblio
2156         ORDER BY timestamp DESC
2157         LIMIT  0,".$limit;
2158
2159     my $sth = $dbh->prepare($query);
2160     $sth->execute;
2161     my $results = $sth->fetchall_arrayref({});
2162     return $results;
2163 }
2164
2165 =head3 GetContracts
2166
2167   $contractlist = &GetContracts($booksellerid, $activeonly);
2168
2169 Looks up the contracts that belong to a bookseller
2170
2171 Returns a list of contracts
2172
2173 =over
2174
2175 =item C<$booksellerid> is the "id" field in the "aqbooksellers" table.
2176
2177 =item C<$activeonly> if exists get only contracts that are still active.
2178
2179 =back
2180
2181 =cut
2182
2183 sub GetContracts {
2184     my ( $booksellerid, $activeonly ) = @_;
2185     my $dbh = C4::Context->dbh;
2186     my $query;
2187     if (! $activeonly) {
2188         $query = "
2189             SELECT *
2190             FROM   aqcontract
2191             WHERE  booksellerid=?
2192         ";
2193     } else {
2194         $query = "SELECT *
2195             FROM aqcontract
2196             WHERE booksellerid=?
2197                 AND contractenddate >= CURDATE( )";
2198     }
2199     my $sth = $dbh->prepare($query);
2200     $sth->execute( $booksellerid );
2201     my @results;
2202     while (my $data = $sth->fetchrow_hashref ) {
2203         push(@results, $data);
2204     }
2205     $sth->finish;
2206     return @results;
2207 }
2208
2209 #------------------------------------------------------------#
2210
2211 =head3 GetContract
2212
2213   $contract = &GetContract($contractID);
2214
2215 Looks up the contract that has PRIMKEY (contractnumber) value $contractID
2216
2217 Returns a contract
2218
2219 =cut
2220
2221 sub GetContract {
2222     my ( $contractno ) = @_;
2223     my $dbh = C4::Context->dbh;
2224     my $query = "
2225         SELECT *
2226         FROM   aqcontract
2227         WHERE  contractnumber=?
2228         ";
2229
2230     my $sth = $dbh->prepare($query);
2231     $sth->execute( $contractno );
2232     my $result = $sth->fetchrow_hashref;
2233     return $result;
2234 }
2235
2236 =head3 AddClaim
2237
2238 =over 4
2239
2240 &AddClaim($ordernumber);
2241
2242 Add a claim for an order
2243
2244 =back
2245
2246 =cut
2247 sub AddClaim {
2248     my ($ordernumber) = @_;
2249     my $dbh          = C4::Context->dbh;
2250     my $query        = "
2251         UPDATE aqorders SET
2252             claims_count = claims_count + 1,
2253             claimed_date = CURDATE()
2254         WHERE ordernumber = ?
2255         ";
2256     my $sth = $dbh->prepare($query);
2257     $sth->execute($ordernumber);
2258 }
2259
2260 =head3 GetInvoices
2261
2262     my @invoices = GetInvoices(
2263         invoicenumber => $invoicenumber,
2264         suppliername => $suppliername,
2265         shipmentdatefrom => $shipmentdatefrom, # ISO format
2266         shipmentdateto => $shipmentdateto, # ISO format
2267         billingdatefrom => $billingdatefrom, # ISO format
2268         billingdateto => $billingdateto, # ISO format
2269         isbneanissn => $isbn_or_ean_or_issn,
2270         title => $title,
2271         author => $author,
2272         publisher => $publisher,
2273         publicationyear => $publicationyear,
2274         branchcode => $branchcode,
2275         order_by => $order_by
2276     );
2277
2278 Return a list of invoices that match all given criteria.
2279
2280 $order_by is "column_name (asc|desc)", where column_name is any of
2281 'invoicenumber', 'booksellerid', 'shipmentdate', 'billingdate', 'closedate',
2282 'shipmentcost', 'shipmentcost_budgetid'.
2283
2284 asc is the default if omitted
2285
2286 =cut
2287
2288 sub GetInvoices {
2289     my %args = @_;
2290
2291     my @columns = qw(invoicenumber booksellerid shipmentdate billingdate
2292         closedate shipmentcost shipmentcost_budgetid);
2293
2294     my $dbh = C4::Context->dbh;
2295     my $query = qq{
2296         SELECT aqinvoices.*, aqbooksellers.name AS suppliername,
2297           COUNT(
2298             DISTINCT IF(
2299               aqorders.datereceived IS NOT NULL,
2300               aqorders.biblionumber,
2301               NULL
2302             )
2303           ) AS receivedbiblios,
2304           SUM(aqorders.quantityreceived) AS receiveditems
2305         FROM aqinvoices
2306           LEFT JOIN aqbooksellers ON aqbooksellers.id = aqinvoices.booksellerid
2307           LEFT JOIN aqorders ON aqorders.invoiceid = aqinvoices.invoiceid
2308           LEFT JOIN biblio ON aqorders.biblionumber = biblio.biblionumber
2309           LEFT JOIN biblioitems ON biblio.biblionumber = biblioitems.biblionumber
2310           LEFT JOIN subscription ON biblio.biblionumber = subscription.biblionumber
2311     };
2312
2313     my @bind_args;
2314     my @bind_strs;
2315     if($args{supplierid}) {
2316         push @bind_strs, " aqinvoices.booksellerid = ? ";
2317         push @bind_args, $args{supplierid};
2318     }
2319     if($args{invoicenumber}) {
2320         push @bind_strs, " aqinvoices.invoicenumber LIKE ? ";
2321         push @bind_args, "%$args{invoicenumber}%";
2322     }
2323     if($args{suppliername}) {
2324         push @bind_strs, " aqbooksellers.name LIKE ? ";
2325         push @bind_args, "%$args{suppliername}%";
2326     }
2327     if($args{shipmentdatefrom}) {
2328         push @bind_strs, " aqinvoices.shipementdate >= ? ";
2329         push @bind_args, $args{shipmentdatefrom};
2330     }
2331     if($args{shipmentdateto}) {
2332         push @bind_strs, " aqinvoices.shipementdate <= ? ";
2333         push @bind_args, $args{shipmentdateto};
2334     }
2335     if($args{billingdatefrom}) {
2336         push @bind_strs, " aqinvoices.billingdate >= ? ";
2337         push @bind_args, $args{billingdatefrom};
2338     }
2339     if($args{billingdateto}) {
2340         push @bind_strs, " aqinvoices.billingdate <= ? ";
2341         push @bind_args, $args{billingdateto};
2342     }
2343     if($args{isbneanissn}) {
2344         push @bind_strs, " (biblioitems.isbn LIKE ? OR biblioitems.ean LIKE ? OR biblioitems.issn LIKE ? ) ";
2345         push @bind_args, $args{isbneanissn}, $args{isbneanissn}, $args{isbneanissn};
2346     }
2347     if($args{title}) {
2348         push @bind_strs, " biblio.title LIKE ? ";
2349         push @bind_args, $args{title};
2350     }
2351     if($args{author}) {
2352         push @bind_strs, " biblio.author LIKE ? ";
2353         push @bind_args, $args{author};
2354     }
2355     if($args{publisher}) {
2356         push @bind_strs, " biblioitems.publishercode LIKE ? ";
2357         push @bind_args, $args{publisher};
2358     }
2359     if($args{publicationyear}) {
2360         push @bind_strs, " biblioitems.publicationyear = ? ";
2361         push @bind_args, $args{publicationyear};
2362     }
2363     if($args{branchcode}) {
2364         push @bind_strs, " aqorders.branchcode = ? ";
2365         push @bind_args, $args{branchcode};
2366     }
2367
2368     $query .= " WHERE " . join(" AND ", @bind_strs) if @bind_strs;
2369     $query .= " GROUP BY aqinvoices.invoiceid ";
2370
2371     if($args{order_by}) {
2372         my ($column, $direction) = split / /, $args{order_by};
2373         if(grep /^$column$/, @columns) {
2374             $direction ||= 'ASC';
2375             $query .= " ORDER BY $column $direction";
2376         }
2377     }
2378
2379     my $sth = $dbh->prepare($query);
2380     $sth->execute(@bind_args);
2381
2382     my $results = $sth->fetchall_arrayref({});
2383     return @$results;
2384 }
2385
2386 =head3 GetInvoice
2387
2388     my $invoice = GetInvoice($invoiceid);
2389
2390 Get informations about invoice with given $invoiceid
2391
2392 Return a hash filled with aqinvoices.* fields
2393
2394 =cut
2395
2396 sub GetInvoice {
2397     my ($invoiceid) = @_;
2398     my $invoice;
2399
2400     return unless $invoiceid;
2401
2402     my $dbh = C4::Context->dbh;
2403     my $query = qq{
2404         SELECT *
2405         FROM aqinvoices
2406         WHERE invoiceid = ?
2407     };
2408     my $sth = $dbh->prepare($query);
2409     $sth->execute($invoiceid);
2410
2411     $invoice = $sth->fetchrow_hashref;
2412     return $invoice;
2413 }
2414
2415 =head3 GetInvoiceDetails
2416
2417     my $invoice = GetInvoiceDetails($invoiceid)
2418
2419 Return informations about an invoice + the list of related order lines
2420
2421 Orders informations are in $invoice->{orders} (array ref)
2422
2423 =cut
2424
2425 sub GetInvoiceDetails {
2426     my ($invoiceid) = @_;
2427
2428     if ( !defined $invoiceid ) {
2429         carp 'GetInvoiceDetails called without an invoiceid';
2430         return;
2431     }
2432
2433     my $dbh = C4::Context->dbh;
2434     my $query = qq{
2435         SELECT aqinvoices.*, aqbooksellers.name AS suppliername
2436         FROM aqinvoices
2437           LEFT JOIN aqbooksellers ON aqinvoices.booksellerid = aqbooksellers.id
2438         WHERE invoiceid = ?
2439     };
2440     my $sth = $dbh->prepare($query);
2441     $sth->execute($invoiceid);
2442
2443     my $invoice = $sth->fetchrow_hashref;
2444
2445     $query = qq{
2446         SELECT aqorders.*, biblio.*
2447         FROM aqorders
2448           LEFT JOIN biblio ON aqorders.biblionumber = biblio.biblionumber
2449         WHERE invoiceid = ?
2450     };
2451     $sth = $dbh->prepare($query);
2452     $sth->execute($invoiceid);
2453     $invoice->{orders} = $sth->fetchall_arrayref({});
2454     $invoice->{orders} ||= []; # force an empty arrayref if fetchall_arrayref fails
2455
2456     return $invoice;
2457 }
2458
2459 =head3 AddInvoice
2460
2461     my $invoiceid = AddInvoice(
2462         invoicenumber => $invoicenumber,
2463         booksellerid => $booksellerid,
2464         shipmentdate => $shipmentdate,
2465         billingdate => $billingdate,
2466         closedate => $closedate,
2467         shipmentcost => $shipmentcost,
2468         shipmentcost_budgetid => $shipmentcost_budgetid
2469     );
2470
2471 Create a new invoice and return its id or undef if it fails.
2472
2473 =cut
2474
2475 sub AddInvoice {
2476     my %invoice = @_;
2477
2478     return unless(%invoice and $invoice{invoicenumber});
2479
2480     my @columns = qw(invoicenumber booksellerid shipmentdate billingdate
2481         closedate shipmentcost shipmentcost_budgetid);
2482
2483     my @set_strs;
2484     my @set_args;
2485     foreach my $key (keys %invoice) {
2486         if(0 < grep(/^$key$/, @columns)) {
2487             push @set_strs, "$key = ?";
2488             push @set_args, ($invoice{$key} || undef);
2489         }
2490     }
2491
2492     my $rv;
2493     if(@set_args > 0) {
2494         my $dbh = C4::Context->dbh;
2495         my $query = "INSERT INTO aqinvoices SET ";
2496         $query .= join (",", @set_strs);
2497         my $sth = $dbh->prepare($query);
2498         $rv = $sth->execute(@set_args);
2499         if($rv) {
2500             $rv = $dbh->last_insert_id(undef, undef, 'aqinvoices', undef);
2501         }
2502     }
2503     return $rv;
2504 }
2505
2506 =head3 ModInvoice
2507
2508     ModInvoice(
2509         invoiceid => $invoiceid,    # Mandatory
2510         invoicenumber => $invoicenumber,
2511         booksellerid => $booksellerid,
2512         shipmentdate => $shipmentdate,
2513         billingdate => $billingdate,
2514         closedate => $closedate,
2515         shipmentcost => $shipmentcost,
2516         shipmentcost_budgetid => $shipmentcost_budgetid
2517     );
2518
2519 Modify an invoice, invoiceid is mandatory.
2520
2521 Return undef if it fails.
2522
2523 =cut
2524
2525 sub ModInvoice {
2526     my %invoice = @_;
2527
2528     return unless(%invoice and $invoice{invoiceid});
2529
2530     my @columns = qw(invoicenumber booksellerid shipmentdate billingdate
2531         closedate shipmentcost shipmentcost_budgetid);
2532
2533     my @set_strs;
2534     my @set_args;
2535     foreach my $key (keys %invoice) {
2536         if(0 < grep(/^$key$/, @columns)) {
2537             push @set_strs, "$key = ?";
2538             push @set_args, ($invoice{$key} || undef);
2539         }
2540     }
2541
2542     my $dbh = C4::Context->dbh;
2543     my $query = "UPDATE aqinvoices SET ";
2544     $query .= join(",", @set_strs);
2545     $query .= " WHERE invoiceid = ?";
2546
2547     my $sth = $dbh->prepare($query);
2548     $sth->execute(@set_args, $invoice{invoiceid});
2549 }
2550
2551 =head3 CloseInvoice
2552
2553     CloseInvoice($invoiceid);
2554
2555 Close an invoice.
2556
2557 Equivalent to ModInvoice(invoiceid => $invoiceid, closedate => undef);
2558
2559 =cut
2560
2561 sub CloseInvoice {
2562     my ($invoiceid) = @_;
2563
2564     return unless $invoiceid;
2565
2566     my $dbh = C4::Context->dbh;
2567     my $query = qq{
2568         UPDATE aqinvoices
2569         SET closedate = CAST(NOW() AS DATE)
2570         WHERE invoiceid = ?
2571     };
2572     my $sth = $dbh->prepare($query);
2573     $sth->execute($invoiceid);
2574 }
2575
2576 =head3 ReopenInvoice
2577
2578     ReopenInvoice($invoiceid);
2579
2580 Reopen an invoice
2581
2582 Equivalent to ModInvoice(invoiceid => $invoiceid, closedate => C4::Dates->new()->output('iso'))
2583
2584 =cut
2585
2586 sub ReopenInvoice {
2587     my ($invoiceid) = @_;
2588
2589     return unless $invoiceid;
2590
2591     my $dbh = C4::Context->dbh;
2592     my $query = qq{
2593         UPDATE aqinvoices
2594         SET closedate = NULL
2595         WHERE invoiceid = ?
2596     };
2597     my $sth = $dbh->prepare($query);
2598     $sth->execute($invoiceid);
2599 }
2600
2601 1;
2602 __END__
2603
2604 =head1 AUTHOR
2605
2606 Koha Development Team <http://koha-community.org/>
2607
2608 =cut