C4/Acquisition.pm

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