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 = 'ordered'
 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 = 'new'
 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
 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 = qq{SELECT
 970                 aqorders.*,
 971                 biblio.title,
 972                 biblio.author,
 973                 aqbasket.basketname,
 974                 borrowers.branchcode,
 975                 biblioitems.publicationyear,
 976                 biblio.copyrightdate,
 977                 biblioitems.editionstatement,
 978                 biblioitems.isbn,
 979                 biblioitems.ean,
 980                 biblio.seriestitle,
 981                 biblioitems.publishercode,
 982                 aqorders.rrp              AS unitpricesupplier,
 983                 aqorders.ecost            AS unitpricelib,
 984                 aqorders.claims_count     AS claims_count,
 985                 aqorders.claimed_date     AS claimed_date,
 986                 aqbudgets.budget_name     AS budget,
 987                 aqbooksellers.name        AS supplier,
 988                 aqbooksellers.id          AS supplierid,
 989                 biblioitems.publishercode AS publisher,
 990                 ADDDATE(aqbasket.closedate, INTERVAL aqbooksellers.deliverytime DAY) AS estimateddeliverydate,
 991                 DATE(aqbasket.closedate)  AS orderdate,
 992                 aqorders.quantity - COALESCE(aqorders.quantityreceived,0)                 AS quantity_to_receive,
 993                 (aqorders.quantity - COALESCE(aqorders.quantityreceived,0)) * aqorders.rrp AS subtotal,
 994                 DATEDIFF(CURDATE( ),closedate) AS latesince
 995                 FROM aqorders LEFT JOIN biblio ON biblio.biblionumber = aqorders.biblionumber
 996                 LEFT JOIN biblioitems ON biblioitems.biblionumber = biblio.biblionumber
 997                 LEFT JOIN aqbudgets ON aqorders.budget_id = aqbudgets.budget_id,
 998                 aqbasket LEFT JOIN borrowers  ON aqbasket.authorisedby = borrowers.borrowernumber
 999                 LEFT JOIN aqbooksellers       ON aqbasket.booksellerid = aqbooksellers.id
1000                 WHERE aqorders.basketno = aqbasket.basketno
1001                     AND ordernumber=?};
1002     my $sth= $dbh->prepare($query);
1003     $sth->execute($ordernumber);
1004     my $data = $sth->fetchrow_hashref;
1005     $data->{orderdate} = format_date( $data->{orderdate} );
1006     $sth->finish;
1007     return $data;
1008 }
1009
1010 =head3 GetLastOrderNotReceivedFromSubscriptionid
1011
1012   $order = &GetLastOrderNotReceivedFromSubscriptionid($subscriptionid);
1013
1014 Returns a reference-to-hash describing the last order not received for a subscription.
1015
1016 =cut
1017
1018 sub GetLastOrderNotReceivedFromSubscriptionid {
1019     my ( $subscriptionid ) = @_;
1020     my $dbh                = C4::Context->dbh;
1021     my $query              = qq|
1022         SELECT * FROM aqorders
1023         LEFT JOIN subscription
1024             ON ( aqorders.subscriptionid = subscription.subscriptionid )
1025         WHERE aqorders.subscriptionid = ?
1026             AND aqorders.datereceived IS NULL
1027         LIMIT 1
1028     |;
1029     my $sth = $dbh->prepare( $query );
1030     $sth->execute( $subscriptionid );
1031     my $order = $sth->fetchrow_hashref;
1032     return $order;
1033 }
1034
1035 =head3 GetLastOrderReceivedFromSubscriptionid
1036
1037   $order = &GetLastOrderReceivedFromSubscriptionid($subscriptionid);
1038
1039 Returns a reference-to-hash describing the last order received for a subscription.
1040
1041 =cut
1042
1043 sub GetLastOrderReceivedFromSubscriptionid {
1044     my ( $subscriptionid ) = @_;
1045     my $dbh                = C4::Context->dbh;
1046     my $query              = qq|
1047         SELECT * FROM aqorders
1048         LEFT JOIN subscription
1049             ON ( aqorders.subscriptionid = subscription.subscriptionid )
1050         WHERE aqorders.subscriptionid = ?
1051             AND aqorders.datereceived =
1052                 (
1053                     SELECT MAX( aqorders.datereceived )
1054                     FROM aqorders
1055                     LEFT JOIN subscription
1056                         ON ( aqorders.subscriptionid = subscription.subscriptionid )
1057                         WHERE aqorders.subscriptionid = ?
1058                             AND aqorders.datereceived IS NOT NULL
1059                 )
1060         ORDER BY ordernumber DESC
1061         LIMIT 1
1062     |;
1063     my $sth = $dbh->prepare( $query );
1064     $sth->execute( $subscriptionid, $subscriptionid );
1065     my $order = $sth->fetchrow_hashref;
1066     return $order;
1067
1068 }
1069
1070
1071 #------------------------------------------------------------#
1072
1073 =head3 NewOrder
1074
1075   &NewOrder(\%hashref);
1076
1077 Adds a new order to the database. Any argument that isn't described
1078 below is the new value of the field with the same name in the aqorders
1079 table of the Koha database.
1080
1081 =over
1082
1083 =item $hashref->{'basketno'} is the basketno foreign key in aqorders, it is mandatory
1084
1085 =item $hashref->{'ordernumber'} is a "minimum order number."
1086
1087 =item $hashref->{'budgetdate'} is effectively ignored.
1088 If it's undef (anything false) or the string 'now', the current day is used.
1089 Else, the upcoming July 1st is used.
1090
1091 =item $hashref->{'subscription'} may be either "yes", or anything else for "no".
1092
1093 =item $hashref->{'uncertainprice'} may be 0 for "the price is known" or 1 for "the price is uncertain"
1094
1095 =item defaults entrydate to Now
1096
1097 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".
1098
1099 =back
1100
1101 =cut
1102
1103 sub NewOrder {
1104     my $orderinfo = shift;
1105
1106     my $dbh = C4::Context->dbh;
1107     my @params;
1108
1109
1110     # if these parameters are missing, we can't continue
1111     for my $key (qw/basketno quantity biblionumber budget_id/) {
1112         croak "Mandatory parameter $key missing" unless $orderinfo->{$key};
1113     }
1114
1115     if ( defined $orderinfo->{subscription} && $orderinfo->{'subscription'} eq 'yes' ) {
1116         $orderinfo->{'subscription'} = 1;
1117     } else {
1118         $orderinfo->{'subscription'} = 0;
1119     }
1120     $orderinfo->{'entrydate'} ||= C4::Dates->new()->output("iso");
1121     if (!$orderinfo->{quantityreceived}) {
1122         $orderinfo->{quantityreceived} = 0;
1123     }
1124
1125     my $ordernumber=InsertInTable("aqorders",$orderinfo);
1126     if (not $orderinfo->{parent_ordernumber}) {
1127         my $sth = $dbh->prepare("
1128             UPDATE aqorders
1129             SET parent_ordernumber = ordernumber
1130             WHERE ordernumber = ?
1131         ");
1132         $sth->execute($ordernumber);
1133     }
1134     return ( $orderinfo->{'basketno'}, $ordernumber );
1135 }
1136
1137
1138
1139 #------------------------------------------------------------#
1140
1141 =head3 NewOrderItem
1142
1143   &NewOrderItem();
1144
1145 =cut
1146
1147 sub NewOrderItem {
1148     my ($itemnumber, $ordernumber)  = @_;
1149     my $dbh = C4::Context->dbh;
1150     my $query = qq|
1151             INSERT INTO aqorders_items
1152                 (itemnumber, ordernumber)
1153             VALUES (?,?)    |;
1154
1155     my $sth = $dbh->prepare($query);
1156     $sth->execute( $itemnumber, $ordernumber);
1157 }
1158
1159 #------------------------------------------------------------#
1160
1161 =head3 ModOrder
1162
1163   &ModOrder(\%hashref);
1164
1165 Modifies an existing order. Updates the order with order number
1166 $hashref->{'ordernumber'} and biblionumber $hashref->{'biblionumber'}. All
1167 other keys of the hash update the fields with the same name in the aqorders
1168 table of the Koha database.
1169
1170 =cut
1171
1172 sub ModOrder {
1173     my $orderinfo = shift;
1174
1175     die "Ordernumber is required"     if $orderinfo->{'ordernumber'} eq  '' ;
1176     die "Biblionumber is required"  if  $orderinfo->{'biblionumber'} eq '';
1177
1178     my $dbh = C4::Context->dbh;
1179     my @params;
1180
1181     # update uncertainprice to an integer, just in case (under FF, checked boxes have the value "ON" by default)
1182     $orderinfo->{uncertainprice}=1 if $orderinfo->{uncertainprice};
1183
1184 #    delete($orderinfo->{'branchcode'});
1185     # the hash contains a lot of entries not in aqorders, so get the columns ...
1186     my $sth = $dbh->prepare("SELECT * FROM aqorders LIMIT 1;");
1187     $sth->execute;
1188     my $colnames = $sth->{NAME};
1189         #FIXME Be careful. If aqorders would have columns with diacritics,
1190         #you should need to decode what you get back from NAME.
1191         #See report 10110 and guided_reports.pl
1192     my $query = "UPDATE aqorders SET ";
1193
1194     foreach my $orderinfokey (grep(!/ordernumber/, keys %$orderinfo)){
1195         # ... and skip hash entries that are not in the aqorders table
1196         # FIXME : probably not the best way to do it (would be better to have a correct hash)
1197         next unless grep(/^$orderinfokey$/, @$colnames);
1198             $query .= "$orderinfokey=?, ";
1199             push(@params, $orderinfo->{$orderinfokey});
1200     }
1201
1202     $query .= "timestamp=NOW()  WHERE  ordernumber=?";
1203 #   push(@params, $specorderinfo{'ordernumber'});
1204     push(@params, $orderinfo->{'ordernumber'} );
1205     $sth = $dbh->prepare($query);
1206     $sth->execute(@params);
1207     $sth->finish;
1208 }
1209
1210 #------------------------------------------------------------#
1211
1212 =head3 ModItemOrder
1213
1214     ModItemOrder($itemnumber, $ordernumber);
1215
1216 Modifies the ordernumber of an item in aqorders_items.
1217
1218 =cut
1219
1220 sub ModItemOrder {
1221     my ($itemnumber, $ordernumber) = @_;
1222
1223     return unless ($itemnumber and $ordernumber);
1224
1225     my $dbh = C4::Context->dbh;
1226     my $query = qq{
1227         UPDATE aqorders_items
1228         SET ordernumber = ?
1229         WHERE itemnumber = ?
1230     };
1231     my $sth = $dbh->prepare($query);
1232     return $sth->execute($ordernumber, $itemnumber);
1233 }
1234
1235 #------------------------------------------------------------#
1236
1237 =head3 GetCancelledOrders
1238
1239   my @orders = GetCancelledOrders($basketno, $orderby);
1240
1241 Returns cancelled orders for a basket
1242
1243 =cut
1244
1245 sub GetCancelledOrders {
1246     my ( $basketno, $orderby ) = @_;
1247
1248     return () unless $basketno;
1249
1250     my $dbh   = C4::Context->dbh;
1251     my $query = "
1252         SELECT
1253             biblio.*,
1254             biblioitems.*,
1255             aqorders.*,
1256             aqbudgets.*,
1257             aqorders_transfers.ordernumber_to AS transferred_to,
1258             aqorders_transfers.timestamp AS transferred_to_timestamp
1259         FROM aqorders
1260           LEFT JOIN aqbudgets   ON aqbudgets.budget_id = aqorders.budget_id
1261           LEFT JOIN biblio      ON biblio.biblionumber = aqorders.biblionumber
1262           LEFT JOIN biblioitems ON biblioitems.biblionumber = biblio.biblionumber
1263           LEFT JOIN aqorders_transfers ON aqorders_transfers.ordernumber_from = aqorders.ordernumber
1264         WHERE basketno = ?
1265           AND (datecancellationprinted IS NOT NULL
1266                AND datecancellationprinted <> '0000-00-00')
1267     ";
1268
1269     $orderby = "aqorders.datecancellationprinted desc, aqorders.timestamp desc"
1270         unless $orderby;
1271     $query .= " ORDER BY $orderby";
1272     my $sth = $dbh->prepare($query);
1273     $sth->execute($basketno);
1274     my $results = $sth->fetchall_arrayref( {} );
1275
1276     return @$results;
1277 }
1278
1279
1280 #------------------------------------------------------------#
1281
1282 =head3 ModReceiveOrder
1283
1284   &ModReceiveOrder($biblionumber, $ordernumber, $quantityreceived, $user,
1285     $cost, $ecost, $invoiceid, rrp, budget_id, datereceived, \@received_itemnumbers);
1286
1287 Updates an order, to reflect the fact that it was received, at least
1288 in part. All arguments not mentioned below update the fields with the
1289 same name in the aqorders table of the Koha database.
1290
1291 If a partial order is received, splits the order into two.
1292
1293 Updates the order with bibilionumber C<$biblionumber> and ordernumber
1294 C<$ordernumber>.
1295
1296 =cut
1297
1298
1299 sub ModReceiveOrder {
1300     my (
1301         $biblionumber,    $ordernumber,  $quantrec, $user, $cost, $ecost,
1302         $invoiceid, $rrp, $budget_id, $datereceived, $received_items
1303     )
1304     = @_;
1305
1306     my $dbh = C4::Context->dbh;
1307     $datereceived = C4::Dates->output('iso') unless $datereceived;
1308     my $suggestionid = GetSuggestionFromBiblionumber( $biblionumber );
1309     if ($suggestionid) {
1310         ModSuggestion( {suggestionid=>$suggestionid,
1311                         STATUS=>'AVAILABLE',
1312                         biblionumber=> $biblionumber}
1313                         );
1314     }
1315
1316     my $sth=$dbh->prepare("
1317         SELECT * FROM   aqorders
1318         WHERE           biblionumber=? AND aqorders.ordernumber=?");
1319
1320     $sth->execute($biblionumber,$ordernumber);
1321     my $order = $sth->fetchrow_hashref();
1322     $sth->finish();
1323
1324     my $new_ordernumber = $ordernumber;
1325     if ( $order->{quantity} > $quantrec ) {
1326         # Split order line in two parts: the first is the original order line
1327         # without received items (the quantity is decreased),
1328         # the second part is a new order line with quantity=quantityrec
1329         # (entirely received)
1330         $sth=$dbh->prepare("
1331             UPDATE aqorders
1332             SET quantity = ?,
1333                 orderstatus = 'partial'
1334             WHERE ordernumber = ?
1335         ");
1336
1337         $sth->execute($order->{quantity} - $quantrec, $ordernumber);
1338
1339         $sth->finish;
1340
1341         delete $order->{'ordernumber'};
1342         $order->{'budget_id'} = ( $budget_id || $order->{'budget_id'} );
1343         $order->{'quantity'} = $quantrec;
1344         $order->{'quantityreceived'} = $quantrec;
1345         $order->{'datereceived'} = $datereceived;
1346         $order->{'invoiceid'} = $invoiceid;
1347         $order->{'unitprice'} = $cost;
1348         $order->{'rrp'} = $rrp;
1349         $order->{ecost} = $ecost;
1350         $order->{'orderstatus'} = 'complete';
1351         my $basketno;
1352         ( $basketno, $new_ordernumber ) = NewOrder($order);
1353
1354         if ($received_items) {
1355             foreach my $itemnumber (@$received_items) {
1356                 ModItemOrder($itemnumber, $new_ordernumber);
1357             }
1358         }
1359     } else {
1360         $sth=$dbh->prepare("update aqorders
1361                             set quantityreceived=?,datereceived=?,invoiceid=?,
1362                                 unitprice=?,rrp=?,ecost=?,budget_id=?,orderstatus='complete'
1363                             where biblionumber=? and ordernumber=?");
1364         $sth->execute($quantrec,$datereceived,$invoiceid,$cost,$rrp,$ecost,$budget_id,$biblionumber,$ordernumber);
1365         $sth->finish;
1366     }
1367     return ($datereceived, $new_ordernumber);
1368 }
1369
1370 =head3 CancelReceipt
1371
1372     my $parent_ordernumber = CancelReceipt($ordernumber);
1373
1374     Cancel an order line receipt and update the parent order line, as if no
1375     receipt was made.
1376     If items are created at receipt (AcqCreateItem = receiving) then delete
1377     these items.
1378
1379 =cut
1380
1381 sub CancelReceipt {
1382     my $ordernumber = shift;
1383
1384     return unless $ordernumber;
1385
1386     my $dbh = C4::Context->dbh;
1387     my $query = qq{
1388         SELECT datereceived, parent_ordernumber, quantity
1389         FROM aqorders
1390         WHERE ordernumber = ?
1391     };
1392     my $sth = $dbh->prepare($query);
1393     $sth->execute($ordernumber);
1394     my $order = $sth->fetchrow_hashref;
1395     unless($order) {
1396         warn "CancelReceipt: order $ordernumber does not exist";
1397         return;
1398     }
1399     unless($order->{'datereceived'}) {
1400         warn "CancelReceipt: order $ordernumber is not received";
1401         return;
1402     }
1403
1404     my $parent_ordernumber = $order->{'parent_ordernumber'};
1405
1406     if($parent_ordernumber == $ordernumber || not $parent_ordernumber) {
1407         # The order line has no parent, just mark it as not received
1408         $query = qq{
1409             UPDATE aqorders
1410             SET quantityreceived = ?,
1411                 datereceived = ?,
1412                 invoiceid = ?,
1413                 orderstatus = 'ordered'
1414             WHERE ordernumber = ?
1415         };
1416         $sth = $dbh->prepare($query);
1417         $sth->execute(0, undef, undef, $ordernumber);
1418     } else {
1419         # The order line has a parent, increase parent quantity and delete
1420         # the order line.
1421         $query = qq{
1422             SELECT quantity, datereceived
1423             FROM aqorders
1424             WHERE ordernumber = ?
1425         };
1426         $sth = $dbh->prepare($query);
1427         $sth->execute($parent_ordernumber);
1428         my $parent_order = $sth->fetchrow_hashref;
1429         unless($parent_order) {
1430             warn "Parent order $parent_ordernumber does not exist.";
1431             return;
1432         }
1433         if($parent_order->{'datereceived'}) {
1434             warn "CancelReceipt: parent order is received.".
1435                 " Can't cancel receipt.";
1436             return;
1437         }
1438         $query = qq{
1439             UPDATE aqorders
1440             SET quantity = ?,
1441                 orderstatus = 'ordered'
1442             WHERE ordernumber = ?
1443         };
1444         $sth = $dbh->prepare($query);
1445         my $rv = $sth->execute(
1446             $order->{'quantity'} + $parent_order->{'quantity'},
1447             $parent_ordernumber
1448         );
1449         unless($rv) {
1450             warn "Cannot update parent order line, so do not cancel".
1451                 " receipt";
1452             return;
1453         }
1454         if(C4::Context->preference('AcqCreateItem') eq 'receiving') {
1455             # Remove items that were created at receipt
1456             $query = qq{
1457                 DELETE FROM items, aqorders_items
1458                 USING items, aqorders_items
1459                 WHERE items.itemnumber = ? AND aqorders_items.itemnumber = ?
1460             };
1461             $sth = $dbh->prepare($query);
1462             my @itemnumbers = GetItemnumbersFromOrder($ordernumber);
1463             foreach my $itemnumber (@itemnumbers) {
1464                 $sth->execute($itemnumber, $itemnumber);
1465             }
1466         } else {
1467             # Update items
1468             my @itemnumbers = GetItemnumbersFromOrder($ordernumber);
1469             foreach my $itemnumber (@itemnumbers) {
1470                 ModItemOrder($itemnumber, $parent_ordernumber);
1471             }
1472         }
1473         # Delete order line
1474         $query = qq{
1475             DELETE FROM aqorders
1476             WHERE ordernumber = ?
1477         };
1478         $sth = $dbh->prepare($query);
1479         $sth->execute($ordernumber);
1480
1481     }
1482
1483     return $parent_ordernumber;
1484 }
1485
1486 #------------------------------------------------------------#
1487
1488 =head3 SearchOrders
1489
1490 @results = &SearchOrders({
1491     ordernumber => $ordernumber,
1492     search => $search,
1493     biblionumber => $biblionumber,
1494     ean => $ean,
1495     booksellerid => $booksellerid,
1496     basketno => $basketno,
1497     owner => $owner,
1498     pending => $pending
1499 });
1500
1501 Searches for orders.
1502
1503 C<$owner> Finds order for the logged in user.
1504 C<$pending> Finds pending orders. Ignores completed and cancelled orders.
1505
1506
1507 C<@results> is an array of references-to-hash with the keys are fields
1508 from aqorders, biblio, biblioitems and aqbasket tables.
1509
1510 =cut
1511
1512 sub SearchOrders {
1513     my ( $params ) = @_;
1514     my $ordernumber = $params->{ordernumber};
1515     my $search = $params->{search};
1516     my $ean = $params->{ean};
1517     my $booksellerid = $params->{booksellerid};
1518     my $basketno = $params->{basketno};
1519     my $basketname = $params->{basketname};
1520     my $basketgroupname = $params->{basketgroupname};
1521     my $owner = $params->{owner};
1522     my $pending = $params->{pending};
1523
1524     my $dbh = C4::Context->dbh;
1525     my @args = ();
1526     my $query = q{
1527         SELECT aqbasket.basketno,
1528                borrowers.surname,
1529                borrowers.firstname,
1530                biblio.*,
1531                biblioitems.isbn,
1532                biblioitems.biblioitemnumber,
1533                aqbasket.closedate,
1534                aqbasket.creationdate,
1535                aqbasket.basketname,
1536                aqorders.*
1537         FROM aqorders
1538             LEFT JOIN aqbasket ON aqorders.basketno = aqbasket.basketno
1539             LEFT JOIN aqbasketgroups ON aqbasket.basketgroupid = aqbasketgroups.id
1540             LEFT JOIN borrowers ON aqbasket.authorisedby=borrowers.borrowernumber
1541             LEFT JOIN biblio ON aqorders.biblionumber=biblio.biblionumber
1542             LEFT JOIN biblioitems ON biblioitems.biblionumber=biblio.biblionumber
1543         WHERE (datecancellationprinted is NULL)
1544     };
1545
1546     $query .= q{
1547         AND (quantity > quantityreceived OR quantityreceived is NULL)
1548     } if $pending;
1549
1550     my $userenv = C4::Context->userenv;
1551     if ( C4::Context->preference("IndependentBranches") ) {
1552         if ( ( $userenv ) and ( $userenv->{flags} != 1 ) ) {
1553             $query .= q{
1554                 AND (
1555                     borrowers.branchcode = ?
1556                     OR borrowers.branchcode  = ''
1557                 )
1558             };
1559             push @args, $userenv->{branch};
1560         }
1561     }
1562
1563     if ( $ordernumber ) {
1564         $query .= ' AND (aqorders.ordernumber=?)';
1565         push @args, $ordernumber;
1566     }
1567     if( $search ) {
1568         $query .= ' AND (biblio.title LIKE ? OR biblio.author LIKE ? OR biblioitems.isbn LIKE ?)';
1569         push @args, ("%$search%","%$search%","%$search%");
1570     }
1571     if ( $ean ) {
1572         $query .= ' AND biblioitems.ean = ?';
1573         push @args, $ean;
1574     }
1575     if ( $booksellerid ) {
1576         $query .= 'AND aqbasket.booksellerid = ?';
1577         push @args, $booksellerid;
1578     }
1579     if( $basketno ) {
1580         $query .= 'AND aqbasket.basketno = ?';
1581         push @args, $basketno;
1582     }
1583     if( $basketname ) {
1584         $query .= 'AND aqbasket.basketname LIKE ?';
1585         push @args, "%$basketname%";
1586     }
1587     if( $basketgroupname ) {
1588         $query .= ' AND aqbasketgroups.name LIKE ?';
1589         push @args, "%$basketgroupname%";
1590     }
1591
1592     if ( $owner ) {
1593         $query .= ' AND aqbasket.authorisedby=? ';
1594         push @args, $userenv->{'number'};
1595     }
1596
1597     $query .= ' ORDER BY aqbasket.basketno';
1598
1599     my $sth = $dbh->prepare($query);
1600     $sth->execute(@args);
1601     return $sth->fetchall_arrayref({});
1602 }
1603
1604 #------------------------------------------------------------#
1605
1606 =head3 DelOrder
1607
1608   &DelOrder($biblionumber, $ordernumber);
1609
1610 Cancel the order with the given order and biblio numbers. It does not
1611 delete any entries in the aqorders table, it merely marks them as
1612 cancelled.
1613
1614 =cut
1615
1616 sub DelOrder {
1617     my ( $bibnum, $ordernumber ) = @_;
1618     my $dbh = C4::Context->dbh;
1619     my $query = "
1620         UPDATE aqorders
1621         SET    datecancellationprinted=now(), orderstatus='cancelled'
1622         WHERE  biblionumber=? AND ordernumber=?
1623     ";
1624     my $sth = $dbh->prepare($query);
1625     $sth->execute( $bibnum, $ordernumber );
1626     $sth->finish;
1627     my @itemnumbers = GetItemnumbersFromOrder( $ordernumber );
1628     foreach my $itemnumber (@itemnumbers){
1629         C4::Items::DelItem( $dbh, $bibnum, $itemnumber );
1630     }
1631
1632 }
1633
1634 =head3 TransferOrder
1635
1636     my $newordernumber = TransferOrder($ordernumber, $basketno);
1637
1638 Transfer an order line to a basket.
1639 Mark $ordernumber as cancelled with an internal note 'Cancelled and transfered
1640 to BOOKSELLER on DATE' and create new order with internal note
1641 'Transfered from BOOKSELLER on DATE'.
1642 Move all attached items to the new order.
1643 Received orders cannot be transfered.
1644 Return the ordernumber of created order.
1645
1646 =cut
1647
1648 sub TransferOrder {
1649     my ($ordernumber, $basketno) = @_;
1650
1651     return unless ($ordernumber and $basketno);
1652
1653     my $order = GetOrder( $ordernumber );
1654     return if $order->{datereceived};
1655     my $basket = GetBasket($basketno);
1656     return unless $basket;
1657
1658     my $dbh = C4::Context->dbh;
1659     my ($query, $sth, $rv);
1660
1661     $query = qq{
1662         UPDATE aqorders
1663         SET datecancellationprinted = CAST(NOW() AS date)
1664         WHERE ordernumber = ?
1665     };
1666     $sth = $dbh->prepare($query);
1667     $rv = $sth->execute($ordernumber);
1668
1669     delete $order->{'ordernumber'};
1670     $order->{'basketno'} = $basketno;
1671     my $newordernumber;
1672     (undef, $newordernumber) = NewOrder($order);
1673
1674     $query = qq{
1675         UPDATE aqorders_items
1676         SET ordernumber = ?
1677         WHERE ordernumber = ?
1678     };
1679     $sth = $dbh->prepare($query);
1680     $sth->execute($newordernumber, $ordernumber);
1681
1682     $query = q{
1683         INSERT INTO aqorders_transfers (ordernumber_from, ordernumber_to)
1684         VALUES (?, ?)
1685     };
1686     $sth = $dbh->prepare($query);
1687     $sth->execute($ordernumber, $newordernumber);
1688
1689     return $newordernumber;
1690 }
1691
1692 =head2 FUNCTIONS ABOUT PARCELS
1693
1694 =cut
1695
1696 #------------------------------------------------------------#
1697
1698 =head3 GetParcel
1699
1700   @results = &GetParcel($booksellerid, $code, $date);
1701
1702 Looks up all of the received items from the supplier with the given
1703 bookseller ID at the given date, for the given code (bookseller Invoice number). Ignores cancelled and completed orders.
1704
1705 C<@results> is an array of references-to-hash. The keys of each element are fields from
1706 the aqorders, biblio, and biblioitems tables of the Koha database.
1707
1708 C<@results> is sorted alphabetically by book title.
1709
1710 =cut
1711
1712 sub GetParcel {
1713     #gets all orders from a certain supplier, orders them alphabetically
1714     my ( $supplierid, $code, $datereceived ) = @_;
1715     my $dbh     = C4::Context->dbh;
1716     my @results = ();
1717     $code .= '%'
1718     if $code;  # add % if we search on a given code (otherwise, let him empty)
1719     my $strsth ="
1720         SELECT  authorisedby,
1721                 creationdate,
1722                 aqbasket.basketno,
1723                 closedate,surname,
1724                 firstname,
1725                 aqorders.biblionumber,
1726                 aqorders.ordernumber,
1727                 aqorders.parent_ordernumber,
1728                 aqorders.quantity,
1729                 aqorders.quantityreceived,
1730                 aqorders.unitprice,
1731                 aqorders.listprice,
1732                 aqorders.rrp,
1733                 aqorders.ecost,
1734                 aqorders.gstrate,
1735                 biblio.title
1736         FROM aqorders
1737         LEFT JOIN aqbasket ON aqbasket.basketno=aqorders.basketno
1738         LEFT JOIN borrowers ON aqbasket.authorisedby=borrowers.borrowernumber
1739         LEFT JOIN biblio ON aqorders.biblionumber=biblio.biblionumber
1740         LEFT JOIN aqinvoices ON aqorders.invoiceid = aqinvoices.invoiceid
1741         WHERE
1742             aqbasket.booksellerid = ?
1743             AND aqinvoices.invoicenumber LIKE ?
1744             AND aqorders.datereceived = ? ";
1745
1746     my @query_params = ( $supplierid, $code, $datereceived );
1747     if ( C4::Context->preference("IndependentBranches") ) {
1748         my $userenv = C4::Context->userenv;
1749         if ( ($userenv) && ( $userenv->{flags} != 1 ) ) {
1750             $strsth .= " and (borrowers.branchcode = ?
1751                         or borrowers.branchcode  = '')";
1752             push @query_params, $userenv->{branch};
1753         }
1754     }
1755     $strsth .= " ORDER BY aqbasket.basketno";
1756     # ## parcelinformation : $strsth
1757     my $sth = $dbh->prepare($strsth);
1758     $sth->execute( @query_params );
1759     while ( my $data = $sth->fetchrow_hashref ) {
1760         push( @results, $data );
1761     }
1762     # ## countparcelbiblio: scalar(@results)
1763     $sth->finish;
1764
1765     return @results;
1766 }
1767
1768 #------------------------------------------------------------#
1769
1770 =head3 GetParcels
1771
1772   $results = &GetParcels($bookseller, $order, $code, $datefrom, $dateto);
1773
1774 get a lists of parcels.
1775
1776 * Input arg :
1777
1778 =over
1779
1780 =item $bookseller
1781 is the bookseller this function has to get parcels.
1782
1783 =item $order
1784 To know on what criteria the results list has to be ordered.
1785
1786 =item $code
1787 is the booksellerinvoicenumber.
1788
1789 =item $datefrom & $dateto
1790 to know on what date this function has to filter its search.
1791
1792 =back
1793
1794 * return:
1795 a pointer on a hash list containing parcel informations as such :
1796
1797 =over
1798
1799 =item Creation date
1800
1801 =item Last operation
1802
1803 =item Number of biblio
1804
1805 =item Number of items
1806
1807 =back
1808
1809 =cut
1810
1811 sub GetParcels {
1812     my ($bookseller,$order, $code, $datefrom, $dateto) = @_;
1813     my $dbh    = C4::Context->dbh;
1814     my @query_params = ();
1815     my $strsth ="
1816         SELECT  aqinvoices.invoicenumber,
1817                 datereceived,purchaseordernumber,
1818                 count(DISTINCT biblionumber) AS biblio,
1819                 sum(quantity) AS itemsexpected,
1820                 sum(quantityreceived) AS itemsreceived
1821         FROM   aqorders LEFT JOIN aqbasket ON aqbasket.basketno = aqorders.basketno
1822         LEFT JOIN aqinvoices ON aqorders.invoiceid = aqinvoices.invoiceid
1823         WHERE aqbasket.booksellerid = ? and datereceived IS NOT NULL
1824     ";
1825     push @query_params, $bookseller;
1826
1827     if ( defined $code ) {
1828         $strsth .= ' and aqinvoices.invoicenumber like ? ';
1829         # add a % to the end of the code to allow stemming.
1830         push @query_params, "$code%";
1831     }
1832
1833     if ( defined $datefrom ) {
1834         $strsth .= ' and datereceived >= ? ';
1835         push @query_params, $datefrom;
1836     }
1837
1838     if ( defined $dateto ) {
1839         $strsth .=  'and datereceived <= ? ';
1840         push @query_params, $dateto;
1841     }
1842
1843     $strsth .= "group by aqinvoices.invoicenumber,datereceived ";
1844
1845     # can't use a placeholder to place this column name.
1846     # but, we could probably be checking to make sure it is a column that will be fetched.
1847     $strsth .= "order by $order " if ($order);
1848
1849     my $sth = $dbh->prepare($strsth);
1850
1851     $sth->execute( @query_params );
1852     my $results = $sth->fetchall_arrayref({});
1853     $sth->finish;
1854     return @$results;
1855 }
1856
1857 #------------------------------------------------------------#
1858
1859 =head3 GetLateOrders
1860
1861   @results = &GetLateOrders;
1862
1863 Searches for bookseller with late orders.
1864
1865 return:
1866 the table of supplier with late issues. This table is full of hashref.
1867
1868 =cut
1869
1870 sub GetLateOrders {
1871     my $delay      = shift;
1872     my $supplierid = shift;
1873     my $branch     = shift;
1874     my $estimateddeliverydatefrom = shift;
1875     my $estimateddeliverydateto = shift;
1876
1877     my $dbh = C4::Context->dbh;
1878
1879     #BEWARE, order of parenthesis and LEFT JOIN is important for speed
1880     my $dbdriver = C4::Context->config("db_scheme") || "mysql";
1881
1882     my @query_params = ();
1883     my $select = "
1884     SELECT aqbasket.basketno,
1885         aqorders.ordernumber,
1886         DATE(aqbasket.closedate)  AS orderdate,
1887         aqorders.rrp              AS unitpricesupplier,
1888         aqorders.ecost            AS unitpricelib,
1889         aqorders.claims_count     AS claims_count,
1890         aqorders.claimed_date     AS claimed_date,
1891         aqbudgets.budget_name     AS budget,
1892         borrowers.branchcode      AS branch,
1893         aqbooksellers.name        AS supplier,
1894         aqbooksellers.id          AS supplierid,
1895         biblio.author, biblio.title,
1896         biblioitems.publishercode AS publisher,
1897         biblioitems.publicationyear,
1898         ADDDATE(aqbasket.closedate, INTERVAL aqbooksellers.deliverytime DAY) AS estimateddeliverydate,
1899     ";
1900     my $from = "
1901     FROM
1902         aqorders LEFT JOIN biblio     ON biblio.biblionumber         = aqorders.biblionumber
1903         LEFT JOIN biblioitems         ON biblioitems.biblionumber    = biblio.biblionumber
1904         LEFT JOIN aqbudgets           ON aqorders.budget_id          = aqbudgets.budget_id,
1905         aqbasket LEFT JOIN borrowers  ON aqbasket.authorisedby       = borrowers.borrowernumber
1906         LEFT JOIN aqbooksellers       ON aqbasket.booksellerid       = aqbooksellers.id
1907         WHERE aqorders.basketno = aqbasket.basketno
1908         AND ( datereceived = ''
1909             OR datereceived IS NULL
1910             OR aqorders.quantityreceived < aqorders.quantity
1911         )
1912         AND aqbasket.closedate IS NOT NULL
1913         AND (aqorders.datecancellationprinted IS NULL OR aqorders.datecancellationprinted='0000-00-00')
1914     ";
1915     my $having = "";
1916     if ($dbdriver eq "mysql") {
1917         $select .= "
1918         aqorders.quantity - COALESCE(aqorders.quantityreceived,0)                 AS quantity,
1919         (aqorders.quantity - COALESCE(aqorders.quantityreceived,0)) * aqorders.rrp AS subtotal,
1920         DATEDIFF(CAST(now() AS date),closedate) AS latesince
1921         ";
1922         if ( defined $delay ) {
1923             $from .= " AND (closedate <= DATE_SUB(CAST(now() AS date),INTERVAL ? DAY)) " ;
1924             push @query_params, $delay;
1925         }
1926         $having = "
1927         HAVING quantity          <> 0
1928             AND unitpricesupplier <> 0
1929             AND unitpricelib      <> 0
1930         ";
1931     } else {
1932         # FIXME: account for IFNULL as above
1933         $select .= "
1934                 aqorders.quantity                AS quantity,
1935                 aqorders.quantity * aqorders.rrp AS subtotal,
1936                 (CAST(now() AS date) - closedate)            AS latesince
1937         ";
1938         if ( defined $delay ) {
1939             $from .= " AND (closedate <= (CAST(now() AS date) -(INTERVAL ? DAY)) ";
1940             push @query_params, $delay;
1941         }
1942     }
1943     if (defined $supplierid) {
1944         $from .= ' AND aqbasket.booksellerid = ? ';
1945         push @query_params, $supplierid;
1946     }
1947     if (defined $branch) {
1948         $from .= ' AND borrowers.branchcode LIKE ? ';
1949         push @query_params, $branch;
1950     }
1951
1952     if ( defined $estimateddeliverydatefrom or defined $estimateddeliverydateto ) {
1953         $from .= ' AND aqbooksellers.deliverytime IS NOT NULL ';
1954     }
1955     if ( defined $estimateddeliverydatefrom ) {
1956         $from .= ' AND ADDDATE(aqbasket.closedate, INTERVAL aqbooksellers.deliverytime DAY) >= ?';
1957         push @query_params, $estimateddeliverydatefrom;
1958     }
1959     if ( defined $estimateddeliverydateto ) {
1960         $from .= ' AND ADDDATE(aqbasket.closedate, INTERVAL aqbooksellers.deliverytime DAY) <= ?';
1961         push @query_params, $estimateddeliverydateto;
1962     }
1963     if ( defined $estimateddeliverydatefrom and not defined $estimateddeliverydateto ) {
1964         $from .= ' AND ADDDATE(aqbasket.closedate, INTERVAL aqbooksellers.deliverytime DAY) <= CAST(now() AS date)';
1965     }
1966     if (C4::Context->preference("IndependentBranches")
1967             && C4::Context->userenv
1968             && C4::Context->userenv->{flags} != 1 ) {
1969         $from .= ' AND borrowers.branchcode LIKE ? ';
1970         push @query_params, C4::Context->userenv->{branch};
1971     }
1972     $from .= " AND orderstatus <> 'cancelled' ";
1973     my $query = "$select $from $having\nORDER BY latesince, basketno, borrowers.branchcode, supplier";
1974     $debug and print STDERR "GetLateOrders query: $query\nGetLateOrders args: " . join(" ",@query_params);
1975     my $sth = $dbh->prepare($query);
1976     $sth->execute(@query_params);
1977     my @results;
1978     while (my $data = $sth->fetchrow_hashref) {
1979         $data->{orderdate} = format_date($data->{orderdate});
1980         $data->{claimed_date} = format_date($data->{claimed_date});
1981         push @results, $data;
1982     }
1983     return @results;
1984 }
1985
1986 #------------------------------------------------------------#
1987
1988 =head3 GetHistory
1989
1990   (\@order_loop, $total_qty, $total_price, $total_qtyreceived) = GetHistory( %params );
1991
1992 Retreives some acquisition history information
1993
1994 params:
1995   title
1996   author
1997   name
1998   from_placed_on
1999   to_placed_on
2000   basket                  - search both basket name and number
2001   booksellerinvoicenumber
2002
2003 returns:
2004     $order_loop is a list of hashrefs that each look like this:
2005             {
2006                 'author'           => 'Twain, Mark',
2007                 'basketno'         => '1',
2008                 'biblionumber'     => '215',
2009                 'count'            => 1,
2010                 'creationdate'     => 'MM/DD/YYYY',
2011                 'datereceived'     => undef,
2012                 'ecost'            => '1.00',
2013                 'id'               => '1',
2014                 'invoicenumber'    => undef,
2015                 'name'             => '',
2016                 'ordernumber'      => '1',
2017                 'quantity'         => 1,
2018                 'quantityreceived' => undef,
2019                 'title'            => 'The Adventures of Huckleberry Finn'
2020             }
2021     $total_qty is the sum of all of the quantities in $order_loop
2022     $total_price is the cost of each in $order_loop times the quantity
2023     $total_qtyreceived is the sum of all of the quantityreceived entries in $order_loop
2024
2025 =cut
2026
2027 sub GetHistory {
2028 # don't run the query if there are no parameters (list would be too long for sure !)
2029     croak "No search params" unless @_;
2030     my %params = @_;
2031     my $title = $params{title};
2032     my $author = $params{author};
2033     my $isbn   = $params{isbn};
2034     my $ean    = $params{ean};
2035     my $name = $params{name};
2036     my $from_placed_on = $params{from_placed_on};
2037     my $to_placed_on = $params{to_placed_on};
2038     my $basket = $params{basket};
2039     my $booksellerinvoicenumber = $params{booksellerinvoicenumber};
2040     my $basketgroupname = $params{basketgroupname};
2041     my $budget = $params{budget};
2042     my $orderstatus = $params{orderstatus};
2043
2044     my @order_loop;
2045     my $total_qty         = 0;
2046     my $total_qtyreceived = 0;
2047     my $total_price       = 0;
2048
2049     my $dbh   = C4::Context->dbh;
2050     my $query ="
2051         SELECT
2052             COALESCE(biblio.title,     deletedbiblio.title)     AS title,
2053             COALESCE(biblio.author,    deletedbiblio.author)    AS author,
2054             COALESCE(biblioitems.isbn, deletedbiblioitems.isbn) AS isbn,
2055             COALESCE(biblioitems.ean,  deletedbiblioitems.ean)  AS ean,
2056             aqorders.basketno,
2057             aqbasket.basketname,
2058             aqbasket.basketgroupid,
2059             aqbasketgroups.name as groupname,
2060             aqbooksellers.name,
2061             aqbasket.creationdate,
2062             aqorders.datereceived,
2063             aqorders.quantity,
2064             aqorders.quantityreceived,
2065             aqorders.ecost,
2066             aqorders.ordernumber,
2067             aqorders.invoiceid,
2068             aqinvoices.invoicenumber,
2069             aqbooksellers.id as id,
2070             aqorders.biblionumber,
2071             aqorders.orderstatus,
2072             aqorders.parent_ordernumber,
2073             aqbudgets.budget_name
2074             ";
2075     $query .= ", aqbudgets.budget_id AS budget" if defined $budget;
2076     $query .= "
2077         FROM aqorders
2078         LEFT JOIN aqbasket ON aqorders.basketno=aqbasket.basketno
2079         LEFT JOIN aqbasketgroups ON aqbasket.basketgroupid=aqbasketgroups.id
2080         LEFT JOIN aqbooksellers ON aqbasket.booksellerid=aqbooksellers.id
2081         LEFT JOIN biblioitems ON biblioitems.biblionumber=aqorders.biblionumber
2082         LEFT JOIN biblio ON biblio.biblionumber=aqorders.biblionumber
2083         LEFT JOIN aqbudgets ON aqorders.budget_id=aqbudgets.budget_id
2084         LEFT JOIN aqinvoices ON aqorders.invoiceid = aqinvoices.invoiceid
2085         LEFT JOIN deletedbiblio ON deletedbiblio.biblionumber=aqorders.biblionumber
2086         LEFT JOIN deletedbiblioitems ON deletedbiblioitems.biblionumber=aqorders.biblionumber
2087         ";
2088
2089     if ( C4::Context->preference("IndependentBranches") ) {
2090         $query .= " LEFT JOIN borrowers ON aqbasket.authorisedby=borrowers.borrowernumber";
2091     }
2092
2093     $query .= " WHERE 1 ";
2094
2095     $query .= " AND (datecancellationprinted is NULL or datecancellationprinted='0000-00-00') " if $orderstatus ne 'cancelled';
2096
2097     my @query_params  = ();
2098
2099     if ( $title ) {
2100         $query .= " AND biblio.title LIKE ? ";
2101         $title =~ s/\s+/%/g;
2102         push @query_params, "%$title%";
2103     }
2104
2105     if ( $author ) {
2106         $query .= " AND biblio.author LIKE ? ";
2107         push @query_params, "%$author%";
2108     }
2109
2110     if ( $isbn ) {
2111         $query .= " AND biblioitems.isbn LIKE ? ";
2112         push @query_params, "%$isbn%";
2113     }
2114     if ( $ean ) {
2115         $query .= " AND biblioitems.ean = ? ";
2116         push @query_params, "$ean";
2117     }
2118     if ( $name ) {
2119         $query .= " AND aqbooksellers.name LIKE ? ";
2120         push @query_params, "%$name%";
2121     }
2122
2123     if ( $budget ) {
2124         $query .= " AND aqbudgets.budget_id = ? ";
2125         push @query_params, "$budget";
2126     }
2127
2128     if ( $from_placed_on ) {
2129         $query .= " AND creationdate >= ? ";
2130         push @query_params, $from_placed_on;
2131     }
2132
2133     if ( $to_placed_on ) {
2134         $query .= " AND creationdate <= ? ";
2135         push @query_params, $to_placed_on;
2136     }
2137
2138     if ( defined $orderstatus and $orderstatus ne '') {
2139         $query .= " AND aqorders.orderstatus = ? ";
2140         push @query_params, "$orderstatus";
2141     }
2142
2143     if ($basket) {
2144         if ($basket =~ m/^\d+$/) {
2145             $query .= " AND aqorders.basketno = ? ";
2146             push @query_params, $basket;
2147         } else {
2148             $query .= " AND aqbasket.basketname LIKE ? ";
2149             push @query_params, "%$basket%";
2150         }
2151     }
2152
2153     if ($booksellerinvoicenumber) {
2154         $query .= " AND aqinvoices.invoicenumber LIKE ? ";
2155         push @query_params, "%$booksellerinvoicenumber%";
2156     }
2157
2158     if ($basketgroupname) {
2159         $query .= " AND aqbasketgroups.name LIKE ? ";
2160         push @query_params, "%$basketgroupname%";
2161     }
2162
2163     if ( C4::Context->preference("IndependentBranches") ) {
2164         my $userenv = C4::Context->userenv;
2165         if ( $userenv && ($userenv->{flags} || 0) != 1 ) {
2166             $query .= " AND (borrowers.branchcode = ? OR borrowers.branchcode ='' ) ";
2167             push @query_params, $userenv->{branch};
2168         }
2169     }
2170     $query .= " ORDER BY id";
2171     my $sth = $dbh->prepare($query);
2172     $sth->execute( @query_params );
2173     my $cnt = 1;
2174     while ( my $line = $sth->fetchrow_hashref ) {
2175         $line->{count} = $cnt++;
2176         $line->{toggle} = 1 if $cnt % 2;
2177         push @order_loop, $line;
2178         $total_qty         += ( $line->{quantity} ) ? $line->{quantity} : 0;
2179         $total_qtyreceived += ( $line->{quantityreceived} ) ? $line->{quantityreceived} : 0;
2180         $total_price       += ( $line->{quantity} and $line->{ecost} ) ? $line->{quantity} * $line->{ecost} : 0;
2181     }
2182     return \@order_loop, $total_qty, $total_price, $total_qtyreceived;
2183 }
2184
2185 =head2 GetRecentAcqui
2186
2187   $results = GetRecentAcqui($days);
2188
2189 C<$results> is a ref to a table which containts hashref
2190
2191 =cut
2192
2193 sub GetRecentAcqui {
2194     my $limit  = shift;
2195     my $dbh    = C4::Context->dbh;
2196     my $query = "
2197         SELECT *
2198         FROM   biblio
2199         ORDER BY timestamp DESC
2200         LIMIT  0,".$limit;
2201
2202     my $sth = $dbh->prepare($query);
2203     $sth->execute;
2204     my $results = $sth->fetchall_arrayref({});
2205     return $results;
2206 }
2207
2208 =head3 GetContracts
2209
2210   $contractlist = &GetContracts($booksellerid, $activeonly);
2211
2212 Looks up the contracts that belong to a bookseller
2213
2214 Returns a list of contracts
2215
2216 =over
2217
2218 =item C<$booksellerid> is the "id" field in the "aqbooksellers" table.
2219
2220 =item C<$activeonly> if exists get only contracts that are still active.
2221
2222 =back
2223
2224 =cut
2225
2226 sub GetContracts {
2227     my ( $booksellerid, $activeonly ) = @_;
2228     my $dbh = C4::Context->dbh;
2229     my $query;
2230     if (! $activeonly) {
2231         $query = "
2232             SELECT *
2233             FROM   aqcontract
2234             WHERE  booksellerid=?
2235         ";
2236     } else {
2237         $query = "SELECT *
2238             FROM aqcontract
2239             WHERE booksellerid=?
2240                 AND contractenddate >= CURDATE( )";
2241     }
2242     my $sth = $dbh->prepare($query);
2243     $sth->execute( $booksellerid );
2244     my @results;
2245     while (my $data = $sth->fetchrow_hashref ) {
2246         push(@results, $data);
2247     }
2248     $sth->finish;
2249     return @results;
2250 }
2251
2252 #------------------------------------------------------------#
2253
2254 =head3 GetContract
2255
2256   $contract = &GetContract($contractID);
2257
2258 Looks up the contract that has PRIMKEY (contractnumber) value $contractID
2259
2260 Returns a contract
2261
2262 =cut
2263
2264 sub GetContract {
2265     my ( $contractno ) = @_;
2266     my $dbh = C4::Context->dbh;
2267     my $query = "
2268         SELECT *
2269         FROM   aqcontract
2270         WHERE  contractnumber=?
2271         ";
2272
2273     my $sth = $dbh->prepare($query);
2274     $sth->execute( $contractno );
2275     my $result = $sth->fetchrow_hashref;
2276     return $result;
2277 }
2278
2279 =head3 AddClaim
2280
2281 =over
2282
2283 &AddClaim($ordernumber);
2284
2285 Add a claim for an order
2286
2287 =back
2288
2289 =cut
2290
2291 sub AddClaim {
2292     my ($ordernumber) = @_;
2293     my $dbh          = C4::Context->dbh;
2294     my $query        = "
2295         UPDATE aqorders SET
2296             claims_count = claims_count + 1,
2297             claimed_date = CURDATE()
2298         WHERE ordernumber = ?
2299         ";
2300     my $sth = $dbh->prepare($query);
2301     $sth->execute($ordernumber);
2302 }
2303
2304 =head3 GetInvoices
2305
2306     my @invoices = GetInvoices(
2307         invoicenumber => $invoicenumber,
2308         suppliername => $suppliername,
2309         shipmentdatefrom => $shipmentdatefrom, # ISO format
2310         shipmentdateto => $shipmentdateto, # ISO format
2311         billingdatefrom => $billingdatefrom, # ISO format
2312         billingdateto => $billingdateto, # ISO format
2313         isbneanissn => $isbn_or_ean_or_issn,
2314         title => $title,
2315         author => $author,
2316         publisher => $publisher,
2317         publicationyear => $publicationyear,
2318         branchcode => $branchcode,
2319         order_by => $order_by
2320     );
2321
2322 Return a list of invoices that match all given criteria.
2323
2324 $order_by is "column_name (asc|desc)", where column_name is any of
2325 'invoicenumber', 'booksellerid', 'shipmentdate', 'billingdate', 'closedate',
2326 'shipmentcost', 'shipmentcost_budgetid'.
2327
2328 asc is the default if omitted
2329
2330 =cut
2331
2332 sub GetInvoices {
2333     my %args = @_;
2334
2335     my @columns = qw(invoicenumber booksellerid shipmentdate billingdate
2336         closedate shipmentcost shipmentcost_budgetid);
2337
2338     my $dbh = C4::Context->dbh;
2339     my $query = qq{
2340         SELECT aqinvoices.*, aqbooksellers.name AS suppliername,
2341           COUNT(
2342             DISTINCT IF(
2343               aqorders.datereceived IS NOT NULL,
2344               aqorders.biblionumber,
2345               NULL
2346             )
2347           ) AS receivedbiblios,
2348           SUM(aqorders.quantityreceived) AS receiveditems
2349         FROM aqinvoices
2350           LEFT JOIN aqbooksellers ON aqbooksellers.id = aqinvoices.booksellerid
2351           LEFT JOIN aqorders ON aqorders.invoiceid = aqinvoices.invoiceid
2352           LEFT JOIN biblio ON aqorders.biblionumber = biblio.biblionumber
2353           LEFT JOIN biblioitems ON biblio.biblionumber = biblioitems.biblionumber
2354           LEFT JOIN subscription ON biblio.biblionumber = subscription.biblionumber
2355     };
2356
2357     my @bind_args;
2358     my @bind_strs;
2359     if($args{supplierid}) {
2360         push @bind_strs, " aqinvoices.booksellerid = ? ";
2361         push @bind_args, $args{supplierid};
2362     }
2363     if($args{invoicenumber}) {
2364         push @bind_strs, " aqinvoices.invoicenumber LIKE ? ";
2365         push @bind_args, "%$args{invoicenumber}%";
2366     }
2367     if($args{suppliername}) {
2368         push @bind_strs, " aqbooksellers.name LIKE ? ";
2369         push @bind_args, "%$args{suppliername}%";
2370     }
2371     if($args{shipmentdatefrom}) {
2372         push @bind_strs, " aqinvoices.shipementdate >= ? ";
2373         push @bind_args, $args{shipmentdatefrom};
2374     }
2375     if($args{shipmentdateto}) {
2376         push @bind_strs, " aqinvoices.shipementdate <= ? ";
2377         push @bind_args, $args{shipmentdateto};
2378     }
2379     if($args{billingdatefrom}) {
2380         push @bind_strs, " aqinvoices.billingdate >= ? ";
2381         push @bind_args, $args{billingdatefrom};
2382     }
2383     if($args{billingdateto}) {
2384         push @bind_strs, " aqinvoices.billingdate <= ? ";
2385         push @bind_args, $args{billingdateto};
2386     }
2387     if($args{isbneanissn}) {
2388         push @bind_strs, " (biblioitems.isbn LIKE ? OR biblioitems.ean LIKE ? OR biblioitems.issn LIKE ? ) ";
2389         push @bind_args, $args{isbneanissn}, $args{isbneanissn}, $args{isbneanissn};
2390     }
2391     if($args{title}) {
2392         push @bind_strs, " biblio.title LIKE ? ";
2393         push @bind_args, $args{title};
2394     }
2395     if($args{author}) {
2396         push @bind_strs, " biblio.author LIKE ? ";
2397         push @bind_args, $args{author};
2398     }
2399     if($args{publisher}) {
2400         push @bind_strs, " biblioitems.publishercode LIKE ? ";
2401         push @bind_args, $args{publisher};
2402     }
2403     if($args{publicationyear}) {
2404         push @bind_strs, " biblioitems.publicationyear = ? ";
2405         push @bind_args, $args{publicationyear};
2406     }
2407     if($args{branchcode}) {
2408         push @bind_strs, " aqorders.branchcode = ? ";
2409         push @bind_args, $args{branchcode};
2410     }
2411
2412     $query .= " WHERE " . join(" AND ", @bind_strs) if @bind_strs;
2413     $query .= " GROUP BY aqinvoices.invoiceid ";
2414
2415     if($args{order_by}) {
2416         my ($column, $direction) = split / /, $args{order_by};
2417         if(grep /^$column$/, @columns) {
2418             $direction ||= 'ASC';
2419             $query .= " ORDER BY $column $direction";
2420         }
2421     }
2422
2423     my $sth = $dbh->prepare($query);
2424     $sth->execute(@bind_args);
2425
2426     my $results = $sth->fetchall_arrayref({});
2427     return @$results;
2428 }
2429
2430 =head3 GetInvoice
2431
2432     my $invoice = GetInvoice($invoiceid);
2433
2434 Get informations about invoice with given $invoiceid
2435
2436 Return a hash filled with aqinvoices.* fields
2437
2438 =cut
2439
2440 sub GetInvoice {
2441     my ($invoiceid) = @_;
2442     my $invoice;
2443
2444     return unless $invoiceid;
2445
2446     my $dbh = C4::Context->dbh;
2447     my $query = qq{
2448         SELECT *
2449         FROM aqinvoices
2450         WHERE invoiceid = ?
2451     };
2452     my $sth = $dbh->prepare($query);
2453     $sth->execute($invoiceid);
2454
2455     $invoice = $sth->fetchrow_hashref;
2456     return $invoice;
2457 }
2458
2459 =head3 GetInvoiceDetails
2460
2461     my $invoice = GetInvoiceDetails($invoiceid)
2462
2463 Return informations about an invoice + the list of related order lines
2464
2465 Orders informations are in $invoice->{orders} (array ref)
2466
2467 =cut
2468
2469 sub GetInvoiceDetails {
2470     my ($invoiceid) = @_;
2471
2472     if ( !defined $invoiceid ) {
2473         carp 'GetInvoiceDetails called without an invoiceid';
2474         return;
2475     }
2476
2477     my $dbh = C4::Context->dbh;
2478     my $query = q{
2479         SELECT aqinvoices.*, aqbooksellers.name AS suppliername
2480         FROM aqinvoices
2481           LEFT JOIN aqbooksellers ON aqinvoices.booksellerid = aqbooksellers.id
2482         WHERE invoiceid = ?
2483     };
2484     my $sth = $dbh->prepare($query);
2485     $sth->execute($invoiceid);
2486
2487     my $invoice = $sth->fetchrow_hashref;
2488
2489     $query = q{
2490         SELECT aqorders.*, biblio.*, aqbasket.basketname
2491         FROM aqorders
2492           LEFT JOIN aqbasket ON aqorders.basketno = aqbasket.basketno
2493           LEFT JOIN biblio ON aqorders.biblionumber = biblio.biblionumber
2494         WHERE invoiceid = ?
2495     };
2496     $sth = $dbh->prepare($query);
2497     $sth->execute($invoiceid);
2498     $invoice->{orders} = $sth->fetchall_arrayref({});
2499     $invoice->{orders} ||= []; # force an empty arrayref if fetchall_arrayref fails
2500
2501     return $invoice;
2502 }
2503
2504 =head3 AddInvoice
2505
2506     my $invoiceid = AddInvoice(
2507         invoicenumber => $invoicenumber,
2508         booksellerid => $booksellerid,
2509         shipmentdate => $shipmentdate,
2510         billingdate => $billingdate,
2511         closedate => $closedate,
2512         shipmentcost => $shipmentcost,
2513         shipmentcost_budgetid => $shipmentcost_budgetid
2514     );
2515
2516 Create a new invoice and return its id or undef if it fails.
2517
2518 =cut
2519
2520 sub AddInvoice {
2521     my %invoice = @_;
2522
2523     return unless(%invoice and $invoice{invoicenumber});
2524
2525     my @columns = qw(invoicenumber booksellerid shipmentdate billingdate
2526         closedate shipmentcost shipmentcost_budgetid);
2527
2528     my @set_strs;
2529     my @set_args;
2530     foreach my $key (keys %invoice) {
2531         if(0 < grep(/^$key$/, @columns)) {
2532             push @set_strs, "$key = ?";
2533             push @set_args, ($invoice{$key} || undef);
2534         }
2535     }
2536
2537     my $rv;
2538     if(@set_args > 0) {
2539         my $dbh = C4::Context->dbh;
2540         my $query = "INSERT INTO aqinvoices SET ";
2541         $query .= join (",", @set_strs);
2542         my $sth = $dbh->prepare($query);
2543         $rv = $sth->execute(@set_args);
2544         if($rv) {
2545             $rv = $dbh->last_insert_id(undef, undef, 'aqinvoices', undef);
2546         }
2547     }
2548     return $rv;
2549 }
2550
2551 =head3 ModInvoice
2552
2553     ModInvoice(
2554         invoiceid => $invoiceid,    # Mandatory
2555         invoicenumber => $invoicenumber,
2556         booksellerid => $booksellerid,
2557         shipmentdate => $shipmentdate,
2558         billingdate => $billingdate,
2559         closedate => $closedate,
2560         shipmentcost => $shipmentcost,
2561         shipmentcost_budgetid => $shipmentcost_budgetid
2562     );
2563
2564 Modify an invoice, invoiceid is mandatory.
2565
2566 Return undef if it fails.
2567
2568 =cut
2569
2570 sub ModInvoice {
2571     my %invoice = @_;
2572
2573     return unless(%invoice and $invoice{invoiceid});
2574
2575     my @columns = qw(invoicenumber booksellerid shipmentdate billingdate
2576         closedate shipmentcost shipmentcost_budgetid);
2577
2578     my @set_strs;
2579     my @set_args;
2580     foreach my $key (keys %invoice) {
2581         if(0 < grep(/^$key$/, @columns)) {
2582             push @set_strs, "$key = ?";
2583             push @set_args, ($invoice{$key} || undef);
2584         }
2585     }
2586
2587     my $dbh = C4::Context->dbh;
2588     my $query = "UPDATE aqinvoices SET ";
2589     $query .= join(",", @set_strs);
2590     $query .= " WHERE invoiceid = ?";
2591
2592     my $sth = $dbh->prepare($query);
2593     $sth->execute(@set_args, $invoice{invoiceid});
2594 }
2595
2596 =head3 CloseInvoice
2597
2598     CloseInvoice($invoiceid);
2599
2600 Close an invoice.
2601
2602 Equivalent to ModInvoice(invoiceid => $invoiceid, closedate => undef);
2603
2604 =cut
2605
2606 sub CloseInvoice {
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 = CAST(NOW() AS DATE)
2615         WHERE invoiceid = ?
2616     };
2617     my $sth = $dbh->prepare($query);
2618     $sth->execute($invoiceid);
2619 }
2620
2621 =head3 ReopenInvoice
2622
2623     ReopenInvoice($invoiceid);
2624
2625 Reopen an invoice
2626
2627 Equivalent to ModInvoice(invoiceid => $invoiceid, closedate => C4::Dates->new()->output('iso'))
2628
2629 =cut
2630
2631 sub ReopenInvoice {
2632     my ($invoiceid) = @_;
2633
2634     return unless $invoiceid;
2635
2636     my $dbh = C4::Context->dbh;
2637     my $query = qq{
2638         UPDATE aqinvoices
2639         SET closedate = NULL
2640         WHERE invoiceid = ?
2641     };
2642     my $sth = $dbh->prepare($query);
2643     $sth->execute($invoiceid);
2644 }
2645
2646 =head3 DelInvoice
2647
2648     DelInvoice($invoiceid);
2649
2650 Delete an invoice if there are no items attached to it.
2651
2652 =cut
2653
2654 sub DelInvoice {
2655     my ($invoiceid) = @_;
2656
2657     return unless $invoiceid;
2658
2659     my $dbh   = C4::Context->dbh;
2660     my $query = qq{
2661         SELECT COUNT(*)
2662         FROM aqorders
2663         WHERE invoiceid = ?
2664     };
2665     my $sth = $dbh->prepare($query);
2666     $sth->execute($invoiceid);
2667     my $res = $sth->fetchrow_arrayref;
2668     if ( $res && $res->[0] == 0 ) {
2669         $query = qq{
2670             DELETE FROM aqinvoices
2671             WHERE invoiceid = ?
2672         };
2673         my $sth = $dbh->prepare($query);
2674         return ( $sth->execute($invoiceid) > 0 );
2675     }
2676     return;
2677 }
2678
2679 =head3 MergeInvoices
2680
2681     MergeInvoices($invoiceid, \@sourceids);
2682
2683 Merge the invoices identified by the IDs in \@sourceids into
2684 the invoice identified by $invoiceid.
2685
2686 =cut
2687
2688 sub MergeInvoices {
2689     my ($invoiceid, $sourceids) = @_;
2690
2691     return unless $invoiceid;
2692     foreach my $sourceid (@$sourceids) {
2693         next if $sourceid == $invoiceid;
2694         my $source = GetInvoiceDetails($sourceid);
2695         foreach my $order (@{$source->{'orders'}}) {
2696             $order->{'invoiceid'} = $invoiceid;
2697             ModOrder($order);
2698         }
2699         DelInvoice($source->{'invoiceid'});
2700     }
2701     return;
2702 }
2703
2704 =head3 GetBiblioCountByBasketno
2705
2706 $biblio_count = &GetBiblioCountByBasketno($basketno);
2707
2708 Looks up the biblio's count that has basketno value $basketno
2709
2710 Returns a quantity
2711
2712 =cut
2713
2714 sub GetBiblioCountByBasketno {
2715     my ($basketno) = @_;
2716     my $dbh          = C4::Context->dbh;
2717     my $query        = "
2718         SELECT COUNT( DISTINCT( biblionumber ) )
2719         FROM   aqorders
2720         WHERE  basketno = ?
2721             AND (datecancellationprinted IS NULL OR datecancellationprinted='0000-00-00')
2722         ";
2723
2724     my $sth = $dbh->prepare($query);
2725     $sth->execute($basketno);
2726     return $sth->fetchrow;
2727 }
2728
2729 1;
2730 __END__
2731
2732 =head1 AUTHOR
2733
2734 Koha Development Team <http://koha-community.org/>
2735
2736 =cut