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
   8 # under the terms of the GNU General Public License as published by
   9 # the Free Software Foundation; either version 3 of the License, or
  10 # (at your option) any later version.
  11 #
  12 # Koha is distributed in the hope that it will be useful, but
  13 # WITHOUT ANY WARRANTY; without even the implied warranty of
  14 # MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
  15 # GNU General Public License for more details.
  16 #
  17 # You should have received a copy of the GNU General Public License
  18 # along with Koha; if not, see <http://www.gnu.org/licenses>.
  19
  20
  21 use Modern::Perl;
  22 use Carp;
  23 use C4::Context;
  24 use C4::Debug;
  25 use C4::Suggestions;
  26 use C4::Biblio;
  27 use C4::Contract;
  28 use C4::Debug;
  29 use C4::Templates qw(gettemplate);
  30 use Koha::DateUtils qw( dt_from_string output_pref );
  31 use Koha::Acquisition::Baskets;
  32 use Koha::Acquisition::Booksellers;
  33 use Koha::Acquisition::Orders;
  34 use Koha::Biblios;
  35 use Koha::Exceptions;
  36 use Koha::Items;
  37 use Koha::Number::Price;
  38 use Koha::Libraries;
  39 use Koha::CsvProfiles;
  40 use Koha::Patrons;
  41
  42 use C4::Koha;
  43
  44 use MARC::Field;
  45 use MARC::Record;
  46
  47 use Time::localtime;
  48
  49 use vars qw(@ISA @EXPORT);
  50
  51 BEGIN {
  52     require Exporter;
  53     @ISA    = qw(Exporter);
  54     @EXPORT = qw(
  55         &GetBasket &NewBasket &CloseBasket &ReopenBasket &DelBasket &ModBasket
  56         &GetBasketAsCSV &GetBasketGroupAsCSV
  57         &GetBasketsByBookseller &GetBasketsByBasketgroup
  58         &GetBasketsInfosByBookseller
  59
  60         &GetBasketUsers &ModBasketUsers
  61         &CanUserManageBasket
  62
  63         &ModBasketHeader
  64
  65         &ModBasketgroup &NewBasketgroup &DelBasketgroup &GetBasketgroup &CloseBasketgroup
  66         &GetBasketgroups &ReOpenBasketgroup
  67
  68         &DelOrder &ModOrder &GetOrder &GetOrders &GetOrdersByBiblionumber
  69         &GetLateOrders &GetOrderFromItemnumber
  70         &SearchOrders &GetHistory &GetRecentAcqui
  71         &ModReceiveOrder &CancelReceipt
  72         &TransferOrder
  73         &GetLastOrderNotReceivedFromSubscriptionid &GetLastOrderReceivedFromSubscriptionid
  74         &ModItemOrder
  75
  76         &GetParcels
  77
  78         &GetInvoices
  79         &GetInvoice
  80         &GetInvoiceDetails
  81         &AddInvoice
  82         &ModInvoice
  83         &CloseInvoice
  84         &ReopenInvoice
  85         &DelInvoice
  86         &MergeInvoices
  87
  88         &AddClaim
  89         &GetBiblioCountByBasketno
  90
  91         &GetOrderUsers
  92         &ModOrderUsers
  93         &NotifyOrderUsers
  94
  95         &FillWithDefaultValues
  96
  97         &get_rounded_price
  98         &get_rounding_sql
  99     );
 100 }
 101
 102
 103
 104
 105
 106 sub GetOrderFromItemnumber {
 107     my ($itemnumber) = @_;
 108     my $dbh          = C4::Context->dbh;
 109     my $query        = qq|
 110
 111     SELECT  * from aqorders    LEFT JOIN aqorders_items
 112     ON (     aqorders.ordernumber = aqorders_items.ordernumber   )
 113     WHERE itemnumber = ?  |;
 114
 115     my $sth = $dbh->prepare($query);
 116
 117 #    $sth->trace(3);
 118
 119     $sth->execute($itemnumber);
 120
 121     my $order = $sth->fetchrow_hashref;
 122     return ( $order  );
 123
 124 }
 125
 126 =head1 NAME
 127
 128 C4::Acquisition - Koha functions for dealing with orders and acquisitions
 129
 130 =head1 SYNOPSIS
 131
 132 use C4::Acquisition;
 133
 134 =head1 DESCRIPTION
 135
 136 The functions in this module deal with acquisitions, managing book
 137 orders, basket and parcels.
 138
 139 =head1 FUNCTIONS
 140
 141 =head2 FUNCTIONS ABOUT BASKETS
 142
 143 =head3 GetBasket
 144
 145   $aqbasket = &GetBasket($basketnumber);
 146
 147 get all basket informations in aqbasket for a given basket
 148
 149 B<returns:> informations for a given basket returned as a hashref.
 150
 151 =cut
 152
 153 sub GetBasket {
 154     my ($basketno) = @_;
 155     my $dbh        = C4::Context->dbh;
 156     my $query = "
 157         SELECT  aqbasket.*,
 158                 concat( b.firstname,' ',b.surname) AS authorisedbyname
 159         FROM    aqbasket
 160         LEFT JOIN borrowers b ON aqbasket.authorisedby=b.borrowernumber
 161         WHERE basketno=?
 162     ";
 163     my $sth=$dbh->prepare($query);
 164     $sth->execute($basketno);
 165     my $basket = $sth->fetchrow_hashref;
 166     return ( $basket );
 167 }
 168
 169 #------------------------------------------------------------#
 170
 171 =head3 NewBasket
 172
 173   $basket = &NewBasket( $booksellerid, $authorizedby, $basketname,
 174       $basketnote, $basketbooksellernote, $basketcontractnumber, $deliveryplace, $billingplace, $is_standing, $create_items );
 175
 176 Create a new basket in aqbasket table
 177
 178 =over
 179
 180 =item C<$booksellerid> is a foreign key in the aqbasket table
 181
 182 =item C<$authorizedby> is the username of who created the basket
 183
 184 =back
 185
 186 The other parameters are optional, see ModBasketHeader for more info on them.
 187
 188 =cut
 189
 190 sub NewBasket {
 191     my ( $booksellerid, $authorisedby, $basketname, $basketnote,
 192         $basketbooksellernote, $basketcontractnumber, $deliveryplace,
 193         $billingplace, $is_standing, $create_items ) = @_;
 194     my $dbh = C4::Context->dbh;
 195     my $query =
 196         'INSERT INTO aqbasket (creationdate,booksellerid,authorisedby) '
 197       . 'VALUES  (now(),?,?)';
 198     $dbh->do( $query, {}, $booksellerid, $authorisedby );
 199
 200     my $basket = $dbh->{mysql_insertid};
 201     $basketname           ||= q{}; # default to empty strings
 202     $basketnote           ||= q{};
 203     $basketbooksellernote ||= q{};
 204     ModBasketHeader( $basket, $basketname, $basketnote, $basketbooksellernote,
 205         $basketcontractnumber, $booksellerid, $deliveryplace, $billingplace, $is_standing, $create_items );
 206     return $basket;
 207 }
 208
 209 #------------------------------------------------------------#
 210
 211 =head3 CloseBasket
 212
 213   &CloseBasket($basketno);
 214
 215 close a basket (becomes unmodifiable, except for receives)
 216
 217 =cut
 218
 219 sub CloseBasket {
 220     my ($basketno) = @_;
 221     my $dbh        = C4::Context->dbh;
 222     $dbh->do('UPDATE aqbasket SET closedate=now() WHERE basketno=?', {}, $basketno );
 223
 224     $dbh->do(
 225 q{UPDATE aqorders SET orderstatus = 'ordered' WHERE basketno = ? AND orderstatus NOT IN ( 'complete', 'cancelled')},
 226         {}, $basketno
 227     );
 228     return;
 229 }
 230
 231 =head3 ReopenBasket
 232
 233   &ReopenBasket($basketno);
 234
 235 reopen a basket
 236
 237 =cut
 238
 239 sub ReopenBasket {
 240     my ($basketno) = @_;
 241     my $dbh        = C4::Context->dbh;
 242     $dbh->do( q{UPDATE aqbasket SET closedate=NULL WHERE  basketno=?}, {}, $basketno );
 243
 244     $dbh->do( q{
 245         UPDATE aqorders
 246         SET orderstatus = 'new'
 247         WHERE basketno = ?
 248         AND orderstatus NOT IN ( 'complete', 'cancelled' )
 249         }, {}, $basketno);
 250     return;
 251 }
 252
 253 #------------------------------------------------------------#
 254
 255 =head3 GetBasketAsCSV
 256
 257   &GetBasketAsCSV($basketno);
 258
 259 Export a basket as CSV
 260
 261 $cgi parameter is needed for column name translation
 262
 263 =cut
 264
 265 sub GetBasketAsCSV {
 266     my ($basketno, $cgi, $csv_profile_id) = @_;
 267     my $basket = GetBasket($basketno);
 268     my @orders = GetOrders($basketno);
 269     my $contract = GetContract({
 270         contractnumber => $basket->{'contractnumber'}
 271     });
 272
 273     my $template = C4::Templates::gettemplate("acqui/csv/basket.tt", "intranet", $cgi);
 274     my @rows;
 275     if ($csv_profile_id) {
 276         my $csv_profile = Koha::CsvProfiles->find( $csv_profile_id );
 277         Koha::Exceptions::ObjectNotFound->throw( 'There is no valid csv profile given') unless $csv_profile;
 278
 279         my $csv = Text::CSV_XS->new({'quote_char'=>'"','escape_char'=>'"','sep_char'=>$csv_profile->csv_separator,'binary'=>1});
 280         my $csv_profile_content = $csv_profile->content;
 281         my ( @headers, @fields );
 282         while ( $csv_profile_content =~ /
 283             ([^=\|]+) # header
 284             =?
 285             ([^\|]*) # fieldname (table.row or row)
 286             \|? /gxms
 287         ) {
 288             my $header = $1;
 289             my $field = ($2 eq '') ? $1 : $2;
 290
 291             $header =~ s/^\s+|\s+$//g; # Trim whitespaces
 292             push @headers, $header;
 293
 294             $field =~ s/[^\.]*\.{1}//; # Remove the table name if exists.
 295             $field =~ s/^\s+|\s+$//g; # Trim whitespaces
 296             push @fields, $field;
 297         }
 298         for my $order (@orders) {
 299             my @row;
 300             my $biblio = Koha::Biblios->find( $order->{biblionumber} );
 301             my $biblioitem = $biblio->biblioitem;
 302             $order = { %$order, %{ $biblioitem->unblessed } };
 303             if ($contract) {
 304                 $order = {%$order, %$contract};
 305             }
 306             $order = {%$order, %$basket, %{ $biblio->unblessed }};
 307             for my $field (@fields) {
 308                 push @row, $order->{$field};
 309             }
 310             push @rows, \@row;
 311         }
 312         my $content = join( $csv_profile->csv_separator, @headers ) . "\n";
 313         for my $row ( @rows ) {
 314             $csv->combine(@$row);
 315             my $string = $csv->string;
 316             $content .= $string . "\n";
 317         }
 318         return $content;
 319     }
 320     else {
 321         foreach my $order (@orders) {
 322             my $biblio = Koha::Biblios->find( $order->{biblionumber} );
 323             my $biblioitem = $biblio->biblioitem;
 324             my $row = {
 325                 contractname => $contract->{'contractname'},
 326                 ordernumber => $order->{'ordernumber'},
 327                 entrydate => $order->{'entrydate'},
 328                 isbn => $order->{'isbn'},
 329                 author => $biblio->author,
 330                 title => $biblio->title,
 331                 publicationyear => $biblioitem->publicationyear,
 332                 publishercode => $biblioitem->publishercode,
 333                 collectiontitle => $biblioitem->collectiontitle,
 334                 notes => $order->{'order_vendornote'},
 335                 quantity => $order->{'quantity'},
 336                 rrp => $order->{'rrp'},
 337             };
 338             for my $place ( qw( deliveryplace billingplace ) ) {
 339                 if ( my $library = Koha::Libraries->find( $row->{deliveryplace} ) ) {
 340                     $row->{$place} = $library->branchname
 341                 }
 342             }
 343             foreach(qw(
 344                 contractname author title publishercode collectiontitle notes
 345                 deliveryplace billingplace
 346             ) ) {
 347                 # Double the quotes to not be interpreted as a field end
 348                 $row->{$_} =~ s/"/""/g if $row->{$_};
 349             }
 350             push @rows, $row;
 351          }
 352
 353         @rows = sort {
 354             if(defined $a->{publishercode} and defined $b->{publishercode}) {
 355                 $a->{publishercode} cmp $b->{publishercode};
 356             }
 357         } @rows;
 358
 359         $template->param(rows => \@rows);
 360
 361         return $template->output;
 362     }
 363 }
 364
 365
 366 =head3 GetBasketGroupAsCSV
 367
 368   &GetBasketGroupAsCSV($basketgroupid);
 369
 370 Export a basket group as CSV
 371
 372 $cgi parameter is needed for column name translation
 373
 374 =cut
 375
 376 sub GetBasketGroupAsCSV {
 377     my ($basketgroupid, $cgi) = @_;
 378     my $baskets = GetBasketsByBasketgroup($basketgroupid);
 379
 380     my $template = C4::Templates::gettemplate('acqui/csv/basketgroup.tt', 'intranet', $cgi);
 381
 382     my @rows;
 383     for my $basket (@$baskets) {
 384         my @orders     = GetOrders( $basket->{basketno} );
 385         my $contract   = GetContract({
 386             contractnumber => $basket->{contractnumber}
 387         });
 388         my $bookseller = Koha::Acquisition::Booksellers->find( $basket->{booksellerid} );
 389         my $basketgroup = GetBasketgroup( $$basket{basketgroupid} );
 390
 391         foreach my $order (@orders) {
 392             my $biblio = Koha::Biblios->find( $order->{biblionumber} );
 393             my $biblioitem = $biblio->biblioitem;
 394             my $row = {
 395                 clientnumber => $bookseller->accountnumber,
 396                 basketname => $basket->{basketname},
 397                 ordernumber => $order->{ordernumber},
 398                 author => $biblio->author,
 399                 title => $biblio->title,
 400                 publishercode => $biblioitem->publishercode,
 401                 publicationyear => $biblioitem->publicationyear,
 402                 collectiontitle => $biblioitem->collectiontitle,
 403                 isbn => $order->{isbn},
 404                 quantity => $order->{quantity},
 405                 rrp_tax_included => $order->{rrp_tax_included},
 406                 rrp_tax_excluded => $order->{rrp_tax_excluded},
 407                 discount => $bookseller->discount,
 408                 ecost_tax_included => $order->{ecost_tax_included},
 409                 ecost_tax_excluded => $order->{ecost_tax_excluded},
 410                 notes => $order->{order_vendornote},
 411                 entrydate => $order->{entrydate},
 412                 booksellername => $bookseller->name,
 413                 bookselleraddress => $bookseller->address1,
 414                 booksellerpostal => $bookseller->postal,
 415                 contractnumber => $contract->{contractnumber},
 416                 contractname => $contract->{contractname},
 417             };
 418             my $temp = {
 419                 basketgroupdeliveryplace => $basketgroup->{deliveryplace},
 420                 basketgroupbillingplace  => $basketgroup->{billingplace},
 421                 basketdeliveryplace      => $basket->{deliveryplace},
 422                 basketbillingplace       => $basket->{billingplace},
 423             };
 424             for my $place (qw( basketgroupdeliveryplace basketgroupbillingplace basketdeliveryplace basketbillingplace )) {
 425                 if ( my $library = Koha::Libraries->find( $temp->{$place} ) ) {
 426                     $row->{$place} = $library->branchname;
 427                 }
 428             }
 429             foreach(qw(
 430                 basketname author title publishercode collectiontitle notes
 431                 booksellername bookselleraddress booksellerpostal contractname
 432                 basketgroupdeliveryplace basketgroupbillingplace
 433                 basketdeliveryplace basketbillingplace
 434             ) ) {
 435                 # Double the quotes to not be interpreted as a field end
 436                 $row->{$_} =~ s/"/""/g if $row->{$_};
 437             }
 438             push @rows, $row;
 439          }
 440      }
 441     $template->param(rows => \@rows);
 442
 443     return $template->output;
 444
 445 }
 446
 447 =head3 CloseBasketgroup
 448
 449   &CloseBasketgroup($basketgroupno);
 450
 451 close a basketgroup
 452
 453 =cut
 454
 455 sub CloseBasketgroup {
 456     my ($basketgroupno) = @_;
 457     my $dbh        = C4::Context->dbh;
 458     my $sth = $dbh->prepare("
 459         UPDATE aqbasketgroups
 460         SET    closed=1
 461         WHERE  id=?
 462     ");
 463     $sth->execute($basketgroupno);
 464 }
 465
 466 #------------------------------------------------------------#
 467
 468 =head3 ReOpenBaskergroup($basketgroupno)
 469
 470   &ReOpenBaskergroup($basketgroupno);
 471
 472 reopen a basketgroup
 473
 474 =cut
 475
 476 sub ReOpenBasketgroup {
 477     my ($basketgroupno) = @_;
 478     my $dbh        = C4::Context->dbh;
 479     my $sth = $dbh->prepare("
 480         UPDATE aqbasketgroups
 481         SET    closed=0
 482         WHERE  id=?
 483     ");
 484     $sth->execute($basketgroupno);
 485 }
 486
 487 #------------------------------------------------------------#
 488
 489
 490 =head3 DelBasket
 491
 492   &DelBasket($basketno);
 493
 494 Deletes the basket that has basketno field $basketno in the aqbasket table.
 495
 496 =over
 497
 498 =item C<$basketno> is the primary key of the basket in the aqbasket table.
 499
 500 =back
 501
 502 =cut
 503
 504 sub DelBasket {
 505     my ( $basketno ) = @_;
 506     my $query = "DELETE FROM aqbasket WHERE basketno=?";
 507     my $dbh = C4::Context->dbh;
 508     my $sth = $dbh->prepare($query);
 509     $sth->execute($basketno);
 510     return;
 511 }
 512
 513 #------------------------------------------------------------#
 514
 515 =head3 ModBasket
 516
 517   &ModBasket($basketinfo);
 518
 519 Modifies a basket, using a hashref $basketinfo for the relevant information, only $basketinfo->{'basketno'} is required.
 520
 521 =over
 522
 523 =item C<$basketno> is the primary key of the basket in the aqbasket table.
 524
 525 =back
 526
 527 =cut
 528
 529 sub ModBasket {
 530     my $basketinfo = shift;
 531     my $query = "UPDATE aqbasket SET ";
 532     my @params;
 533     foreach my $key (keys %$basketinfo){
 534         if ($key ne 'basketno'){
 535             $query .= "$key=?, ";
 536             push(@params, $basketinfo->{$key} || undef );
 537         }
 538     }
 539 # get rid of the "," at the end of $query
 540     if (substr($query, length($query)-2) eq ', '){
 541         chop($query);
 542         chop($query);
 543         $query .= ' ';
 544     }
 545     $query .= "WHERE basketno=?";
 546     push(@params, $basketinfo->{'basketno'});
 547     my $dbh = C4::Context->dbh;
 548     my $sth = $dbh->prepare($query);
 549     $sth->execute(@params);
 550
 551     return;
 552 }
 553
 554 #------------------------------------------------------------#
 555
 556 =head3 ModBasketHeader
 557
 558   &ModBasketHeader($basketno, $basketname, $note, $booksellernote, $contractnumber, $booksellerid);
 559
 560 Modifies a basket's header.
 561
 562 =over
 563
 564 =item C<$basketno> is the "basketno" field in the "aqbasket" table;
 565
 566 =item C<$basketname> is the "basketname" field in the "aqbasket" table;
 567
 568 =item C<$note> is the "note" field in the "aqbasket" table;
 569
 570 =item C<$booksellernote> is the "booksellernote" field in the "aqbasket" table;
 571
 572 =item C<$contractnumber> is the "contractnumber" (foreign) key in the "aqbasket" table.
 573
 574 =item C<$booksellerid> is the id (foreign) key in the "aqbooksellers" table for the vendor.
 575
 576 =item C<$deliveryplace> is the "deliveryplace" field in the aqbasket table.
 577
 578 =item C<$billingplace> is the "billingplace" field in the aqbasket table.
 579
 580 =item C<$is_standing> is the "is_standing" field in the aqbasket table.
 581
 582 =item C<$create_items> should be set to 'ordering', 'receiving' or 'cataloguing' (or undef, in which
 583 case the AcqCreateItem syspref takes precedence).
 584
 585 =back
 586
 587 =cut
 588
 589 sub ModBasketHeader {
 590     my ($basketno, $basketname, $note, $booksellernote, $contractnumber, $booksellerid, $deliveryplace, $billingplace, $is_standing, $create_items) = @_;
 591
 592     $is_standing ||= 0;
 593     my $query = qq{
 594         UPDATE aqbasket
 595         SET basketname=?, note=?, booksellernote=?, booksellerid=?, deliveryplace=?, billingplace=?, is_standing=?, create_items=?
 596         WHERE basketno=?
 597     };
 598
 599     my $dbh = C4::Context->dbh;
 600     my $sth = $dbh->prepare($query);
 601     $sth->execute($basketname, $note, $booksellernote, $booksellerid, $deliveryplace, $billingplace, $is_standing, $create_items || undef, $basketno);
 602
 603     if ( $contractnumber ) {
 604         my $query2 ="UPDATE aqbasket SET contractnumber=? WHERE basketno=?";
 605         my $sth2 = $dbh->prepare($query2);
 606         $sth2->execute($contractnumber,$basketno);
 607     }
 608     return;
 609 }
 610
 611 #------------------------------------------------------------#
 612
 613 =head3 GetBasketsByBookseller
 614
 615   @results = &GetBasketsByBookseller($booksellerid, $extra);
 616
 617 Returns a list of hashes of all the baskets that belong to bookseller 'booksellerid'.
 618
 619 =over
 620
 621 =item C<$booksellerid> is the 'id' field of the bookseller in the aqbooksellers table
 622
 623 =item C<$extra> is the extra sql parameters, can be
 624
 625  $extra->{groupby}: group baskets by column
 626     ex. $extra->{groupby} = aqbasket.basketgroupid
 627  $extra->{orderby}: order baskets by column
 628  $extra->{limit}: limit number of results (can be helpful for pagination)
 629
 630 =back
 631
 632 =cut
 633
 634 sub GetBasketsByBookseller {
 635     my ($booksellerid, $extra) = @_;
 636     my $query = "SELECT * FROM aqbasket WHERE booksellerid=?";
 637     if ($extra){
 638         if ($extra->{groupby}) {
 639             $query .= " GROUP by $extra->{groupby}";
 640         }
 641         if ($extra->{orderby}){
 642             $query .= " ORDER by $extra->{orderby}";
 643         }
 644         if ($extra->{limit}){
 645             $query .= " LIMIT $extra->{limit}";
 646         }
 647     }
 648     my $dbh = C4::Context->dbh;
 649     my $sth = $dbh->prepare($query);
 650     $sth->execute($booksellerid);
 651     return $sth->fetchall_arrayref({});
 652 }
 653
 654 =head3 GetBasketsInfosByBookseller
 655
 656     my $baskets = GetBasketsInfosByBookseller($supplierid, $allbaskets);
 657
 658 The optional second parameter allbaskets is a boolean allowing you to
 659 select all baskets from the supplier; by default only active baskets (open or
 660 closed but still something to receive) are returned.
 661
 662 Returns in a arrayref of hashref all about booksellers baskets, plus:
 663     total_biblios: Number of distinct biblios in basket
 664     total_items: Number of items in basket
 665     expected_items: Number of non-received items in basket
 666
 667 =cut
 668
 669 sub GetBasketsInfosByBookseller {
 670     my ($supplierid, $allbaskets) = @_;
 671
 672     return unless $supplierid;
 673
 674     my $dbh = C4::Context->dbh;
 675     my $query = q{
 676         SELECT aqbasket.basketno, aqbasket.basketname, aqbasket.note, aqbasket.booksellernote, aqbasket.contractnumber, aqbasket.creationdate, aqbasket.closedate, aqbasket.booksellerid, aqbasket.authorisedby, aqbasket.booksellerinvoicenumber, aqbasket.basketgroupid, aqbasket.deliveryplace, aqbasket.billingplace, aqbasket.branch, aqbasket.is_standing, aqbasket.create_items,
 677           SUM(aqorders.quantity) AS total_items,
 678           SUM(
 679             IF ( aqorders.orderstatus = 'cancelled', aqorders.quantity, 0 )
 680           ) AS total_items_cancelled,
 681           COUNT(DISTINCT aqorders.biblionumber) AS total_biblios,
 682           SUM(
 683             IF(aqorders.datereceived IS NULL
 684               AND aqorders.datecancellationprinted IS NULL
 685             , aqorders.quantity
 686             , 0)
 687           ) AS expected_items,
 688         SUM( aqorders.uncertainprice ) AS uncertainprices
 689         FROM aqbasket
 690           LEFT JOIN aqorders ON aqorders.basketno = aqbasket.basketno
 691         WHERE booksellerid = ?};
 692
 693     $query.=" GROUP BY aqbasket.basketno, aqbasket.basketname, aqbasket.note, aqbasket.booksellernote, aqbasket.contractnumber, aqbasket.creationdate, aqbasket.closedate, aqbasket.booksellerid, aqbasket.authorisedby, aqbasket.booksellerinvoicenumber, aqbasket.basketgroupid, aqbasket.deliveryplace, aqbasket.billingplace, aqbasket.branch, aqbasket.is_standing, aqbasket.create_items";
 694
 695     unless ( $allbaskets ) {
 696         # Don't show the basket if it's NOT CLOSED or is FULLY RECEIVED
 697         $query.=" HAVING (closedate IS NULL OR (
 698           SUM(
 699             IF(aqorders.datereceived IS NULL
 700               AND aqorders.datecancellationprinted IS NULL
 701             , aqorders.quantity
 702             , 0)
 703             ) > 0))"
 704     }
 705
 706     my $sth = $dbh->prepare($query);
 707     $sth->execute($supplierid);
 708     my $baskets = $sth->fetchall_arrayref({});
 709
 710     # Retrieve the number of biblios cancelled
 711     my $cancelled_biblios = $dbh->selectall_hashref( q|
 712         SELECT COUNT(DISTINCT(biblionumber)) AS total_biblios_cancelled, aqbasket.basketno
 713         FROM aqbasket
 714         LEFT JOIN aqorders ON aqorders.basketno = aqbasket.basketno
 715         WHERE booksellerid = ?
 716         AND aqorders.orderstatus = 'cancelled'
 717         GROUP BY aqbasket.basketno
 718     |, 'basketno', {}, $supplierid );
 719     map {
 720         $_->{total_biblios_cancelled} = $cancelled_biblios->{$_->{basketno}}{total_biblios_cancelled} || 0
 721     } @$baskets;
 722
 723     return $baskets;
 724 }
 725
 726 =head3 GetBasketUsers
 727
 728     $basketusers_ids = &GetBasketUsers($basketno);
 729
 730 Returns a list of all borrowernumbers that are in basket users list
 731
 732 =cut
 733
 734 sub GetBasketUsers {
 735     my $basketno = shift;
 736
 737     return unless $basketno;
 738
 739     my $query = qq{
 740         SELECT borrowernumber
 741         FROM aqbasketusers
 742         WHERE basketno = ?
 743     };
 744     my $dbh = C4::Context->dbh;
 745     my $sth = $dbh->prepare($query);
 746     $sth->execute($basketno);
 747     my $results = $sth->fetchall_arrayref( {} );
 748
 749     my @borrowernumbers;
 750     foreach (@$results) {
 751         push @borrowernumbers, $_->{'borrowernumber'};
 752     }
 753
 754     return @borrowernumbers;
 755 }
 756
 757 =head3 ModBasketUsers
 758
 759     my @basketusers_ids = (1, 2, 3);
 760     &ModBasketUsers($basketno, @basketusers_ids);
 761
 762 Delete all users from basket users list, and add users in C<@basketusers_ids>
 763 to this users list.
 764
 765 =cut
 766
 767 sub ModBasketUsers {
 768     my ($basketno, @basketusers_ids) = @_;
 769
 770     return unless $basketno;
 771
 772     my $dbh = C4::Context->dbh;
 773     my $query = qq{
 774         DELETE FROM aqbasketusers
 775         WHERE basketno = ?
 776     };
 777     my $sth = $dbh->prepare($query);
 778     $sth->execute($basketno);
 779
 780     $query = qq{
 781         INSERT INTO aqbasketusers (basketno, borrowernumber)
 782         VALUES (?, ?)
 783     };
 784     $sth = $dbh->prepare($query);
 785     foreach my $basketuser_id (@basketusers_ids) {
 786         $sth->execute($basketno, $basketuser_id);
 787     }
 788     return;
 789 }
 790
 791 =head3 CanUserManageBasket
 792
 793     my $bool = CanUserManageBasket($borrower, $basket[, $userflags]);
 794     my $bool = CanUserManageBasket($borrowernumber, $basketno[, $userflags]);
 795
 796 Check if a borrower can manage a basket, according to system preference
 797 AcqViewBaskets, user permissions and basket properties (creator, users list,
 798 branch).
 799
 800 First parameter can be either a borrowernumber or a hashref as returned by
 801 Koha::Patron->unblessed
 802
 803 Second parameter can be either a basketno or a hashref as returned by
 804 C4::Acquisition::GetBasket.
 805
 806 The third parameter is optional. If given, it should be a hashref as returned
 807 by C4::Auth::getuserflags. If not, getuserflags is called.
 808
 809 If user is authorised to manage basket, returns 1.
 810 Otherwise returns 0.
 811
 812 =cut
 813
 814 sub CanUserManageBasket {
 815     my ($borrower, $basket, $userflags) = @_;
 816
 817     if (!ref $borrower) {
 818         # FIXME This needs to be replaced
 819         # We should not accept both scalar and array
 820         # Tests need to be updated
 821         $borrower = Koha::Patrons->find( $borrower )->unblessed;
 822     }
 823     if (!ref $basket) {
 824         $basket = GetBasket($basket);
 825     }
 826
 827     return 0 unless ($basket and $borrower);
 828
 829     my $borrowernumber = $borrower->{borrowernumber};
 830     my $basketno = $basket->{basketno};
 831
 832     my $AcqViewBaskets = C4::Context->preference('AcqViewBaskets');
 833
 834     if (!defined $userflags) {
 835         my $dbh = C4::Context->dbh;
 836         my $sth = $dbh->prepare("SELECT flags FROM borrowers WHERE borrowernumber = ?");
 837         $sth->execute($borrowernumber);
 838         my ($flags) = $sth->fetchrow_array;
 839         $sth->finish;
 840
 841         $userflags = C4::Auth::getuserflags($flags, $borrower->{userid}, $dbh);
 842     }
 843
 844     unless ($userflags->{superlibrarian}
 845     || (ref $userflags->{acquisition} && $userflags->{acquisition}->{order_manage_all})
 846     || (!ref $userflags->{acquisition} && $userflags->{acquisition}))
 847     {
 848         if (not exists $userflags->{acquisition}) {
 849             return 0;
 850         }
 851
 852         if ( (ref $userflags->{acquisition} && !$userflags->{acquisition}->{order_manage})
 853         || (!ref $userflags->{acquisition} && !$userflags->{acquisition}) ) {
 854             return 0;
 855         }
 856
 857         if ($AcqViewBaskets eq 'user'
 858         && $basket->{authorisedby} != $borrowernumber
 859         && ! grep { $borrowernumber eq $_ } GetBasketUsers($basketno)) {
 860              return 0;
 861         }
 862
 863         if ($AcqViewBaskets eq 'branch' && defined $basket->{branch}
 864         && $basket->{branch} ne $borrower->{branchcode}) {
 865             return 0;
 866         }
 867     }
 868
 869     return 1;
 870 }
 871
 872 #------------------------------------------------------------#
 873
 874 =head3 GetBasketsByBasketgroup
 875
 876   $baskets = &GetBasketsByBasketgroup($basketgroupid);
 877
 878 Returns a reference to all baskets that belong to basketgroup $basketgroupid.
 879
 880 =cut
 881
 882 sub GetBasketsByBasketgroup {
 883     my $basketgroupid = shift;
 884     my $query = qq{
 885         SELECT *, aqbasket.booksellerid as booksellerid
 886         FROM aqbasket
 887         LEFT JOIN aqcontract USING(contractnumber) WHERE basketgroupid=?
 888     };
 889     my $dbh = C4::Context->dbh;
 890     my $sth = $dbh->prepare($query);
 891     $sth->execute($basketgroupid);
 892     return $sth->fetchall_arrayref({});
 893 }
 894
 895 #------------------------------------------------------------#
 896
 897 =head3 NewBasketgroup
 898
 899   $basketgroupid = NewBasketgroup(\%hashref);
 900
 901 Adds a basketgroup to the aqbasketgroups table, and add the initial baskets to it.
 902
 903 $hashref->{'booksellerid'} is the 'id' field of the bookseller in the aqbooksellers table,
 904
 905 $hashref->{'name'} is the 'name' field of the basketgroup in the aqbasketgroups table,
 906
 907 $hashref->{'basketlist'} is a list reference of the 'id's of the baskets that belong to this group,
 908
 909 $hashref->{'billingplace'} is the 'billingplace' field of the basketgroup in the aqbasketgroups table,
 910
 911 $hashref->{'deliveryplace'} is the 'deliveryplace' field of the basketgroup in the aqbasketgroups table,
 912
 913 $hashref->{'freedeliveryplace'} is the 'freedeliveryplace' field of the basketgroup in the aqbasketgroups table,
 914
 915 $hashref->{'deliverycomment'} is the 'deliverycomment' field of the basketgroup in the aqbasketgroups table,
 916
 917 $hashref->{'closed'} is the 'closed' field of the aqbasketgroups table, it is false if 0, true otherwise.
 918
 919 =cut
 920
 921 sub NewBasketgroup {
 922     my $basketgroupinfo = shift;
 923     die "booksellerid is required to create a basketgroup" unless $basketgroupinfo->{'booksellerid'};
 924     my $query = "INSERT INTO aqbasketgroups (";
 925     my @params;
 926     foreach my $field (qw(name billingplace deliveryplace freedeliveryplace deliverycomment closed)) {
 927         if ( defined $basketgroupinfo->{$field} ) {
 928             $query .= "$field, ";
 929             push(@params, $basketgroupinfo->{$field});
 930         }
 931     }
 932     $query .= "booksellerid) VALUES (";
 933     foreach (@params) {
 934         $query .= "?, ";
 935     }
 936     $query .= "?)";
 937     push(@params, $basketgroupinfo->{'booksellerid'});
 938     my $dbh = C4::Context->dbh;
 939     my $sth = $dbh->prepare($query);
 940     $sth->execute(@params);
 941     my $basketgroupid = $dbh->{'mysql_insertid'};
 942     if( $basketgroupinfo->{'basketlist'} ) {
 943         foreach my $basketno (@{$basketgroupinfo->{'basketlist'}}) {
 944             my $query2 = "UPDATE aqbasket SET basketgroupid=? WHERE basketno=?";
 945             my $sth2 = $dbh->prepare($query2);
 946             $sth2->execute($basketgroupid, $basketno);
 947         }
 948     }
 949     return $basketgroupid;
 950 }
 951
 952 #------------------------------------------------------------#
 953
 954 =head3 ModBasketgroup
 955
 956   ModBasketgroup(\%hashref);
 957
 958 Modifies a basketgroup in the aqbasketgroups table, and add the baskets to it.
 959
 960 $hashref->{'id'} is the 'id' field of the basketgroup in the aqbasketgroup table, this parameter is mandatory,
 961
 962 $hashref->{'name'} is the 'name' field of the basketgroup in the aqbasketgroups table,
 963
 964 $hashref->{'basketlist'} is a list reference of the 'id's of the baskets that belong to this group,
 965
 966 $hashref->{'billingplace'} is the 'billingplace' field of the basketgroup in the aqbasketgroups table,
 967
 968 $hashref->{'deliveryplace'} is the 'deliveryplace' field of the basketgroup in the aqbasketgroups table,
 969
 970 $hashref->{'freedeliveryplace'} is the 'freedeliveryplace' field of the basketgroup in the aqbasketgroups table,
 971
 972 $hashref->{'deliverycomment'} is the 'deliverycomment' field of the basketgroup in the aqbasketgroups table,
 973
 974 $hashref->{'closed'} is the 'closed' field of the aqbasketgroups table, it is false if 0, true otherwise.
 975
 976 =cut
 977
 978 sub ModBasketgroup {
 979     my $basketgroupinfo = shift;
 980     die "basketgroup id is required to edit a basketgroup" unless $basketgroupinfo->{'id'};
 981     my $dbh = C4::Context->dbh;
 982     my $query = "UPDATE aqbasketgroups SET ";
 983     my @params;
 984     foreach my $field (qw(name billingplace deliveryplace freedeliveryplace deliverycomment closed)) {
 985         if ( defined $basketgroupinfo->{$field} ) {
 986             $query .= "$field=?, ";
 987             push(@params, $basketgroupinfo->{$field});
 988         }
 989     }
 990     chop($query);
 991     chop($query);
 992     $query .= " WHERE id=?";
 993     push(@params, $basketgroupinfo->{'id'});
 994     my $sth = $dbh->prepare($query);
 995     $sth->execute(@params);
 996
 997     $sth = $dbh->prepare('UPDATE aqbasket SET basketgroupid = NULL WHERE basketgroupid = ?');
 998     $sth->execute($basketgroupinfo->{'id'});
 999
1000     if($basketgroupinfo->{'basketlist'} && @{$basketgroupinfo->{'basketlist'}}){
1001         $sth = $dbh->prepare("UPDATE aqbasket SET basketgroupid=? WHERE basketno=?");
1002         foreach my $basketno (@{$basketgroupinfo->{'basketlist'}}) {
1003             $sth->execute($basketgroupinfo->{'id'}, $basketno);
1004         }
1005     }
1006     return;
1007 }
1008
1009 #------------------------------------------------------------#
1010
1011 =head3 DelBasketgroup
1012
1013   DelBasketgroup($basketgroupid);
1014
1015 Deletes a basketgroup in the aqbasketgroups table, and removes the reference to it from the baskets,
1016
1017 =over
1018
1019 =item C<$basketgroupid> is the 'id' field of the basket in the aqbasketgroup table
1020
1021 =back
1022
1023 =cut
1024
1025 sub DelBasketgroup {
1026     my $basketgroupid = shift;
1027     die "basketgroup id is required to edit a basketgroup" unless $basketgroupid;
1028     my $query = "DELETE FROM aqbasketgroups WHERE id=?";
1029     my $dbh = C4::Context->dbh;
1030     my $sth = $dbh->prepare($query);
1031     $sth->execute($basketgroupid);
1032     return;
1033 }
1034
1035 #------------------------------------------------------------#
1036
1037
1038 =head2 FUNCTIONS ABOUT ORDERS
1039
1040 =head3 GetBasketgroup
1041
1042   $basketgroup = &GetBasketgroup($basketgroupid);
1043
1044 Returns a reference to the hash containing all information about the basketgroup.
1045
1046 =cut
1047
1048 sub GetBasketgroup {
1049     my $basketgroupid = shift;
1050     die "basketgroup id is required to edit a basketgroup" unless $basketgroupid;
1051     my $dbh = C4::Context->dbh;
1052     my $result_set = $dbh->selectall_arrayref(
1053         'SELECT * FROM aqbasketgroups WHERE id=?',
1054         { Slice => {} },
1055         $basketgroupid
1056     );
1057     return $result_set->[0];    # id is unique
1058 }
1059
1060 #------------------------------------------------------------#
1061
1062 =head3 GetBasketgroups
1063
1064   $basketgroups = &GetBasketgroups($booksellerid);
1065
1066 Returns a reference to the array of all the basketgroups of bookseller $booksellerid.
1067
1068 =cut
1069
1070 sub GetBasketgroups {
1071     my $booksellerid = shift;
1072     die 'bookseller id is required to edit a basketgroup' unless $booksellerid;
1073     my $query = 'SELECT * FROM aqbasketgroups WHERE booksellerid=? ORDER BY id DESC';
1074     my $dbh = C4::Context->dbh;
1075     my $sth = $dbh->prepare($query);
1076     $sth->execute($booksellerid);
1077     return $sth->fetchall_arrayref({});
1078 }
1079
1080 #------------------------------------------------------------#
1081
1082 =head2 FUNCTIONS ABOUT ORDERS
1083
1084 =head3 GetOrders
1085
1086   @orders = &GetOrders( $basketno, { orderby => 'biblio.title', cancelled => 0|1 } );
1087
1088 Looks up the pending (non-cancelled) orders with the given basket
1089 number.
1090
1091 If cancelled is set, only cancelled orders will be returned.
1092
1093 =cut
1094
1095 sub GetOrders {
1096     my ( $basketno, $params ) = @_;
1097
1098     return () unless $basketno;
1099
1100     my $orderby = $params->{orderby};
1101     my $cancelled = $params->{cancelled} || 0;
1102
1103     my $dbh   = C4::Context->dbh;
1104     my $query = q|
1105         SELECT biblio.*,biblioitems.*,
1106                 aqorders.*,
1107                 aqbudgets.*,
1108         |;
1109     $query .= $cancelled
1110       ? q|
1111                 aqorders_transfers.ordernumber_to AS transferred_to,
1112                 aqorders_transfers.timestamp AS transferred_to_timestamp
1113     |
1114       : q|
1115                 aqorders_transfers.ordernumber_from AS transferred_from,
1116                 aqorders_transfers.timestamp AS transferred_from_timestamp
1117     |;
1118     $query .= q|
1119         FROM    aqorders
1120             LEFT JOIN aqbudgets        ON aqbudgets.budget_id = aqorders.budget_id
1121             LEFT JOIN biblio           ON biblio.biblionumber = aqorders.biblionumber
1122             LEFT JOIN biblioitems      ON biblioitems.biblionumber =biblio.biblionumber
1123     |;
1124     $query .= $cancelled
1125       ? q|
1126             LEFT JOIN aqorders_transfers ON aqorders_transfers.ordernumber_from = aqorders.ordernumber
1127     |
1128       : q|
1129             LEFT JOIN aqorders_transfers ON aqorders_transfers.ordernumber_to = aqorders.ordernumber
1130
1131     |;
1132     $query .= q|
1133         WHERE   basketno=?
1134     |;
1135
1136     if ($cancelled) {
1137         $orderby ||= q|biblioitems.publishercode, biblio.title|;
1138         $query .= q|
1139             AND datecancellationprinted IS NOT NULL
1140         |;
1141     }
1142     else {
1143         $orderby ||=
1144           q|aqorders.datecancellationprinted desc, aqorders.timestamp desc|;
1145         $query .= q|
1146             AND datecancellationprinted IS NULL
1147         |;
1148     }
1149
1150     $query .= " ORDER BY $orderby";
1151     my $orders =
1152       $dbh->selectall_arrayref( $query, { Slice => {} }, $basketno );
1153     return @{$orders};
1154
1155 }
1156
1157 #------------------------------------------------------------#
1158
1159 =head3 GetOrdersByBiblionumber
1160
1161   @orders = &GetOrdersByBiblionumber($biblionumber);
1162
1163 Looks up the orders with linked to a specific $biblionumber, including
1164 cancelled orders and received orders.
1165
1166 return :
1167 C<@orders> is an array of references-to-hash, whose keys are the
1168 fields from the aqorders, biblio, and biblioitems tables in the Koha database.
1169
1170 =cut
1171
1172 sub GetOrdersByBiblionumber {
1173     my $biblionumber = shift;
1174     return unless $biblionumber;
1175     my $dbh   = C4::Context->dbh;
1176     my $query  ="
1177         SELECT biblio.*,biblioitems.*,
1178                 aqorders.*,
1179                 aqbudgets.*
1180         FROM    aqorders
1181             LEFT JOIN aqbudgets        ON aqbudgets.budget_id = aqorders.budget_id
1182             LEFT JOIN biblio           ON biblio.biblionumber = aqorders.biblionumber
1183             LEFT JOIN biblioitems      ON biblioitems.biblionumber =biblio.biblionumber
1184         WHERE   aqorders.biblionumber=?
1185     ";
1186     my $result_set =
1187       $dbh->selectall_arrayref( $query, { Slice => {} }, $biblionumber );
1188     return @{$result_set};
1189
1190 }
1191
1192 #------------------------------------------------------------#
1193
1194 =head3 GetOrder
1195
1196   $order = &GetOrder($ordernumber);
1197
1198 Looks up an order by order number.
1199
1200 Returns a reference-to-hash describing the order. The keys of
1201 C<$order> are fields from the biblio, biblioitems, aqorders tables of the Koha database.
1202
1203 =cut
1204
1205 sub GetOrder {
1206     my ($ordernumber) = @_;
1207     return unless $ordernumber;
1208
1209     my $dbh      = C4::Context->dbh;
1210     my $query = qq{SELECT
1211                 aqorders.*,
1212                 biblio.title,
1213                 biblio.author,
1214                 aqbasket.basketname,
1215                 borrowers.branchcode,
1216                 biblioitems.publicationyear,
1217                 biblio.copyrightdate,
1218                 biblioitems.editionstatement,
1219                 biblioitems.isbn,
1220                 biblioitems.ean,
1221                 biblio.seriestitle,
1222                 biblioitems.publishercode,
1223                 aqorders.rrp              AS unitpricesupplier,
1224                 aqorders.ecost            AS unitpricelib,
1225                 aqorders.claims_count     AS claims_count,
1226                 aqorders.claimed_date     AS claimed_date,
1227                 aqbudgets.budget_name     AS budget,
1228                 aqbooksellers.name        AS supplier,
1229                 aqbooksellers.id          AS supplierid,
1230                 biblioitems.publishercode AS publisher,
1231                 ADDDATE(aqbasket.closedate, INTERVAL aqbooksellers.deliverytime DAY) AS estimateddeliverydate,
1232                 DATE(aqbasket.closedate)  AS orderdate,
1233                 aqorders.quantity - COALESCE(aqorders.quantityreceived,0)                 AS quantity_to_receive,
1234                 (aqorders.quantity - COALESCE(aqorders.quantityreceived,0)) * aqorders.rrp AS subtotal,
1235                 DATEDIFF(CURDATE( ),closedate) AS latesince
1236                 FROM aqorders LEFT JOIN biblio ON biblio.biblionumber = aqorders.biblionumber
1237                 LEFT JOIN biblioitems ON biblioitems.biblionumber = biblio.biblionumber
1238                 LEFT JOIN aqbudgets ON aqorders.budget_id = aqbudgets.budget_id,
1239                 aqbasket LEFT JOIN borrowers  ON aqbasket.authorisedby = borrowers.borrowernumber
1240                 LEFT JOIN aqbooksellers       ON aqbasket.booksellerid = aqbooksellers.id
1241                 WHERE aqorders.basketno = aqbasket.basketno
1242                     AND ordernumber=?};
1243     my $result_set =
1244       $dbh->selectall_arrayref( $query, { Slice => {} }, $ordernumber );
1245
1246     # result_set assumed to contain 1 match
1247     return $result_set->[0];
1248 }
1249
1250 =head3 GetLastOrderNotReceivedFromSubscriptionid
1251
1252   $order = &GetLastOrderNotReceivedFromSubscriptionid($subscriptionid);
1253
1254 Returns a reference-to-hash describing the last order not received for a subscription.
1255
1256 =cut
1257
1258 sub GetLastOrderNotReceivedFromSubscriptionid {
1259     my ( $subscriptionid ) = @_;
1260     my $dbh                = C4::Context->dbh;
1261     my $query              = qq|
1262         SELECT * FROM aqorders
1263         LEFT JOIN subscription
1264             ON ( aqorders.subscriptionid = subscription.subscriptionid )
1265         WHERE aqorders.subscriptionid = ?
1266             AND aqorders.datereceived IS NULL
1267         LIMIT 1
1268     |;
1269     my $result_set =
1270       $dbh->selectall_arrayref( $query, { Slice => {} }, $subscriptionid );
1271
1272     # result_set assumed to contain 1 match
1273     return $result_set->[0];
1274 }
1275
1276 =head3 GetLastOrderReceivedFromSubscriptionid
1277
1278   $order = &GetLastOrderReceivedFromSubscriptionid($subscriptionid);
1279
1280 Returns a reference-to-hash describing the last order received for a subscription.
1281
1282 =cut
1283
1284 sub GetLastOrderReceivedFromSubscriptionid {
1285     my ( $subscriptionid ) = @_;
1286     my $dbh                = C4::Context->dbh;
1287     my $query              = qq|
1288         SELECT * FROM aqorders
1289         LEFT JOIN subscription
1290             ON ( aqorders.subscriptionid = subscription.subscriptionid )
1291         WHERE aqorders.subscriptionid = ?
1292             AND aqorders.datereceived =
1293                 (
1294                     SELECT MAX( aqorders.datereceived )
1295                     FROM aqorders
1296                     LEFT JOIN subscription
1297                         ON ( aqorders.subscriptionid = subscription.subscriptionid )
1298                         WHERE aqorders.subscriptionid = ?
1299                             AND aqorders.datereceived IS NOT NULL
1300                 )
1301         ORDER BY ordernumber DESC
1302         LIMIT 1
1303     |;
1304     my $result_set =
1305       $dbh->selectall_arrayref( $query, { Slice => {} }, $subscriptionid, $subscriptionid );
1306
1307     # result_set assumed to contain 1 match
1308     return $result_set->[0];
1309
1310 }
1311
1312 #------------------------------------------------------------#
1313
1314 =head3 ModOrder
1315
1316   &ModOrder(\%hashref);
1317
1318 Modifies an existing order. Updates the order with order number
1319 $hashref->{'ordernumber'} and biblionumber $hashref->{'biblionumber'}. All
1320 other keys of the hash update the fields with the same name in the aqorders
1321 table of the Koha database.
1322
1323 =cut
1324
1325 sub ModOrder {
1326     my $orderinfo = shift;
1327
1328     die "Ordernumber is required" if $orderinfo->{'ordernumber'} eq '';
1329
1330     my $dbh = C4::Context->dbh;
1331     my @params;
1332
1333     # update uncertainprice to an integer, just in case (under FF, checked boxes have the value "ON" by default)
1334     $orderinfo->{uncertainprice}=1 if $orderinfo->{uncertainprice};
1335
1336 #    delete($orderinfo->{'branchcode'});
1337     # the hash contains a lot of entries not in aqorders, so get the columns ...
1338     my $sth = $dbh->prepare("SELECT * FROM aqorders LIMIT 1;");
1339     $sth->execute;
1340     my $colnames = $sth->{NAME};
1341         #FIXME Be careful. If aqorders would have columns with diacritics,
1342         #you should need to decode what you get back from NAME.
1343         #See report 10110 and guided_reports.pl
1344     my $query = "UPDATE aqorders SET ";
1345
1346     foreach my $orderinfokey (grep(!/ordernumber/, keys %$orderinfo)){
1347         # ... and skip hash entries that are not in the aqorders table
1348         # FIXME : probably not the best way to do it (would be better to have a correct hash)
1349         next unless grep { $_ eq $orderinfokey } @$colnames;
1350             $query .= "$orderinfokey=?, ";
1351             push(@params, $orderinfo->{$orderinfokey});
1352     }
1353
1354     $query .= "timestamp=NOW()  WHERE  ordernumber=?";
1355     push(@params, $orderinfo->{'ordernumber'} );
1356     $sth = $dbh->prepare($query);
1357     $sth->execute(@params);
1358     return;
1359 }
1360
1361 #------------------------------------------------------------#
1362
1363 =head3 ModItemOrder
1364
1365     ModItemOrder($itemnumber, $ordernumber);
1366
1367 Modifies the ordernumber of an item in aqorders_items.
1368
1369 =cut
1370
1371 sub ModItemOrder {
1372     my ($itemnumber, $ordernumber) = @_;
1373
1374     return unless ($itemnumber and $ordernumber);
1375
1376     my $dbh = C4::Context->dbh;
1377     my $query = qq{
1378         UPDATE aqorders_items
1379         SET ordernumber = ?
1380         WHERE itemnumber = ?
1381     };
1382     my $sth = $dbh->prepare($query);
1383     return $sth->execute($ordernumber, $itemnumber);
1384 }
1385
1386 #------------------------------------------------------------#
1387
1388 =head3 ModReceiveOrder
1389
1390     my ( $date_received, $new_ordernumber ) = ModReceiveOrder(
1391         {
1392             biblionumber         => $biblionumber,
1393             order                => $order,
1394             quantityreceived     => $quantityreceived,
1395             user                 => $user,
1396             invoice              => $invoice,
1397             budget_id            => $budget_id,
1398             datereceived         => $datereceived,
1399             received_itemnumbers => \@received_itemnumbers,
1400         }
1401     );
1402
1403 Updates an order, to reflect the fact that it was received, at least
1404 in part.
1405
1406 If a partial order is received, splits the order into two.
1407
1408 Updates the order with biblionumber C<$biblionumber> and ordernumber
1409 C<$order->{ordernumber}>.
1410
1411 =cut
1412
1413
1414 sub ModReceiveOrder {
1415     my ($params)       = @_;
1416     my $biblionumber   = $params->{biblionumber};
1417     my $order          = { %{ $params->{order} } }; # Copy the order, we don't want to modify it
1418     my $invoice        = $params->{invoice};
1419     my $quantrec       = $params->{quantityreceived};
1420     my $user           = $params->{user};
1421     my $budget_id      = $params->{budget_id};
1422     my $datereceived   = $params->{datereceived};
1423     my $received_items = $params->{received_items};
1424
1425     my $dbh = C4::Context->dbh;
1426     $datereceived = output_pref(
1427         {
1428             dt => ( $datereceived ? dt_from_string( $datereceived ) : dt_from_string ),
1429             dateformat => 'iso',
1430             dateonly => 1,
1431         }
1432     );
1433
1434     my $suggestionid = GetSuggestionFromBiblionumber( $biblionumber );
1435     if ($suggestionid) {
1436         ModSuggestion( {suggestionid=>$suggestionid,
1437                         STATUS=>'AVAILABLE',
1438                         biblionumber=> $biblionumber}
1439                         );
1440     }
1441
1442     my $result_set = $dbh->selectrow_arrayref(
1443             q{SELECT aqbasket.is_standing
1444             FROM aqbasket
1445             WHERE basketno=?},{ Slice => {} }, $order->{basketno});
1446     my $is_standing = $result_set->[0];  # we assume we have a unique basket
1447
1448     my $new_ordernumber = $order->{ordernumber};
1449     if ( $is_standing || $order->{quantity} > $quantrec ) {
1450         # Split order line in two parts: the first is the original order line
1451         # without received items (the quantity is decreased),
1452         # the second part is a new order line with quantity=quantityrec
1453         # (entirely received)
1454         my $query = q|
1455             UPDATE aqorders
1456             SET quantity = ?,
1457                 orderstatus = 'partial'|;
1458         $query .= q| WHERE ordernumber = ?|;
1459         my $sth = $dbh->prepare($query);
1460
1461         $sth->execute(
1462             ( $is_standing ? 1 : ($order->{quantity} - $quantrec) ),
1463             $order->{ordernumber}
1464         );
1465
1466         if ( not $order->{subscriptionid} && defined $order->{order_internalnote} ) {
1467             $dbh->do(
1468                 q|UPDATE aqorders
1469                 SET order_internalnote = ?
1470                 WHERE ordernumber = ?|, {},
1471                 $order->{order_internalnote}, $order->{ordernumber}
1472             );
1473         }
1474
1475         # Recalculate tax_value
1476         $dbh->do(q|
1477             UPDATE aqorders
1478             SET
1479                 tax_value_on_ordering = quantity * | . get_rounding_sql(q|ecost_tax_excluded|) . q| * tax_rate_on_ordering,
1480                 tax_value_on_receiving = quantity * | . get_rounding_sql(q|unitprice_tax_excluded|) . q| * tax_rate_on_receiving
1481             WHERE ordernumber = ?
1482         |, undef, $order->{ordernumber});
1483
1484         delete $order->{ordernumber};
1485         $order->{budget_id} = ( $budget_id || $order->{budget_id} );
1486         $order->{quantity} = $quantrec;
1487         $order->{quantityreceived} = $quantrec;
1488         $order->{ecost_tax_excluded} //= 0;
1489         $order->{tax_rate_on_ordering} //= 0;
1490         $order->{unitprice_tax_excluded} //= 0;
1491         $order->{tax_rate_on_receiving} //= 0;
1492         $order->{tax_value_on_ordering} = $order->{quantity} * get_rounded_price($order->{ecost_tax_excluded}) * $order->{tax_rate_on_ordering};
1493         $order->{tax_value_on_receiving} = $order->{quantity} * get_rounded_price($order->{unitprice_tax_excluded}) * $order->{tax_rate_on_receiving};
1494         $order->{datereceived} = $datereceived;
1495         $order->{invoiceid} = $invoice->{invoiceid};
1496         $order->{orderstatus} = 'complete';
1497         $new_ordernumber = Koha::Acquisition::Order->new($order)->store->ordernumber; # TODO What if the store fails?
1498
1499         if ($received_items) {
1500             foreach my $itemnumber (@$received_items) {
1501                 ModItemOrder($itemnumber, $new_ordernumber);
1502             }
1503         }
1504     } else {
1505         my $query = q|
1506             UPDATE aqorders
1507             SET quantityreceived = ?,
1508                 datereceived = ?,
1509                 invoiceid = ?,
1510                 budget_id = ?,
1511                 orderstatus = 'complete'
1512         |;
1513
1514         $query .= q|
1515             , replacementprice = ?
1516         | if defined $order->{replacementprice};
1517
1518         $query .= q|
1519             , unitprice = ?, unitprice_tax_included = ?, unitprice_tax_excluded = ?
1520         | if defined $order->{unitprice};
1521
1522         $query .= q|
1523             ,tax_value_on_receiving = ?
1524         | if defined $order->{tax_value_on_receiving};
1525
1526         $query .= q|
1527             ,tax_rate_on_receiving = ?
1528         | if defined $order->{tax_rate_on_receiving};
1529
1530         $query .= q|
1531             , order_internalnote = ?
1532         | if defined $order->{order_internalnote};
1533
1534         $query .= q| where biblionumber=? and ordernumber=?|;
1535
1536         my $sth = $dbh->prepare( $query );
1537         my @params = ( $quantrec, $datereceived, $invoice->{invoiceid}, ( $budget_id ? $budget_id : $order->{budget_id} ) );
1538
1539         if ( defined $order->{replacementprice} ) {
1540             push @params, $order->{replacementprice};
1541         }
1542
1543         if ( defined $order->{unitprice} ) {
1544             push @params, $order->{unitprice}, $order->{unitprice_tax_included}, $order->{unitprice_tax_excluded};
1545         }
1546
1547         if ( defined $order->{tax_value_on_receiving} ) {
1548             push @params, $order->{tax_value_on_receiving};
1549         }
1550
1551         if ( defined $order->{tax_rate_on_receiving} ) {
1552             push @params, $order->{tax_rate_on_receiving};
1553         }
1554
1555         if ( defined $order->{order_internalnote} ) {
1556             push @params, $order->{order_internalnote};
1557         }
1558
1559         push @params, ( $biblionumber, $order->{ordernumber} );
1560
1561         $sth->execute( @params );
1562
1563         # All items have been received, sent a notification to users
1564         NotifyOrderUsers( $order->{ordernumber} );
1565
1566     }
1567     return ($datereceived, $new_ordernumber);
1568 }
1569
1570 =head3 CancelReceipt
1571
1572     my $parent_ordernumber = CancelReceipt($ordernumber);
1573
1574     Cancel an order line receipt and update the parent order line, as if no
1575     receipt was made.
1576     If items are created at receipt (AcqCreateItem = receiving) then delete
1577     these items.
1578
1579 =cut
1580
1581 sub CancelReceipt {
1582     my $ordernumber = shift;
1583
1584     return unless $ordernumber;
1585
1586     my $dbh = C4::Context->dbh;
1587     my $query = qq{
1588         SELECT datereceived, parent_ordernumber, quantity
1589         FROM aqorders
1590         WHERE ordernumber = ?
1591     };
1592     my $sth = $dbh->prepare($query);
1593     $sth->execute($ordernumber);
1594     my $order = $sth->fetchrow_hashref;
1595     unless($order) {
1596         warn "CancelReceipt: order $ordernumber does not exist";
1597         return;
1598     }
1599     unless($order->{'datereceived'}) {
1600         warn "CancelReceipt: order $ordernumber is not received";
1601         return;
1602     }
1603
1604     my $parent_ordernumber = $order->{'parent_ordernumber'};
1605
1606     my $order_obj = Koha::Acquisition::Orders->find( $ordernumber ); # FIXME rewrite all this subroutine using this object
1607     my @itemnumbers = $order_obj->items->get_column('itemnumber');
1608
1609     if($parent_ordernumber == $ordernumber || not $parent_ordernumber) {
1610         # The order line has no parent, just mark it as not received
1611         $query = qq{
1612             UPDATE aqorders
1613             SET quantityreceived = ?,
1614                 datereceived = ?,
1615                 invoiceid = ?,
1616                 orderstatus = 'ordered'
1617             WHERE ordernumber = ?
1618         };
1619         $sth = $dbh->prepare($query);
1620         $sth->execute(0, undef, undef, $ordernumber);
1621         _cancel_items_receipt( $order_obj );
1622     } else {
1623         # The order line has a parent, increase parent quantity and delete
1624         # the order line.
1625         unless ( $order_obj->basket->is_standing ) {
1626             $query = qq{
1627                 SELECT quantity, datereceived
1628                 FROM aqorders
1629                 WHERE ordernumber = ?
1630             };
1631             $sth = $dbh->prepare($query);
1632             $sth->execute($parent_ordernumber);
1633             my $parent_order = $sth->fetchrow_hashref;
1634             unless($parent_order) {
1635                 warn "Parent order $parent_ordernumber does not exist.";
1636                 return;
1637             }
1638             if($parent_order->{'datereceived'}) {
1639                 warn "CancelReceipt: parent order is received.".
1640                     " Can't cancel receipt.";
1641                 return;
1642             }
1643             $query = qq{
1644                 UPDATE aqorders
1645                 SET quantity = ?,
1646                     orderstatus = 'ordered'
1647                 WHERE ordernumber = ?
1648             };
1649             $sth = $dbh->prepare($query);
1650             my $rv = $sth->execute(
1651                 $order->{'quantity'} + $parent_order->{'quantity'},
1652                 $parent_ordernumber
1653             );
1654             unless($rv) {
1655                 warn "Cannot update parent order line, so do not cancel".
1656                     " receipt";
1657                 return;
1658             }
1659
1660             # Recalculate tax_value
1661             $dbh->do(q|
1662                 UPDATE aqorders
1663                 SET
1664                     tax_value_on_ordering = quantity * | . get_rounding_sql(q|ecost_tax_excluded|) . q| * tax_rate_on_ordering,
1665                     tax_value_on_receiving = quantity * | . get_rounding_sql(q|unitprice_tax_excluded|) . q| * tax_rate_on_receiving
1666                 WHERE ordernumber = ?
1667             |, undef, $parent_ordernumber);
1668         }
1669
1670         _cancel_items_receipt( $order_obj, $parent_ordernumber );
1671         # Delete order line
1672         $query = qq{
1673             DELETE FROM aqorders
1674             WHERE ordernumber = ?
1675         };
1676         $sth = $dbh->prepare($query);
1677         $sth->execute($ordernumber);
1678
1679     }
1680
1681     if( $order_obj->basket->effective_create_items eq 'ordering' ) {
1682         my @affects = split q{\|}, C4::Context->preference("AcqItemSetSubfieldsWhenReceiptIsCancelled");
1683         if ( @affects ) {
1684             for my $in ( @itemnumbers ) {
1685                 my $item = Koha::Items->find( $in ); # FIXME We do not need that, we already have Koha::Items from $order_obj->items
1686                 my $biblio = $item->biblio;
1687                 my ( $itemfield ) = GetMarcFromKohaField( 'items.itemnumber' );
1688                 my $item_marc = C4::Items::GetMarcItem( $biblio->biblionumber, $in );
1689                 for my $affect ( @affects ) {
1690                     my ( $sf, $v ) = split q{=}, $affect, 2;
1691                     foreach ( $item_marc->field($itemfield) ) {
1692                         $_->update( $sf => $v );
1693                     }
1694                 }
1695                 C4::Items::ModItemFromMarc( $item_marc, $biblio->biblionumber, $in );
1696             }
1697         }
1698     }
1699
1700     return $parent_ordernumber;
1701 }
1702
1703 sub _cancel_items_receipt {
1704     my ( $order, $parent_ordernumber ) = @_;
1705     $parent_ordernumber ||= $order->ordernumber;
1706
1707     my $items = $order->items;
1708     if ( $order->basket->effective_create_items eq 'receiving' ) {
1709         # Remove items that were created at receipt
1710         my $query = qq{
1711             DELETE FROM items, aqorders_items
1712             USING items, aqorders_items
1713             WHERE items.itemnumber = ? AND aqorders_items.itemnumber = ?
1714         };
1715         my $dbh = C4::Context->dbh;
1716         my $sth = $dbh->prepare($query);
1717         while ( my $item = $items->next ) {
1718             $sth->execute($item->itemnumber, $item->itemnumber);
1719         }
1720     } else {
1721         # Update items
1722         while ( my $item = $items->next ) {
1723             ModItemOrder($item->itemnumber, $parent_ordernumber);
1724         }
1725     }
1726 }
1727
1728 #------------------------------------------------------------#
1729
1730 =head3 SearchOrders
1731
1732 @results = &SearchOrders({
1733     ordernumber => $ordernumber,
1734     search => $search,
1735     ean => $ean,
1736     booksellerid => $booksellerid,
1737     basketno => $basketno,
1738     basketname => $basketname,
1739     basketgroupname => $basketgroupname,
1740     owner => $owner,
1741     pending => $pending
1742     ordered => $ordered
1743     biblionumber => $biblionumber,
1744     budget_id => $budget_id
1745 });
1746
1747 Searches for orders filtered by criteria.
1748
1749 C<$ordernumber> Finds matching orders or transferred orders by ordernumber.
1750 C<$search> Finds orders matching %$search% in title, author, or isbn.
1751 C<$owner> Finds order for the logged in user.
1752 C<$pending> Finds pending orders. Ignores completed and cancelled orders.
1753 C<$ordered> Finds orders to receive only (status 'ordered' or 'partial').
1754
1755
1756 C<@results> is an array of references-to-hash with the keys are fields
1757 from aqorders, biblio, biblioitems and aqbasket tables.
1758
1759 =cut
1760
1761 sub SearchOrders {
1762     my ( $params ) = @_;
1763     my $ordernumber = $params->{ordernumber};
1764     my $search = $params->{search};
1765     my $ean = $params->{ean};
1766     my $booksellerid = $params->{booksellerid};
1767     my $basketno = $params->{basketno};
1768     my $basketname = $params->{basketname};
1769     my $basketgroupname = $params->{basketgroupname};
1770     my $owner = $params->{owner};
1771     my $pending = $params->{pending};
1772     my $ordered = $params->{ordered};
1773     my $biblionumber = $params->{biblionumber};
1774     my $budget_id = $params->{budget_id};
1775
1776     my $dbh = C4::Context->dbh;
1777     my @args = ();
1778     my $query = q{
1779         SELECT aqbasket.basketno,
1780                borrowers.surname,
1781                borrowers.firstname,
1782                biblio.*,
1783                biblioitems.isbn,
1784                biblioitems.biblioitemnumber,
1785                biblioitems.publishercode,
1786                biblioitems.publicationyear,
1787                aqbasket.authorisedby,
1788                aqbasket.booksellerid,
1789                aqbasket.closedate,
1790                aqbasket.creationdate,
1791                aqbasket.basketname,
1792                aqbasketgroups.id as basketgroupid,
1793                aqbasketgroups.name as basketgroupname,
1794                aqorders.*
1795         FROM aqorders
1796             LEFT JOIN aqbasket ON aqorders.basketno = aqbasket.basketno
1797             LEFT JOIN aqbasketgroups ON aqbasket.basketgroupid = aqbasketgroups.id
1798             LEFT JOIN borrowers ON aqbasket.authorisedby=borrowers.borrowernumber
1799             LEFT JOIN biblio ON aqorders.biblionumber=biblio.biblionumber
1800             LEFT JOIN biblioitems ON biblioitems.biblionumber=biblio.biblionumber
1801     };
1802
1803     # If we search on ordernumber, we retrieve the transferred order if a transfer has been done.
1804     $query .= q{
1805             LEFT JOIN aqorders_transfers ON aqorders_transfers.ordernumber_to = aqorders.ordernumber
1806     } if $ordernumber;
1807
1808     $query .= q{
1809         WHERE (datecancellationprinted is NULL)
1810     };
1811
1812     if ( $pending or $ordered ) {
1813         $query .= q{
1814             AND (
1815                 ( aqbasket.is_standing AND aqorders.orderstatus IN ( "new", "ordered", "partial" ) )
1816                 OR (
1817                     ( quantity > quantityreceived OR quantityreceived is NULL )
1818         };
1819
1820         if ( $ordered ) {
1821             $query .= q{ AND aqorders.orderstatus IN ( "ordered", "partial" )};
1822         }
1823         $query .= q{
1824                 )
1825             )
1826         };
1827     }
1828
1829     my $userenv = C4::Context->userenv;
1830     if ( C4::Context->preference("IndependentBranches") ) {
1831         unless ( C4::Context->IsSuperLibrarian() ) {
1832             $query .= q{
1833                 AND (
1834                     borrowers.branchcode = ?
1835                     OR borrowers.branchcode  = ''
1836                 )
1837             };
1838             push @args, $userenv->{branch};
1839         }
1840     }
1841
1842     if ( $ordernumber ) {
1843         $query .= ' AND ( aqorders.ordernumber = ? OR aqorders_transfers.ordernumber_from = ? ) ';
1844         push @args, ( $ordernumber, $ordernumber );
1845     }
1846     if ( $biblionumber ) {
1847         $query .= 'AND aqorders.biblionumber = ?';
1848         push @args, $biblionumber;
1849     }
1850     if( $search ) {
1851         $query .= ' AND (biblio.title LIKE ? OR biblio.author LIKE ? OR biblioitems.isbn LIKE ?)';
1852         push @args, ("%$search%","%$search%","%$search%");
1853     }
1854     if ( $ean ) {
1855         $query .= ' AND biblioitems.ean = ?';
1856         push @args, $ean;
1857     }
1858     if ( $booksellerid ) {
1859         $query .= 'AND aqbasket.booksellerid = ?';
1860         push @args, $booksellerid;
1861     }
1862     if( $basketno ) {
1863         $query .= 'AND aqbasket.basketno = ?';
1864         push @args, $basketno;
1865     }
1866     if( $basketname ) {
1867         $query .= 'AND aqbasket.basketname LIKE ?';
1868         push @args, "%$basketname%";
1869     }
1870     if( $basketgroupname ) {
1871         $query .= ' AND aqbasketgroups.name LIKE ?';
1872         push @args, "%$basketgroupname%";
1873     }
1874
1875     if ( $owner ) {
1876         $query .= ' AND aqbasket.authorisedby=? ';
1877         push @args, $userenv->{'number'};
1878     }
1879
1880     if ( $budget_id ) {
1881         $query .= ' AND aqorders.budget_id = ?';
1882         push @args, $budget_id;
1883     }
1884
1885     $query .= ' ORDER BY aqbasket.basketno';
1886
1887     my $sth = $dbh->prepare($query);
1888     $sth->execute(@args);
1889     return $sth->fetchall_arrayref({});
1890 }
1891
1892 #------------------------------------------------------------#
1893
1894 =head3 DelOrder
1895
1896   &DelOrder($biblionumber, $ordernumber);
1897
1898 Cancel the order with the given order and biblio numbers. It does not
1899 delete any entries in the aqorders table, it merely marks them as
1900 cancelled.
1901
1902 =cut
1903
1904 sub DelOrder {
1905     my ( $bibnum, $ordernumber, $delete_biblio, $reason ) = @_;
1906     my $error;
1907     my $dbh = C4::Context->dbh;
1908     my $query = "
1909         UPDATE aqorders
1910         SET    datecancellationprinted=now(), orderstatus='cancelled'
1911     ";
1912     if($reason) {
1913         $query .= ", cancellationreason = ? ";
1914     }
1915     $query .= "
1916         WHERE biblionumber=? AND ordernumber=?
1917     ";
1918     my $sth = $dbh->prepare($query);
1919     if($reason) {
1920         $sth->execute($reason, $bibnum, $ordernumber);
1921     } else {
1922         $sth->execute( $bibnum, $ordernumber );
1923     }
1924     $sth->finish;
1925
1926     my $order = Koha::Acquisition::Orders->find($ordernumber);
1927     my $items = $order->items;
1928     while ( my $item = $items->next ) { # Should be moved to Koha::Acquisition::Order->delete
1929         my $delcheck = C4::Items::DelItemCheck( $bibnum, $item->itemnumber );
1930
1931         if($delcheck != 1) {
1932             $error->{'delitem'} = 1;
1933         }
1934     }
1935
1936     if($delete_biblio) {
1937         # We get the number of remaining items
1938         my $biblio = Koha::Biblios->find( $bibnum );
1939         my $itemcount = $biblio->items->count;
1940
1941         # If there are no items left,
1942         if ( $itemcount == 0 ) {
1943             # We delete the record
1944             my $delcheck = DelBiblio($bibnum);
1945
1946             if($delcheck) {
1947                 $error->{'delbiblio'} = 1;
1948             }
1949         }
1950     }
1951
1952     return $error;
1953 }
1954
1955 =head3 TransferOrder
1956
1957     my $newordernumber = TransferOrder($ordernumber, $basketno);
1958
1959 Transfer an order line to a basket.
1960 Mark $ordernumber as cancelled with an internal note 'Cancelled and transferred
1961 to BOOKSELLER on DATE' and create new order with internal note
1962 'Transferred from BOOKSELLER on DATE'.
1963 Move all attached items to the new order.
1964 Received orders cannot be transferred.
1965 Return the ordernumber of created order.
1966
1967 =cut
1968
1969 sub TransferOrder {
1970     my ($ordernumber, $basketno) = @_;
1971
1972     return unless ($ordernumber and $basketno);
1973
1974     my $order = Koha::Acquisition::Orders->find( $ordernumber ) or return;
1975     return if $order->datereceived;
1976
1977     $order = $order->unblessed;
1978
1979     my $basket = GetBasket($basketno);
1980     return unless $basket;
1981
1982     my $dbh = C4::Context->dbh;
1983     my ($query, $sth, $rv);
1984
1985     $query = q{
1986         UPDATE aqorders
1987         SET datecancellationprinted = CAST(NOW() AS date), orderstatus = ?
1988         WHERE ordernumber = ?
1989     };
1990     $sth = $dbh->prepare($query);
1991     $rv = $sth->execute('cancelled', $ordernumber);
1992
1993     delete $order->{'ordernumber'};
1994     delete $order->{parent_ordernumber};
1995     $order->{'basketno'} = $basketno;
1996
1997     my $newordernumber = Koha::Acquisition::Order->new($order)->store->ordernumber;
1998
1999     $query = q{
2000         UPDATE aqorders_items
2001         SET ordernumber = ?
2002         WHERE ordernumber = ?
2003     };
2004     $sth = $dbh->prepare($query);
2005     $sth->execute($newordernumber, $ordernumber);
2006
2007     $query = q{
2008         INSERT INTO aqorders_transfers (ordernumber_from, ordernumber_to)
2009         VALUES (?, ?)
2010     };
2011     $sth = $dbh->prepare($query);
2012     $sth->execute($ordernumber, $newordernumber);
2013
2014     return $newordernumber;
2015 }
2016
2017 =head3 get_rounding_sql
2018
2019     $rounding_sql = get_rounding_sql($column_name);
2020
2021 returns the correct SQL routine based on OrderPriceRounding system preference.
2022
2023 =cut
2024
2025 sub get_rounding_sql {
2026     my ( $round_string ) = @_;
2027     my $rounding_pref = C4::Context->preference('OrderPriceRounding') // q{};
2028     if ( $rounding_pref eq "nearest_cent"  ) {
2029         return "CAST($round_string*100 AS SIGNED)/100";
2030     }
2031     return $round_string;
2032 }
2033
2034 =head3 get_rounded_price
2035
2036     $rounded_price = get_rounded_price( $price );
2037
2038 returns a price rounded as specified in OrderPriceRounding system preference.
2039
2040 =cut
2041
2042 sub get_rounded_price {
2043     my ( $price ) =  @_;
2044     my $rounding_pref = C4::Context->preference('OrderPriceRounding') // q{};
2045     if( $rounding_pref eq 'nearest_cent' ) {
2046         return Koha::Number::Price->new( $price )->round();
2047     }
2048     return $price;
2049 }
2050
2051
2052 =head2 FUNCTIONS ABOUT PARCELS
2053
2054 =head3 GetParcels
2055
2056   $results = &GetParcels($bookseller, $order, $code, $datefrom, $dateto);
2057
2058 get a lists of parcels.
2059
2060 * Input arg :
2061
2062 =over
2063
2064 =item $bookseller
2065 is the bookseller this function has to get parcels.
2066
2067 =item $order
2068 To know on what criteria the results list has to be ordered.
2069
2070 =item $code
2071 is the booksellerinvoicenumber.
2072
2073 =item $datefrom & $dateto
2074 to know on what date this function has to filter its search.
2075
2076 =back
2077
2078 * return:
2079 a pointer on a hash list containing parcel informations as such :
2080
2081 =over
2082
2083 =item Creation date
2084
2085 =item Last operation
2086
2087 =item Number of biblio
2088
2089 =item Number of items
2090
2091 =back
2092
2093 =cut
2094
2095 sub GetParcels {
2096     my ($bookseller,$order, $code, $datefrom, $dateto) = @_;
2097     my $dbh    = C4::Context->dbh;
2098     my @query_params = ();
2099     my $strsth ="
2100         SELECT  aqinvoices.invoicenumber,
2101                 datereceived,purchaseordernumber,
2102                 count(DISTINCT biblionumber) AS biblio,
2103                 sum(quantity) AS itemsexpected,
2104                 sum(quantityreceived) AS itemsreceived
2105         FROM   aqorders LEFT JOIN aqbasket ON aqbasket.basketno = aqorders.basketno
2106         LEFT JOIN aqinvoices ON aqorders.invoiceid = aqinvoices.invoiceid
2107         WHERE aqbasket.booksellerid = ? and datereceived IS NOT NULL
2108     ";
2109     push @query_params, $bookseller;
2110
2111     if ( defined $code ) {
2112         $strsth .= ' and aqinvoices.invoicenumber like ? ';
2113         # add a % to the end of the code to allow stemming.
2114         push @query_params, "$code%";
2115     }
2116
2117     if ( defined $datefrom ) {
2118         $strsth .= ' and datereceived >= ? ';
2119         push @query_params, $datefrom;
2120     }
2121
2122     if ( defined $dateto ) {
2123         $strsth .=  'and datereceived <= ? ';
2124         push @query_params, $dateto;
2125     }
2126
2127     $strsth .= "group by aqinvoices.invoicenumber,datereceived ";
2128
2129     # can't use a placeholder to place this column name.
2130     # but, we could probably be checking to make sure it is a column that will be fetched.
2131     $strsth .= "order by $order " if ($order);
2132
2133     my $sth = $dbh->prepare($strsth);
2134
2135     $sth->execute( @query_params );
2136     my $results = $sth->fetchall_arrayref({});
2137     return @{$results};
2138 }
2139
2140 #------------------------------------------------------------#
2141
2142 =head3 GetLateOrders
2143
2144   @results = &GetLateOrders;
2145
2146 Searches for bookseller with late orders.
2147
2148 return:
2149 the table of supplier with late issues. This table is full of hashref.
2150
2151 =cut
2152
2153 sub GetLateOrders {
2154     my $delay      = shift;
2155     my $supplierid = shift;
2156     my $branch     = shift;
2157     my $estimateddeliverydatefrom = shift;
2158     my $estimateddeliverydateto = shift;
2159
2160     my $dbh = C4::Context->dbh;
2161
2162     #BEWARE, order of parenthesis and LEFT JOIN is important for speed
2163     my $dbdriver = C4::Context->config("db_scheme") || "mysql";
2164
2165     my @query_params = ();
2166     my $select = "
2167     SELECT aqbasket.basketno,
2168         aqorders.ordernumber      AS ordernumber,
2169         DATE(aqbasket.closedate)  AS orderdate,
2170         aqbasket.basketname       AS basketname,
2171         aqbasket.basketgroupid    AS basketgroupid,
2172         aqbasketgroups.name       AS basketgroupname,
2173         aqorders.rrp              AS unitpricesupplier,
2174         aqorders.ecost            AS unitpricelib,
2175         aqorders.claims_count     AS claims_count,
2176         aqorders.claimed_date     AS claimed_date,
2177         aqorders.order_internalnote AS internalnote,
2178         aqorders.order_vendornote   AS vendornote,
2179         aqbudgets.budget_name     AS budget,
2180         borrowers.branchcode      AS branch,
2181         aqbooksellers.name        AS supplier,
2182         aqbooksellers.id          AS supplierid,
2183         biblio.author, biblio.title,
2184         biblioitems.publishercode AS publisher,
2185         biblioitems.publicationyear,
2186         biblioitems.isbn          AS isbn,
2187         ADDDATE(aqbasket.closedate, INTERVAL aqbooksellers.deliverytime DAY) AS estimateddeliverydate,
2188     ";
2189     my $from = "
2190     FROM
2191         aqorders LEFT JOIN biblio     ON biblio.biblionumber         = aqorders.biblionumber
2192         LEFT JOIN biblioitems         ON biblioitems.biblionumber    = biblio.biblionumber
2193         LEFT JOIN aqbudgets           ON aqorders.budget_id          = aqbudgets.budget_id,
2194         aqbasket LEFT JOIN borrowers  ON aqbasket.authorisedby       = borrowers.borrowernumber
2195         LEFT JOIN aqbooksellers       ON aqbasket.booksellerid       = aqbooksellers.id
2196         LEFT JOIN aqbasketgroups      ON aqbasket.basketgroupid      = aqbasketgroups.id
2197         WHERE aqorders.basketno = aqbasket.basketno
2198         AND ( datereceived IS NULL
2199             OR aqorders.quantityreceived < aqorders.quantity
2200         )
2201         AND aqbasket.closedate IS NOT NULL
2202         AND aqorders.datecancellationprinted IS NULL
2203     ";
2204     if ($dbdriver eq "mysql") {
2205         $select .= "
2206         aqorders.quantity - COALESCE(aqorders.quantityreceived,0)                 AS quantity,
2207         (aqorders.quantity - COALESCE(aqorders.quantityreceived,0)) * aqorders.rrp AS subtotal,
2208         DATEDIFF(CAST(now() AS date),closedate) AS latesince
2209         ";
2210         if ( defined $delay ) {
2211             $from .= " AND (closedate <= DATE_SUB(CAST(now() AS date),INTERVAL ? DAY)) " ;
2212             push @query_params, $delay;
2213         }
2214         $from .= " AND aqorders.quantity - COALESCE(aqorders.quantityreceived,0) <> 0";
2215     } else {
2216         # FIXME: account for IFNULL as above
2217         $select .= "
2218                 aqorders.quantity                AS quantity,
2219                 aqorders.quantity * aqorders.rrp AS subtotal,
2220                 (CAST(now() AS date) - closedate)            AS latesince
2221         ";
2222         if ( defined $delay ) {
2223             $from .= " AND (closedate <= (CAST(now() AS date) -(INTERVAL ? DAY)) ";
2224             push @query_params, $delay;
2225         }
2226         $from .= " AND aqorders.quantity <> 0";
2227     }
2228     if (defined $supplierid) {
2229         $from .= ' AND aqbasket.booksellerid = ? ';
2230         push @query_params, $supplierid;
2231     }
2232     if (defined $branch) {
2233         $from .= ' AND borrowers.branchcode LIKE ? ';
2234         push @query_params, $branch;
2235     }
2236
2237     if ( defined $estimateddeliverydatefrom or defined $estimateddeliverydateto ) {
2238         $from .= ' AND aqbooksellers.deliverytime IS NOT NULL ';
2239     }
2240     if ( defined $estimateddeliverydatefrom ) {
2241         $from .= ' AND ADDDATE(aqbasket.closedate, INTERVAL aqbooksellers.deliverytime DAY) >= ?';
2242         push @query_params, $estimateddeliverydatefrom;
2243     }
2244     if ( defined $estimateddeliverydateto ) {
2245         $from .= ' AND ADDDATE(aqbasket.closedate, INTERVAL aqbooksellers.deliverytime DAY) <= ?';
2246         push @query_params, $estimateddeliverydateto;
2247     }
2248     if ( defined $estimateddeliverydatefrom and not defined $estimateddeliverydateto ) {
2249         $from .= ' AND ADDDATE(aqbasket.closedate, INTERVAL aqbooksellers.deliverytime DAY) <= CAST(now() AS date)';
2250     }
2251     if (C4::Context->preference("IndependentBranches")
2252             && !C4::Context->IsSuperLibrarian() ) {
2253         $from .= ' AND borrowers.branchcode LIKE ? ';
2254         push @query_params, C4::Context->userenv->{branch};
2255     }
2256     $from .= " AND orderstatus <> 'cancelled' ";
2257     my $query = "$select $from \nORDER BY latesince, basketno, borrowers.branchcode, supplier";
2258     $debug and print STDERR "GetLateOrders query: $query\nGetLateOrders args: " . join(" ",@query_params);
2259     my $sth = $dbh->prepare($query);
2260     $sth->execute(@query_params);
2261     my @results;
2262     while (my $data = $sth->fetchrow_hashref) {
2263         push @results, $data;
2264     }
2265     return @results;
2266 }
2267
2268 #------------------------------------------------------------#
2269
2270 =head3 GetHistory
2271
2272   \@order_loop = GetHistory( %params );
2273
2274 Retreives some acquisition history information
2275
2276 params:
2277   title
2278   author
2279   name
2280   isbn
2281   ean
2282   from_placed_on
2283   to_placed_on
2284   basket                  - search both basket name and number
2285   booksellerinvoicenumber
2286   basketgroupname
2287   budget
2288   orderstatus (note that orderstatus '' will retrieve orders
2289                of any status except cancelled)
2290   managing_library
2291   biblionumber
2292   get_canceled_order (if set to a true value, cancelled orders will
2293                       be included)
2294
2295 returns:
2296     $order_loop is a list of hashrefs that each look like this:
2297             {
2298                 'author'           => 'Twain, Mark',
2299                 'basketno'         => '1',
2300                 'biblionumber'     => '215',
2301                 'count'            => 1,
2302                 'creationdate'     => 'MM/DD/YYYY',
2303                 'datereceived'     => undef,
2304                 'ecost'            => '1.00',
2305                 'id'               => '1',
2306                 'invoicenumber'    => undef,
2307                 'name'             => '',
2308                 'ordernumber'      => '1',
2309                 'quantity'         => 1,
2310                 'quantityreceived' => undef,
2311                 'title'            => 'The Adventures of Huckleberry Finn',
2312                 'managing_library' => 'CPL'
2313             }
2314
2315 =cut
2316
2317 sub GetHistory {
2318 # don't run the query if there are no parameters (list would be too long for sure !)
2319     croak "No search params" unless @_;
2320     my %params = @_;
2321     my $title = $params{title};
2322     my $author = $params{author};
2323     my $isbn   = $params{isbn};
2324     my $ean    = $params{ean};
2325     my $name = $params{name};
2326     my $from_placed_on = $params{from_placed_on};
2327     my $to_placed_on = $params{to_placed_on};
2328     my $basket = $params{basket};
2329     my $booksellerinvoicenumber = $params{booksellerinvoicenumber};
2330     my $basketgroupname = $params{basketgroupname};
2331     my $budget = $params{budget};
2332     my $orderstatus = $params{orderstatus};
2333     my $biblionumber = $params{biblionumber};
2334     my $get_canceled_order = $params{get_canceled_order} || 0;
2335     my $ordernumber = $params{ordernumber};
2336     my $search_children_too = $params{search_children_too} || 0;
2337     my $created_by = $params{created_by} || [];
2338     my $managing_library = $params{managing_library};
2339     my $ordernumbers = $params{ordernumbers} || [];
2340     my $additional_fields = $params{additional_fields} // [];
2341
2342     my @order_loop;
2343     my $total_qty         = 0;
2344     my $total_qtyreceived = 0;
2345     my $total_price       = 0;
2346
2347     #get variation of isbn
2348     my @isbn_params;
2349     my @isbns;
2350     if ($isbn){
2351         if ( C4::Context->preference("SearchWithISBNVariations") ){
2352             @isbns = C4::Koha::GetVariationsOfISBN( $isbn );
2353             foreach my $isb (@isbns){
2354                 push @isbn_params, '?';
2355             }
2356         }
2357         unless (@isbns){
2358             push @isbns, $isbn;
2359             push @isbn_params, '?';
2360         }
2361     }
2362
2363     my $dbh   = C4::Context->dbh;
2364     my $query ="
2365         SELECT
2366             COALESCE(biblio.title,     deletedbiblio.title)     AS title,
2367             COALESCE(biblio.author,    deletedbiblio.author)    AS author,
2368             COALESCE(biblioitems.isbn, deletedbiblioitems.isbn) AS isbn,
2369             COALESCE(biblioitems.ean,  deletedbiblioitems.ean)  AS ean,
2370             aqorders.basketno,
2371             aqbasket.basketname,
2372             aqbasket.basketgroupid,
2373             aqbasket.authorisedby,
2374             concat( borrowers.firstname,' ',borrowers.surname) AS authorisedbyname,
2375             branch as managing_library,
2376             aqbasketgroups.name as groupname,
2377             aqbooksellers.name,
2378             aqbasket.creationdate,
2379             aqorders.datereceived,
2380             aqorders.quantity,
2381             aqorders.quantityreceived,
2382             aqorders.ecost,
2383             aqorders.ordernumber,
2384             aqorders.invoiceid,
2385             aqinvoices.invoicenumber,
2386             aqbooksellers.id as id,
2387             aqorders.biblionumber,
2388             aqorders.orderstatus,
2389             aqorders.parent_ordernumber,
2390             aqbudgets.budget_name
2391             ";
2392     $query .= ", aqbudgets.budget_id AS budget" if defined $budget;
2393     $query .= "
2394         FROM aqorders
2395         LEFT JOIN aqbasket ON aqorders.basketno=aqbasket.basketno
2396         LEFT JOIN aqbasketgroups ON aqbasket.basketgroupid=aqbasketgroups.id
2397         LEFT JOIN aqbooksellers ON aqbasket.booksellerid=aqbooksellers.id
2398         LEFT JOIN biblioitems ON biblioitems.biblionumber=aqorders.biblionumber
2399         LEFT JOIN biblio ON biblio.biblionumber=aqorders.biblionumber
2400         LEFT JOIN aqbudgets ON aqorders.budget_id=aqbudgets.budget_id
2401         LEFT JOIN aqinvoices ON aqorders.invoiceid = aqinvoices.invoiceid
2402         LEFT JOIN deletedbiblio ON deletedbiblio.biblionumber=aqorders.biblionumber
2403         LEFT JOIN deletedbiblioitems ON deletedbiblioitems.biblionumber=aqorders.biblionumber
2404         LEFT JOIN borrowers ON aqbasket.authorisedby=borrowers.borrowernumber
2405         ";
2406
2407     $query .= " WHERE 1 ";
2408
2409     unless ($get_canceled_order or (defined $orderstatus and $orderstatus eq 'cancelled')) {
2410         $query .= " AND datecancellationprinted IS NULL ";
2411     }
2412
2413     my @query_params  = ();
2414
2415     if ( $biblionumber ) {
2416         $query .= " AND biblio.biblionumber = ?";
2417         push @query_params, $biblionumber;
2418     }
2419
2420     if ( $title ) {
2421         $query .= " AND biblio.title LIKE ? ";
2422         $title =~ s/\s+/%/g;
2423         push @query_params, "%$title%";
2424     }
2425
2426     if ( $author ) {
2427         $query .= " AND biblio.author LIKE ? ";
2428         push @query_params, "%$author%";
2429     }
2430
2431     if ( @isbns ) {
2432         $query .= " AND ( biblioitems.isbn LIKE " . join (" OR biblioitems.isbn LIKE ", @isbn_params ) . ")";
2433         foreach my $isb (@isbns){
2434             push @query_params, "%$isb%";
2435         }
2436     }
2437
2438     if ( $ean ) {
2439         $query .= " AND biblioitems.ean = ? ";
2440         push @query_params, "$ean";
2441     }
2442     if ( $name ) {
2443         $query .= " AND aqbooksellers.name LIKE ? ";
2444         push @query_params, "%$name%";
2445     }
2446
2447     if ( $budget ) {
2448         $query .= " AND aqbudgets.budget_id = ? ";
2449         push @query_params, "$budget";
2450     }
2451
2452     if ( $from_placed_on ) {
2453         $query .= " AND creationdate >= ? ";
2454         push @query_params, $from_placed_on;
2455     }
2456
2457     if ( $to_placed_on ) {
2458         $query .= " AND creationdate <= ? ";
2459         push @query_params, $to_placed_on;
2460     }
2461
2462     if ( defined $orderstatus and $orderstatus ne '') {
2463         $query .= " AND aqorders.orderstatus = ? ";
2464         push @query_params, "$orderstatus";
2465     }
2466
2467     if ($basket) {
2468         if ($basket =~ m/^\d+$/) {
2469             $query .= " AND aqorders.basketno = ? ";
2470             push @query_params, $basket;
2471         } else {
2472             $query .= " AND aqbasket.basketname LIKE ? ";
2473             push @query_params, "%$basket%";
2474         }
2475     }
2476
2477     if ($booksellerinvoicenumber) {
2478         $query .= " AND aqinvoices.invoicenumber LIKE ? ";
2479         push @query_params, "%$booksellerinvoicenumber%";
2480     }
2481
2482     if ($basketgroupname) {
2483         $query .= " AND aqbasketgroups.name LIKE ? ";
2484         push @query_params, "%$basketgroupname%";
2485     }
2486
2487     if ($ordernumber) {
2488         $query .= " AND (aqorders.ordernumber = ? ";
2489         push @query_params, $ordernumber;
2490         if ($search_children_too) {
2491             $query .= " OR aqorders.parent_ordernumber = ? ";
2492             push @query_params, $ordernumber;
2493         }
2494         $query .= ") ";
2495     }
2496
2497     if ( @$created_by ) {
2498         $query .= ' AND aqbasket.authorisedby IN ( ' . join( ',', ('?') x @$created_by ) . ')';
2499         push @query_params, @$created_by;
2500     }
2501
2502     if ( $managing_library ) {
2503         $query .= " AND aqbasket.branch = ? ";
2504         push @query_params, $managing_library;
2505     }
2506
2507     if ( @$ordernumbers ) {
2508         $query .= ' AND (aqorders.ordernumber IN ( ' . join (',', ('?') x @$ordernumbers ) . '))';
2509         push @query_params, @$ordernumbers;
2510     }
2511     if ( @$additional_fields ) {
2512         my @baskets = Koha::Acquisition::Baskets->filter_by_additional_fields($additional_fields);
2513
2514         return [] unless @baskets;
2515
2516         # No parameterization because record IDs come directly from DB
2517         $query .= ' AND aqbasket.basketno IN ( ' . join( ',', map { $_->basketno } @baskets ) . ' )';
2518     }
2519
2520     if ( C4::Context->preference("IndependentBranches") ) {
2521         unless ( C4::Context->IsSuperLibrarian() ) {
2522             $query .= " AND (borrowers.branchcode = ? OR borrowers.branchcode ='' ) ";
2523             push @query_params, C4::Context->userenv->{branch};
2524         }
2525     }
2526     $query .= " ORDER BY id";
2527
2528     return $dbh->selectall_arrayref( $query, { Slice => {} }, @query_params );
2529 }
2530
2531 =head2 GetRecentAcqui
2532
2533   $results = GetRecentAcqui($days);
2534
2535 C<$results> is a ref to a table which contains hashref
2536
2537 =cut
2538
2539 sub GetRecentAcqui {
2540     my $limit  = shift;
2541     my $dbh    = C4::Context->dbh;
2542     my $query = "
2543         SELECT *
2544         FROM   biblio
2545         ORDER BY timestamp DESC
2546         LIMIT  0,".$limit;
2547
2548     my $sth = $dbh->prepare($query);
2549     $sth->execute;
2550     my $results = $sth->fetchall_arrayref({});
2551     return $results;
2552 }
2553
2554 #------------------------------------------------------------#
2555
2556 =head3 AddClaim
2557
2558   &AddClaim($ordernumber);
2559
2560 Add a claim for an order
2561
2562 =cut
2563
2564 sub AddClaim {
2565     my ($ordernumber) = @_;
2566     my $dbh          = C4::Context->dbh;
2567     my $query        = "
2568         UPDATE aqorders SET
2569             claims_count = claims_count + 1,
2570             claimed_date = CURDATE()
2571         WHERE ordernumber = ?
2572         ";
2573     my $sth = $dbh->prepare($query);
2574     $sth->execute($ordernumber);
2575 }
2576
2577 =head3 GetInvoices
2578
2579     my @invoices = GetInvoices(
2580         invoicenumber => $invoicenumber,
2581         supplierid => $supplierid,
2582         suppliername => $suppliername,
2583         shipmentdatefrom => $shipmentdatefrom, # ISO format
2584         shipmentdateto => $shipmentdateto, # ISO format
2585         billingdatefrom => $billingdatefrom, # ISO format
2586         billingdateto => $billingdateto, # ISO format
2587         isbneanissn => $isbn_or_ean_or_issn,
2588         title => $title,
2589         author => $author,
2590         publisher => $publisher,
2591         publicationyear => $publicationyear,
2592         branchcode => $branchcode,
2593         order_by => $order_by
2594     );
2595
2596 Return a list of invoices that match all given criteria.
2597
2598 $order_by is "column_name (asc|desc)", where column_name is any of
2599 'invoicenumber', 'booksellerid', 'shipmentdate', 'billingdate', 'closedate',
2600 'shipmentcost', 'shipmentcost_budgetid'.
2601
2602 asc is the default if omitted
2603
2604 =cut
2605
2606 sub GetInvoices {
2607     my %args = @_;
2608
2609     my @columns = qw(invoicenumber booksellerid shipmentdate billingdate
2610         closedate shipmentcost shipmentcost_budgetid);
2611
2612     my $dbh = C4::Context->dbh;
2613     my $query = qq{
2614         SELECT aqinvoices.invoiceid, aqinvoices.invoicenumber, aqinvoices.booksellerid, aqinvoices.shipmentdate, aqinvoices.billingdate, aqinvoices.closedate, aqinvoices.shipmentcost, aqinvoices.shipmentcost_budgetid, aqinvoices.message_id,
2615             aqbooksellers.name AS suppliername,
2616           COUNT(
2617             DISTINCT IF(
2618               aqorders.datereceived IS NOT NULL,
2619               aqorders.biblionumber,
2620               NULL
2621             )
2622           ) AS receivedbiblios,
2623           COUNT(
2624              DISTINCT IF(
2625               aqorders.subscriptionid IS NOT NULL,
2626               aqorders.subscriptionid,
2627               NULL
2628             )
2629           ) AS is_linked_to_subscriptions,
2630           SUM(aqorders.quantityreceived) AS receiveditems
2631         FROM aqinvoices
2632           LEFT JOIN aqbooksellers ON aqbooksellers.id = aqinvoices.booksellerid
2633           LEFT JOIN aqorders ON aqorders.invoiceid = aqinvoices.invoiceid
2634           LEFT JOIN aqbasket ON aqbasket.basketno=aqorders.basketno
2635           LEFT JOIN borrowers ON aqbasket.authorisedby=borrowers.borrowernumber
2636           LEFT JOIN biblio ON aqorders.biblionumber = biblio.biblionumber
2637           LEFT JOIN biblioitems ON biblio.biblionumber = biblioitems.biblionumber
2638           LEFT JOIN subscription ON biblio.biblionumber = subscription.biblionumber
2639     };
2640
2641     my @bind_args;
2642     my @bind_strs;
2643     if($args{supplierid}) {
2644         push @bind_strs, " aqinvoices.booksellerid = ? ";
2645         push @bind_args, $args{supplierid};
2646     }
2647     if($args{invoicenumber}) {
2648         push @bind_strs, " aqinvoices.invoicenumber LIKE ? ";
2649         push @bind_args, "%$args{invoicenumber}%";
2650     }
2651     if($args{suppliername}) {
2652         push @bind_strs, " aqbooksellers.name LIKE ? ";
2653         push @bind_args, "%$args{suppliername}%";
2654     }
2655     if($args{shipmentdatefrom}) {
2656         push @bind_strs, " aqinvoices.shipmentdate >= ? ";
2657         push @bind_args, $args{shipmentdatefrom};
2658     }
2659     if($args{shipmentdateto}) {
2660         push @bind_strs, " aqinvoices.shipmentdate <= ? ";
2661         push @bind_args, $args{shipmentdateto};
2662     }
2663     if($args{billingdatefrom}) {
2664         push @bind_strs, " aqinvoices.billingdate >= ? ";
2665         push @bind_args, $args{billingdatefrom};
2666     }
2667     if($args{billingdateto}) {
2668         push @bind_strs, " aqinvoices.billingdate <= ? ";
2669         push @bind_args, $args{billingdateto};
2670     }
2671     if($args{isbneanissn}) {
2672         push @bind_strs, " (biblioitems.isbn LIKE CONCAT('%', ?, '%') OR biblioitems.ean LIKE CONCAT('%', ?, '%') OR biblioitems.issn LIKE CONCAT('%', ?, '%') ) ";
2673         push @bind_args, $args{isbneanissn}, $args{isbneanissn}, $args{isbneanissn};
2674     }
2675     if($args{title}) {
2676         push @bind_strs, " biblio.title LIKE CONCAT('%', ?, '%') ";
2677         push @bind_args, $args{title};
2678     }
2679     if($args{author}) {
2680         push @bind_strs, " biblio.author LIKE CONCAT('%', ?, '%') ";
2681         push @bind_args, $args{author};
2682     }
2683     if($args{publisher}) {
2684         push @bind_strs, " biblioitems.publishercode LIKE CONCAT('%', ?, '%') ";
2685         push @bind_args, $args{publisher};
2686     }
2687     if($args{publicationyear}) {
2688         push @bind_strs, " ((biblioitems.publicationyear LIKE CONCAT('%', ?, '%')) OR (biblio.copyrightdate LIKE CONCAT('%', ?, '%'))) ";
2689         push @bind_args, $args{publicationyear}, $args{publicationyear};
2690     }
2691     if($args{branchcode}) {
2692         push @bind_strs, " borrowers.branchcode = ? ";
2693         push @bind_args, $args{branchcode};
2694     }
2695     if($args{message_id}) {
2696         push @bind_strs, " aqinvoices.message_id = ? ";
2697         push @bind_args, $args{message_id};
2698     }
2699
2700     $query .= " WHERE " . join(" AND ", @bind_strs) if @bind_strs;
2701     $query .= " GROUP BY aqinvoices.invoiceid, aqinvoices.invoicenumber, aqinvoices.booksellerid, aqinvoices.shipmentdate, aqinvoices.billingdate, aqinvoices.closedate, aqinvoices.shipmentcost, aqinvoices.shipmentcost_budgetid, aqinvoices.message_id, aqbooksellers.name";
2702
2703     if($args{order_by}) {
2704         my ($column, $direction) = split / /, $args{order_by};
2705         if(grep  { $_ eq $column } @columns) {
2706             $direction ||= 'ASC';
2707             $query .= " ORDER BY $column $direction";
2708         }
2709     }
2710
2711     my $sth = $dbh->prepare($query);
2712     $sth->execute(@bind_args);
2713
2714     my $results = $sth->fetchall_arrayref({});
2715     return @$results;
2716 }
2717
2718 =head3 GetInvoice
2719
2720     my $invoice = GetInvoice($invoiceid);
2721
2722 Get informations about invoice with given $invoiceid
2723
2724 Return a hash filled with aqinvoices.* fields
2725
2726 =cut
2727
2728 sub GetInvoice {
2729     my ($invoiceid) = @_;
2730     my $invoice;
2731
2732     return unless $invoiceid;
2733
2734     my $dbh = C4::Context->dbh;
2735     my $query = qq{
2736         SELECT *
2737         FROM aqinvoices
2738         WHERE invoiceid = ?
2739     };
2740     my $sth = $dbh->prepare($query);
2741     $sth->execute($invoiceid);
2742
2743     $invoice = $sth->fetchrow_hashref;
2744     return $invoice;
2745 }
2746
2747 =head3 GetInvoiceDetails
2748
2749     my $invoice = GetInvoiceDetails($invoiceid)
2750
2751 Return informations about an invoice + the list of related order lines
2752
2753 Orders informations are in $invoice->{orders} (array ref)
2754
2755 =cut
2756
2757 sub GetInvoiceDetails {
2758     my ($invoiceid) = @_;
2759
2760     if ( !defined $invoiceid ) {
2761         carp 'GetInvoiceDetails called without an invoiceid';
2762         return;
2763     }
2764
2765     my $dbh = C4::Context->dbh;
2766     my $query = q{
2767         SELECT aqinvoices.*, aqbooksellers.name AS suppliername
2768         FROM aqinvoices
2769           LEFT JOIN aqbooksellers ON aqinvoices.booksellerid = aqbooksellers.id
2770         WHERE invoiceid = ?
2771     };
2772     my $sth = $dbh->prepare($query);
2773     $sth->execute($invoiceid);
2774
2775     my $invoice = $sth->fetchrow_hashref;
2776
2777     $query = q{
2778         SELECT aqorders.*,
2779                 biblio.*,
2780                 biblio.copyrightdate,
2781                 biblioitems.isbn,
2782                 biblioitems.publishercode,
2783                 biblioitems.publicationyear,
2784                 aqbasket.basketname,
2785                 aqbasketgroups.id AS basketgroupid,
2786                 aqbasketgroups.name AS basketgroupname
2787         FROM aqorders
2788           LEFT JOIN aqbasket ON aqorders.basketno = aqbasket.basketno
2789           LEFT JOIN aqbasketgroups ON aqbasket.basketgroupid = aqbasketgroups.id
2790           LEFT JOIN biblio ON aqorders.biblionumber = biblio.biblionumber
2791           LEFT JOIN biblioitems ON aqorders.biblionumber = biblioitems.biblionumber
2792         WHERE invoiceid = ?
2793     };
2794     $sth = $dbh->prepare($query);
2795     $sth->execute($invoiceid);
2796     $invoice->{orders} = $sth->fetchall_arrayref({});
2797     $invoice->{orders} ||= []; # force an empty arrayref if fetchall_arrayref fails
2798
2799     return $invoice;
2800 }
2801
2802 =head3 AddInvoice
2803
2804     my $invoiceid = AddInvoice(
2805         invoicenumber => $invoicenumber,
2806         booksellerid => $booksellerid,
2807         shipmentdate => $shipmentdate,
2808         billingdate => $billingdate,
2809         closedate => $closedate,
2810         shipmentcost => $shipmentcost,
2811         shipmentcost_budgetid => $shipmentcost_budgetid
2812     );
2813
2814 Create a new invoice and return its id or undef if it fails.
2815
2816 =cut
2817
2818 sub AddInvoice {
2819     my %invoice = @_;
2820
2821     return unless(%invoice and $invoice{invoicenumber});
2822
2823     my @columns = qw(invoicenumber booksellerid shipmentdate billingdate
2824         closedate shipmentcost shipmentcost_budgetid message_id);
2825
2826     my @set_strs;
2827     my @set_args;
2828     foreach my $key (keys %invoice) {
2829         if(0 < grep { $_ eq $key } @columns) {
2830             push @set_strs, "$key = ?";
2831             push @set_args, ($invoice{$key} || undef);
2832         }
2833     }
2834
2835     my $rv;
2836     if(@set_args > 0) {
2837         my $dbh = C4::Context->dbh;
2838         my $query = "INSERT INTO aqinvoices SET ";
2839         $query .= join (",", @set_strs);
2840         my $sth = $dbh->prepare($query);
2841         $rv = $sth->execute(@set_args);
2842         if($rv) {
2843             $rv = $dbh->last_insert_id(undef, undef, 'aqinvoices', undef);
2844         }
2845     }
2846     return $rv;
2847 }
2848
2849 =head3 ModInvoice
2850
2851     ModInvoice(
2852         invoiceid => $invoiceid,    # Mandatory
2853         invoicenumber => $invoicenumber,
2854         booksellerid => $booksellerid,
2855         shipmentdate => $shipmentdate,
2856         billingdate => $billingdate,
2857         closedate => $closedate,
2858         shipmentcost => $shipmentcost,
2859         shipmentcost_budgetid => $shipmentcost_budgetid
2860     );
2861
2862 Modify an invoice, invoiceid is mandatory.
2863
2864 Return undef if it fails.
2865
2866 =cut
2867
2868 sub ModInvoice {
2869     my %invoice = @_;
2870
2871     return unless(%invoice and $invoice{invoiceid});
2872
2873     my @columns = qw(invoicenumber booksellerid shipmentdate billingdate
2874         closedate shipmentcost shipmentcost_budgetid);
2875
2876     my @set_strs;
2877     my @set_args;
2878     foreach my $key (keys %invoice) {
2879         if(0 < grep { $_ eq $key } @columns) {
2880             push @set_strs, "$key = ?";
2881             push @set_args, ($invoice{$key} || undef);
2882         }
2883     }
2884
2885     my $dbh = C4::Context->dbh;
2886     my $query = "UPDATE aqinvoices SET ";
2887     $query .= join(",", @set_strs);
2888     $query .= " WHERE invoiceid = ?";
2889
2890     my $sth = $dbh->prepare($query);
2891     $sth->execute(@set_args, $invoice{invoiceid});
2892 }
2893
2894 =head3 CloseInvoice
2895
2896     CloseInvoice($invoiceid);
2897
2898 Close an invoice.
2899
2900 Equivalent to ModInvoice(invoiceid => $invoiceid, closedate => undef);
2901
2902 =cut
2903
2904 sub CloseInvoice {
2905     my ($invoiceid) = @_;
2906
2907     return unless $invoiceid;
2908
2909     my $dbh = C4::Context->dbh;
2910     my $query = qq{
2911         UPDATE aqinvoices
2912         SET closedate = CAST(NOW() AS DATE)
2913         WHERE invoiceid = ?
2914     };
2915     my $sth = $dbh->prepare($query);
2916     $sth->execute($invoiceid);
2917 }
2918
2919 =head3 ReopenInvoice
2920
2921     ReopenInvoice($invoiceid);
2922
2923 Reopen an invoice
2924
2925 Equivalent to ModInvoice(invoiceid => $invoiceid, closedate => output_pref({ dt=>dt_from_string, dateonly=>1, otputpref=>'iso' }))
2926
2927 =cut
2928
2929 sub ReopenInvoice {
2930     my ($invoiceid) = @_;
2931
2932     return unless $invoiceid;
2933
2934     my $dbh = C4::Context->dbh;
2935     my $query = qq{
2936         UPDATE aqinvoices
2937         SET closedate = NULL
2938         WHERE invoiceid = ?
2939     };
2940     my $sth = $dbh->prepare($query);
2941     $sth->execute($invoiceid);
2942 }
2943
2944 =head3 DelInvoice
2945
2946     DelInvoice($invoiceid);
2947
2948 Delete an invoice if there are no items attached to it.
2949
2950 =cut
2951
2952 sub DelInvoice {
2953     my ($invoiceid) = @_;
2954
2955     return unless $invoiceid;
2956
2957     my $dbh   = C4::Context->dbh;
2958     my $query = qq{
2959         SELECT COUNT(*)
2960         FROM aqorders
2961         WHERE invoiceid = ?
2962     };
2963     my $sth = $dbh->prepare($query);
2964     $sth->execute($invoiceid);
2965     my $res = $sth->fetchrow_arrayref;
2966     if ( $res && $res->[0] == 0 ) {
2967         $query = qq{
2968             DELETE FROM aqinvoices
2969             WHERE invoiceid = ?
2970         };
2971         my $sth = $dbh->prepare($query);
2972         return ( $sth->execute($invoiceid) > 0 );
2973     }
2974     return;
2975 }
2976
2977 =head3 MergeInvoices
2978
2979     MergeInvoices($invoiceid, \@sourceids);
2980
2981 Merge the invoices identified by the IDs in \@sourceids into
2982 the invoice identified by $invoiceid.
2983
2984 =cut
2985
2986 sub MergeInvoices {
2987     my ($invoiceid, $sourceids) = @_;
2988
2989     return unless $invoiceid;
2990     foreach my $sourceid (@$sourceids) {
2991         next if $sourceid == $invoiceid;
2992         my $source = GetInvoiceDetails($sourceid);
2993         foreach my $order (@{$source->{'orders'}}) {
2994             $order->{'invoiceid'} = $invoiceid;
2995             ModOrder($order);
2996         }
2997         DelInvoice($source->{'invoiceid'});
2998     }
2999     return;
3000 }
3001
3002 =head3 GetBiblioCountByBasketno
3003
3004 $biblio_count = &GetBiblioCountByBasketno($basketno);
3005
3006 Looks up the biblio's count that has basketno value $basketno
3007
3008 Returns a quantity
3009
3010 =cut
3011
3012 sub GetBiblioCountByBasketno {
3013     my ($basketno) = @_;
3014     my $dbh          = C4::Context->dbh;
3015     my $query        = "
3016         SELECT COUNT( DISTINCT( biblionumber ) )
3017         FROM   aqorders
3018         WHERE  basketno = ?
3019             AND datecancellationprinted IS NULL
3020         ";
3021
3022     my $sth = $dbh->prepare($query);
3023     $sth->execute($basketno);
3024     return $sth->fetchrow;
3025 }
3026
3027 =head3 populate_order_with_prices
3028
3029 $order = populate_order_with_prices({
3030     order        => $order #a hashref with the order values
3031     booksellerid => $booksellerid #FIXME - should obtain from order basket
3032     receiving    => 1 # boolean representing order stage, should pass only this or ordering
3033     ordering     => 1 # boolean representing order stage
3034 });
3035
3036
3037 Sets calculated values for an order - all values are stored with full precision
3038 regardless of rounding preference except for tax value which is calculated
3039 on rounded values if requested
3040
3041 For ordering the values set are:
3042     rrp_tax_included
3043     rrp_tax_excluded
3044     ecost_tax_included
3045     ecost_tax_excluded
3046     tax_value_on_ordering
3047 For receiving the value set are:
3048     unitprice_tax_included
3049     unitprice_tax_excluded
3050     tax_value_on_receiving
3051
3052 Note: When receiving, if the rounded value of the unitprice matches the rounded
3053 value of the ecost then then ecost (full precision) is used.
3054
3055 Returns a hashref of the order
3056
3057 FIXME: Move this to Koha::Acquisition::Order.pm
3058
3059 =cut
3060
3061 sub populate_order_with_prices {
3062     my ($params) = @_;
3063
3064     my $order        = $params->{order};
3065     my $booksellerid = $params->{booksellerid};
3066     return unless $booksellerid;
3067
3068     my $bookseller = Koha::Acquisition::Booksellers->find( $booksellerid );
3069
3070     my $receiving = $params->{receiving};
3071     my $ordering  = $params->{ordering};
3072     my $discount  = $order->{discount};
3073     $discount /= 100 if $discount > 1;
3074
3075     if ($ordering) {
3076         $order->{tax_rate_on_ordering} //= $order->{tax_rate};
3077         if ( $bookseller->listincgst ) {
3078
3079             # The user entered the prices tax included
3080             $order->{unitprice_tax_included} = $order->{unitprice};
3081             $order->{rrp_tax_included} = $order->{rrp};
3082
3083             # price tax excluded = price tax included / ( 1 + tax rate )
3084             $order->{unitprice_tax_excluded} = $order->{unitprice_tax_included} / ( 1 + $order->{tax_rate_on_ordering} );
3085             $order->{rrp_tax_excluded} = $order->{rrp_tax_included} / ( 1 + $order->{tax_rate_on_ordering} );
3086
3087             # ecost tax included = rrp tax included  ( 1 - discount )
3088             $order->{ecost_tax_included} = $order->{rrp_tax_included} * ( 1 - $discount );
3089
3090             # ecost tax excluded = rrp tax excluded * ( 1 - discount )
3091             $order->{ecost_tax_excluded} = $order->{rrp_tax_excluded} * ( 1 - $discount );
3092
3093             # tax value = quantity * ecost tax excluded * tax rate
3094             # we should use the unitprice if included
3095             my $cost_tax_included = $order->{unitprice_tax_included} || $order->{ecost_tax_included};
3096             my $cost_tax_excluded = $order->{unitprice_tax_excluded} || $order->{ecost_tax_excluded};
3097             $order->{tax_value_on_ordering} = ( get_rounded_price($cost_tax_included) - get_rounded_price($cost_tax_excluded) ) * $order->{quantity};
3098
3099         }
3100         else {
3101             # The user entered the prices tax excluded
3102             $order->{unitprice_tax_excluded} = $order->{unitprice};
3103             $order->{rrp_tax_excluded} = $order->{rrp};
3104
3105             # price tax included = price tax excluded * ( 1 - tax rate )
3106             $order->{unitprice_tax_included} = $order->{unitprice_tax_excluded} * ( 1 + $order->{tax_rate_on_ordering} );
3107             $order->{rrp_tax_included} = $order->{rrp_tax_excluded} * ( 1 + $order->{tax_rate_on_ordering} );
3108
3109             # ecost tax excluded = rrp tax excluded * ( 1 - discount )
3110             $order->{ecost_tax_excluded} = $order->{rrp_tax_excluded} * ( 1 - $discount );
3111
3112             # ecost tax included = rrp tax excluded * ( 1 + tax rate ) * ( 1 - discount ) = ecost tax excluded * ( 1 + tax rate )
3113             $order->{ecost_tax_included} = $order->{ecost_tax_excluded} * ( 1 + $order->{tax_rate_on_ordering} );
3114
3115             # tax value = quantity * ecost tax included * tax rate
3116             # we should use the unitprice if included
3117             my $cost_tax_excluded = $order->{unitprice_tax_excluded} || $order->{ecost_tax_excluded};
3118             $order->{tax_value_on_ordering} = $order->{quantity} * get_rounded_price($cost_tax_excluded) * $order->{tax_rate_on_ordering};
3119         }
3120     }
3121
3122     if ($receiving) {
3123         $order->{tax_rate_on_receiving} //= $order->{tax_rate};
3124         if ( $bookseller->invoiceincgst ) {
3125             # Trick for unitprice. If the unit price rounded value is the same as the ecost rounded value
3126             # we need to keep the exact ecost value
3127             if ( Koha::Number::Price->new( $order->{unitprice} )->round == Koha::Number::Price->new( $order->{ecost_tax_included} )->round ) {
3128                 $order->{unitprice} = $order->{ecost_tax_included};
3129             }
3130
3131             # The user entered the unit price tax included
3132             $order->{unitprice_tax_included} = $order->{unitprice};
3133
3134             # unit price tax excluded = unit price tax included / ( 1 + tax rate )
3135             $order->{unitprice_tax_excluded} = $order->{unitprice_tax_included} / ( 1 + $order->{tax_rate_on_receiving} );
3136         }
3137         else {
3138             # Trick for unitprice. If the unit price rounded value is the same as the ecost rounded value
3139             # we need to keep the exact ecost value
3140             if ( Koha::Number::Price->new( $order->{unitprice} )->round == Koha::Number::Price->new( $order->{ecost_tax_excluded} )->round ) {
3141                 $order->{unitprice} = $order->{ecost_tax_excluded};
3142             }
3143
3144             # The user entered the unit price tax excluded
3145             $order->{unitprice_tax_excluded} = $order->{unitprice};
3146
3147
3148             # unit price tax included = unit price tax included * ( 1 + tax rate )
3149             $order->{unitprice_tax_included} = $order->{unitprice_tax_excluded} * ( 1 + $order->{tax_rate_on_receiving} );
3150         }
3151
3152         # tax value = quantity * unit price tax excluded * tax rate
3153         $order->{tax_value_on_receiving} = $order->{quantity} * get_rounded_price($order->{unitprice_tax_excluded}) * $order->{tax_rate_on_receiving};
3154     }
3155
3156     return $order;
3157 }
3158
3159 =head3 GetOrderUsers
3160
3161     $order_users_ids = &GetOrderUsers($ordernumber);
3162
3163 Returns a list of all borrowernumbers that are in order users list
3164
3165 =cut
3166
3167 sub GetOrderUsers {
3168     my ($ordernumber) = @_;
3169
3170     return unless $ordernumber;
3171
3172     my $query = q|
3173         SELECT borrowernumber
3174         FROM aqorder_users
3175         WHERE ordernumber = ?
3176     |;
3177     my $dbh = C4::Context->dbh;
3178     my $sth = $dbh->prepare($query);
3179     $sth->execute($ordernumber);
3180     my $results = $sth->fetchall_arrayref( {} );
3181
3182     my @borrowernumbers;
3183     foreach (@$results) {
3184         push @borrowernumbers, $_->{'borrowernumber'};
3185     }
3186
3187     return @borrowernumbers;
3188 }
3189
3190 =head3 ModOrderUsers
3191
3192     my @order_users_ids = (1, 2, 3);
3193     &ModOrderUsers($ordernumber, @basketusers_ids);
3194
3195 Delete all users from order users list, and add users in C<@order_users_ids>
3196 to this users list.
3197
3198 =cut
3199
3200 sub ModOrderUsers {
3201     my ( $ordernumber, @order_users_ids ) = @_;
3202
3203     return unless $ordernumber;
3204
3205     my $dbh   = C4::Context->dbh;
3206     my $query = q|
3207         DELETE FROM aqorder_users
3208         WHERE ordernumber = ?
3209     |;
3210     my $sth = $dbh->prepare($query);
3211     $sth->execute($ordernumber);
3212
3213     $query = q|
3214         INSERT INTO aqorder_users (ordernumber, borrowernumber)
3215         VALUES (?, ?)
3216     |;
3217     $sth = $dbh->prepare($query);
3218     foreach my $order_user_id (@order_users_ids) {
3219         $sth->execute( $ordernumber, $order_user_id );
3220     }
3221 }
3222
3223 sub NotifyOrderUsers {
3224     my ($ordernumber) = @_;
3225
3226     my @borrowernumbers = GetOrderUsers($ordernumber);
3227     return unless @borrowernumbers;
3228
3229     my $order = GetOrder( $ordernumber );
3230     for my $borrowernumber (@borrowernumbers) {
3231         my $patron = Koha::Patrons->find( $borrowernumber );
3232         my $library = $patron->library->unblessed;
3233         my $biblio = Koha::Biblios->find( $order->{biblionumber} )->unblessed;
3234         my $letter = C4::Letters::GetPreparedLetter(
3235             module      => 'acquisition',
3236             letter_code => 'ACQ_NOTIF_ON_RECEIV',
3237             branchcode  => $library->{branchcode},
3238             lang        => $patron->lang,
3239             tables      => {
3240                 'branches'    => $library,
3241                 'borrowers'   => $patron->unblessed,
3242                 'biblio'      => $biblio,
3243                 'aqorders'    => $order,
3244             },
3245         );
3246         if ( $letter ) {
3247             C4::Letters::EnqueueLetter(
3248                 {
3249                     letter         => $letter,
3250                     borrowernumber => $borrowernumber,
3251                     LibraryName    => C4::Context->preference("LibraryName"),
3252                     message_transport_type => 'email',
3253                 }
3254             ) or warn "can't enqueue letter $letter";
3255         }
3256     }
3257 }
3258
3259 =head3 FillWithDefaultValues
3260
3261 FillWithDefaultValues( $marc_record );
3262
3263 This will update the record with default value defined in the ACQ framework.
3264 For all existing fields, if a default value exists and there are no subfield, it will be created.
3265 If the field does not exist, it will be created too.
3266
3267 =cut
3268
3269 sub FillWithDefaultValues {
3270     my ($record) = @_;
3271     my $tagslib = C4::Biblio::GetMarcStructure( 1, 'ACQ', { unsafe => 1 } );
3272     if ($tagslib) {
3273         my ($itemfield) =
3274           C4::Biblio::GetMarcFromKohaField( 'items.itemnumber' );
3275         for my $tag ( sort keys %$tagslib ) {
3276             next unless $tag;
3277             next if $tag == $itemfield;
3278             for my $subfield ( sort keys %{ $tagslib->{$tag} } ) {
3279                 next if IsMarcStructureInternal($tagslib->{$tag}{$subfield});
3280                 my $defaultvalue = $tagslib->{$tag}{$subfield}{defaultvalue};
3281                 if ( defined $defaultvalue and $defaultvalue ne '' ) {
3282                     my @fields = $record->field($tag);
3283                     if (@fields) {
3284                         for my $field (@fields) {
3285                             if ( $field->is_control_field ) {
3286                                 $field->update($defaultvalue) if not defined $field->data;
3287                             }
3288                             elsif ( not defined $field->subfield($subfield) ) {
3289                                 $field->add_subfields(
3290                                     $subfield => $defaultvalue );
3291                             }
3292                         }
3293                     }
3294                     else {
3295                         if ( $tag < 10 ) { # is_control_field
3296                             $record->insert_fields_ordered(
3297                                 MARC::Field->new(
3298                                     $tag, $defaultvalue
3299                                 )
3300                             );
3301                         }
3302                         else {
3303                             $record->insert_fields_ordered(
3304                                 MARC::Field->new(
3305                                     $tag, '', '', $subfield => $defaultvalue
3306                                 )
3307                             );
3308                         }
3309                     }
3310                 }
3311             }
3312         }
3313     }
3314 }
3315
3316 1;
3317 __END__
3318
3319 =head1 AUTHOR
3320
3321 Koha Development Team <http://koha-community.org/>
3322
3323 =cut