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