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