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(q|UPDATE aqorders
1460                 SET order_internalnote = ?|, {}, $order->{order_internalnote});
1461         }
1462
1463         # Recalculate tax_value
1464         $dbh->do(q|
1465             UPDATE aqorders
1466             SET
1467                 tax_value_on_ordering = quantity * | . get_rounding_sql(q|ecost_tax_excluded|) . q| * tax_rate_on_ordering,
1468                 tax_value_on_receiving = quantity * | . get_rounding_sql(q|unitprice_tax_excluded|) . q| * tax_rate_on_receiving
1469             WHERE ordernumber = ?
1470         |, undef, $order->{ordernumber});
1471
1472         delete $order->{ordernumber};
1473         $order->{budget_id} = ( $budget_id || $order->{budget_id} );
1474         $order->{quantity} = $quantrec;
1475         $order->{quantityreceived} = $quantrec;
1476         $order->{ecost_tax_excluded} //= 0;
1477         $order->{tax_rate_on_ordering} //= 0;
1478         $order->{unitprice_tax_excluded} //= 0;
1479         $order->{tax_rate_on_receiving} //= 0;
1480         $order->{tax_value_on_ordering} = $order->{quantity} * get_rounded_price($order->{ecost_tax_excluded}) * $order->{tax_rate_on_ordering};
1481         $order->{tax_value_on_receiving} = $order->{quantity} * get_rounded_price($order->{unitprice_tax_excluded}) * $order->{tax_rate_on_receiving};
1482         $order->{datereceived} = $datereceived;
1483         $order->{invoiceid} = $invoice->{invoiceid};
1484         $order->{orderstatus} = 'complete';
1485         $new_ordernumber = Koha::Acquisition::Order->new($order)->store->ordernumber; # TODO What if the store fails?
1486
1487         if ($received_items) {
1488             foreach my $itemnumber (@$received_items) {
1489                 ModItemOrder($itemnumber, $new_ordernumber);
1490             }
1491         }
1492     } else {
1493         my $query = q|
1494             UPDATE aqorders
1495             SET quantityreceived = ?,
1496                 datereceived = ?,
1497                 invoiceid = ?,
1498                 budget_id = ?,
1499                 orderstatus = 'complete'
1500         |;
1501
1502         $query .= q|
1503             , replacementprice = ?
1504         | if defined $order->{replacementprice};
1505
1506         $query .= q|
1507             , unitprice = ?, unitprice_tax_included = ?, unitprice_tax_excluded = ?
1508         | if defined $order->{unitprice};
1509
1510         $query .= q|
1511             ,tax_value_on_receiving = ?
1512         | if defined $order->{tax_value_on_receiving};
1513
1514         $query .= q|
1515             ,tax_rate_on_receiving = ?
1516         | if defined $order->{tax_rate_on_receiving};
1517
1518         $query .= q|
1519             , order_internalnote = ?
1520         | if defined $order->{order_internalnote};
1521
1522         $query .= q| where biblionumber=? and ordernumber=?|;
1523
1524         my $sth = $dbh->prepare( $query );
1525         my @params = ( $quantrec, $datereceived, $invoice->{invoiceid}, ( $budget_id ? $budget_id : $order->{budget_id} ) );
1526
1527         if ( defined $order->{replacementprice} ) {
1528             push @params, $order->{replacementprice};
1529         }
1530
1531         if ( defined $order->{unitprice} ) {
1532             push @params, $order->{unitprice}, $order->{unitprice_tax_included}, $order->{unitprice_tax_excluded};
1533         }
1534
1535         if ( defined $order->{tax_value_on_receiving} ) {
1536             push @params, $order->{tax_value_on_receiving};
1537         }
1538
1539         if ( defined $order->{tax_rate_on_receiving} ) {
1540             push @params, $order->{tax_rate_on_receiving};
1541         }
1542
1543         if ( defined $order->{order_internalnote} ) {
1544             push @params, $order->{order_internalnote};
1545         }
1546
1547         push @params, ( $biblionumber, $order->{ordernumber} );
1548
1549         $sth->execute( @params );
1550
1551         # All items have been received, sent a notification to users
1552         NotifyOrderUsers( $order->{ordernumber} );
1553
1554     }
1555     return ($datereceived, $new_ordernumber);
1556 }
1557
1558 =head3 CancelReceipt
1559
1560     my $parent_ordernumber = CancelReceipt($ordernumber);
1561
1562     Cancel an order line receipt and update the parent order line, as if no
1563     receipt was made.
1564     If items are created at receipt (AcqCreateItem = receiving) then delete
1565     these items.
1566
1567 =cut
1568
1569 sub CancelReceipt {
1570     my $ordernumber = shift;
1571
1572     return unless $ordernumber;
1573
1574     my $dbh = C4::Context->dbh;
1575     my $query = qq{
1576         SELECT datereceived, parent_ordernumber, quantity
1577         FROM aqorders
1578         WHERE ordernumber = ?
1579     };
1580     my $sth = $dbh->prepare($query);
1581     $sth->execute($ordernumber);
1582     my $order = $sth->fetchrow_hashref;
1583     unless($order) {
1584         warn "CancelReceipt: order $ordernumber does not exist";
1585         return;
1586     }
1587     unless($order->{'datereceived'}) {
1588         warn "CancelReceipt: order $ordernumber is not received";
1589         return;
1590     }
1591
1592     my $parent_ordernumber = $order->{'parent_ordernumber'};
1593
1594     my $order_obj = Koha::Acquisition::Orders->find( $ordernumber ); # FIXME rewrite all this subroutine using this object
1595     my @itemnumbers = $order_obj->items->get_column('itemnumber');
1596
1597     if($parent_ordernumber == $ordernumber || not $parent_ordernumber) {
1598         # The order line has no parent, just mark it as not received
1599         $query = qq{
1600             UPDATE aqorders
1601             SET quantityreceived = ?,
1602                 datereceived = ?,
1603                 invoiceid = ?,
1604                 orderstatus = 'ordered'
1605             WHERE ordernumber = ?
1606         };
1607         $sth = $dbh->prepare($query);
1608         $sth->execute(0, undef, undef, $ordernumber);
1609         _cancel_items_receipt( $order_obj );
1610     } else {
1611         # The order line has a parent, increase parent quantity and delete
1612         # the order line.
1613         $query = qq{
1614             SELECT quantity, datereceived
1615             FROM aqorders
1616             WHERE ordernumber = ?
1617         };
1618         $sth = $dbh->prepare($query);
1619         $sth->execute($parent_ordernumber);
1620         my $parent_order = $sth->fetchrow_hashref;
1621         unless($parent_order) {
1622             warn "Parent order $parent_ordernumber does not exist.";
1623             return;
1624         }
1625         if($parent_order->{'datereceived'}) {
1626             warn "CancelReceipt: parent order is received.".
1627                 " Can't cancel receipt.";
1628             return;
1629         }
1630         $query = qq{
1631             UPDATE aqorders
1632             SET quantity = ?,
1633                 orderstatus = 'ordered'
1634             WHERE ordernumber = ?
1635         };
1636         $sth = $dbh->prepare($query);
1637         my $rv = $sth->execute(
1638             $order->{'quantity'} + $parent_order->{'quantity'},
1639             $parent_ordernumber
1640         );
1641         unless($rv) {
1642             warn "Cannot update parent order line, so do not cancel".
1643                 " receipt";
1644             return;
1645         }
1646
1647         # Recalculate tax_value
1648         $dbh->do(q|
1649             UPDATE aqorders
1650             SET
1651                 tax_value_on_ordering = quantity * | . get_rounding_sql(q|ecost_tax_excluded|) . q| * tax_rate_on_ordering,
1652                 tax_value_on_receiving = quantity * | . get_rounding_sql(q|unitprice_tax_excluded|) . q| * tax_rate_on_receiving
1653             WHERE ordernumber = ?
1654         |, undef, $parent_ordernumber);
1655
1656         _cancel_items_receipt( $order_obj, $parent_ordernumber );
1657         # Delete order line
1658         $query = qq{
1659             DELETE FROM aqorders
1660             WHERE ordernumber = ?
1661         };
1662         $sth = $dbh->prepare($query);
1663         $sth->execute($ordernumber);
1664
1665     }
1666
1667     if( $order_obj->basket->effective_create_items eq 'ordering' ) {
1668         my @affects = split q{\|}, C4::Context->preference("AcqItemSetSubfieldsWhenReceiptIsCancelled");
1669         if ( @affects ) {
1670             for my $in ( @itemnumbers ) {
1671                 my $item = Koha::Items->find( $in ); # FIXME We do not need that, we already have Koha::Items from $order_obj->items
1672                 my $biblio = $item->biblio;
1673                 my ( $itemfield ) = GetMarcFromKohaField( 'items.itemnumber', $biblio->frameworkcode );
1674                 my $item_marc = C4::Items::GetMarcItem( $biblio->biblionumber, $in );
1675                 for my $affect ( @affects ) {
1676                     my ( $sf, $v ) = split q{=}, $affect, 2;
1677                     foreach ( $item_marc->field($itemfield) ) {
1678                         $_->update( $sf => $v );
1679                     }
1680                 }
1681                 C4::Items::ModItemFromMarc( $item_marc, $biblio->biblionumber, $in );
1682             }
1683         }
1684     }
1685
1686     return $parent_ordernumber;
1687 }
1688
1689 sub _cancel_items_receipt {
1690     my ( $order, $parent_ordernumber ) = @_;
1691     $parent_ordernumber ||= $order->ordernumber;
1692
1693     my $items = $order->items;
1694     if ( $order->basket->effective_create_items eq 'receiving' ) {
1695         # Remove items that were created at receipt
1696         my $query = qq{
1697             DELETE FROM items, aqorders_items
1698             USING items, aqorders_items
1699             WHERE items.itemnumber = ? AND aqorders_items.itemnumber = ?
1700         };
1701         my $dbh = C4::Context->dbh;
1702         my $sth = $dbh->prepare($query);
1703         while ( my $item = $items->next ) {
1704             $sth->execute($item->itemnumber, $item->itemnumber);
1705         }
1706     } else {
1707         # Update items
1708         while ( my $item = $items->next ) {
1709             ModItemOrder($item->itemnumber, $parent_ordernumber);
1710         }
1711     }
1712 }
1713
1714 #------------------------------------------------------------#
1715
1716 =head3 SearchOrders
1717
1718 @results = &SearchOrders({
1719     ordernumber => $ordernumber,
1720     search => $search,
1721     ean => $ean,
1722     booksellerid => $booksellerid,
1723     basketno => $basketno,
1724     basketname => $basketname,
1725     basketgroupname => $basketgroupname,
1726     owner => $owner,
1727     pending => $pending
1728     ordered => $ordered
1729     biblionumber => $biblionumber,
1730     budget_id => $budget_id
1731 });
1732
1733 Searches for orders filtered by criteria.
1734
1735 C<$ordernumber> Finds matching orders or transferred orders by ordernumber.
1736 C<$search> Finds orders matching %$search% in title, author, or isbn.
1737 C<$owner> Finds order for the logged in user.
1738 C<$pending> Finds pending orders. Ignores completed and cancelled orders.
1739 C<$ordered> Finds orders to receive only (status 'ordered' or 'partial').
1740
1741
1742 C<@results> is an array of references-to-hash with the keys are fields
1743 from aqorders, biblio, biblioitems and aqbasket tables.
1744
1745 =cut
1746
1747 sub SearchOrders {
1748     my ( $params ) = @_;
1749     my $ordernumber = $params->{ordernumber};
1750     my $search = $params->{search};
1751     my $ean = $params->{ean};
1752     my $booksellerid = $params->{booksellerid};
1753     my $basketno = $params->{basketno};
1754     my $basketname = $params->{basketname};
1755     my $basketgroupname = $params->{basketgroupname};
1756     my $owner = $params->{owner};
1757     my $pending = $params->{pending};
1758     my $ordered = $params->{ordered};
1759     my $biblionumber = $params->{biblionumber};
1760     my $budget_id = $params->{budget_id};
1761
1762     my $dbh = C4::Context->dbh;
1763     my @args = ();
1764     my $query = q{
1765         SELECT aqbasket.basketno,
1766                borrowers.surname,
1767                borrowers.firstname,
1768                biblio.*,
1769                biblioitems.isbn,
1770                biblioitems.biblioitemnumber,
1771                biblioitems.publishercode,
1772                biblioitems.publicationyear,
1773                aqbasket.authorisedby,
1774                aqbasket.booksellerid,
1775                aqbasket.closedate,
1776                aqbasket.creationdate,
1777                aqbasket.basketname,
1778                aqbasketgroups.id as basketgroupid,
1779                aqbasketgroups.name as basketgroupname,
1780                aqorders.*
1781         FROM aqorders
1782             LEFT JOIN aqbasket ON aqorders.basketno = aqbasket.basketno
1783             LEFT JOIN aqbasketgroups ON aqbasket.basketgroupid = aqbasketgroups.id
1784             LEFT JOIN borrowers ON aqbasket.authorisedby=borrowers.borrowernumber
1785             LEFT JOIN biblio ON aqorders.biblionumber=biblio.biblionumber
1786             LEFT JOIN biblioitems ON biblioitems.biblionumber=biblio.biblionumber
1787     };
1788
1789     # If we search on ordernumber, we retrieve the transferred order if a transfer has been done.
1790     $query .= q{
1791             LEFT JOIN aqorders_transfers ON aqorders_transfers.ordernumber_to = aqorders.ordernumber
1792     } if $ordernumber;
1793
1794     $query .= q{
1795         WHERE (datecancellationprinted is NULL)
1796     };
1797
1798     if ( $pending or $ordered ) {
1799         $query .= q{
1800             AND (
1801                 ( aqbasket.is_standing AND aqorders.orderstatus IN ( "new", "ordered", "partial" ) )
1802                 OR (
1803                     ( quantity > quantityreceived OR quantityreceived is NULL )
1804         };
1805
1806         if ( $ordered ) {
1807             $query .= q{ AND aqorders.orderstatus IN ( "ordered", "partial" )};
1808         }
1809         $query .= q{
1810                 )
1811             )
1812         };
1813     }
1814
1815     my $userenv = C4::Context->userenv;
1816     if ( C4::Context->preference("IndependentBranches") ) {
1817         unless ( C4::Context->IsSuperLibrarian() ) {
1818             $query .= q{
1819                 AND (
1820                     borrowers.branchcode = ?
1821                     OR borrowers.branchcode  = ''
1822                 )
1823             };
1824             push @args, $userenv->{branch};
1825         }
1826     }
1827
1828     if ( $ordernumber ) {
1829         $query .= ' AND ( aqorders.ordernumber = ? OR aqorders_transfers.ordernumber_from = ? ) ';
1830         push @args, ( $ordernumber, $ordernumber );
1831     }
1832     if ( $biblionumber ) {
1833         $query .= 'AND aqorders.biblionumber = ?';
1834         push @args, $biblionumber;
1835     }
1836     if( $search ) {
1837         $query .= ' AND (biblio.title LIKE ? OR biblio.author LIKE ? OR biblioitems.isbn LIKE ?)';
1838         push @args, ("%$search%","%$search%","%$search%");
1839     }
1840     if ( $ean ) {
1841         $query .= ' AND biblioitems.ean = ?';
1842         push @args, $ean;
1843     }
1844     if ( $booksellerid ) {
1845         $query .= 'AND aqbasket.booksellerid = ?';
1846         push @args, $booksellerid;
1847     }
1848     if( $basketno ) {
1849         $query .= 'AND aqbasket.basketno = ?';
1850         push @args, $basketno;
1851     }
1852     if( $basketname ) {
1853         $query .= 'AND aqbasket.basketname LIKE ?';
1854         push @args, "%$basketname%";
1855     }
1856     if( $basketgroupname ) {
1857         $query .= ' AND aqbasketgroups.name LIKE ?';
1858         push @args, "%$basketgroupname%";
1859     }
1860
1861     if ( $owner ) {
1862         $query .= ' AND aqbasket.authorisedby=? ';
1863         push @args, $userenv->{'number'};
1864     }
1865
1866     if ( $budget_id ) {
1867         $query .= ' AND aqorders.budget_id = ?';
1868         push @args, $budget_id;
1869     }
1870
1871     $query .= ' ORDER BY aqbasket.basketno';
1872
1873     my $sth = $dbh->prepare($query);
1874     $sth->execute(@args);
1875     return $sth->fetchall_arrayref({});
1876 }
1877
1878 #------------------------------------------------------------#
1879
1880 =head3 DelOrder
1881
1882   &DelOrder($biblionumber, $ordernumber);
1883
1884 Cancel the order with the given order and biblio numbers. It does not
1885 delete any entries in the aqorders table, it merely marks them as
1886 cancelled.
1887
1888 =cut
1889
1890 sub DelOrder {
1891     my ( $bibnum, $ordernumber, $delete_biblio, $reason ) = @_;
1892
1893     my $error;
1894     my $dbh = C4::Context->dbh;
1895     my $query = "
1896         UPDATE aqorders
1897         SET    datecancellationprinted=now(), orderstatus='cancelled'
1898     ";
1899     if($reason) {
1900         $query .= ", cancellationreason = ? ";
1901     }
1902     $query .= "
1903         WHERE biblionumber=? AND ordernumber=?
1904     ";
1905     my $sth = $dbh->prepare($query);
1906     if($reason) {
1907         $sth->execute($reason, $bibnum, $ordernumber);
1908     } else {
1909         $sth->execute( $bibnum, $ordernumber );
1910     }
1911     $sth->finish;
1912
1913     my $order = Koha::Acquisition::Orders->find($ordernumber);
1914     my $items = $order->items;
1915     while ( my $item = $items->next ) { # Should be moved to Koha::Acquisition::Order->delete
1916         my $delcheck = C4::Items::DelItemCheck( $bibnum, $item->itemnumber );
1917
1918         if($delcheck != 1) {
1919             $error->{'delitem'} = 1;
1920         }
1921     }
1922
1923     if($delete_biblio) {
1924         # We get the number of remaining items
1925         my $biblio = Koha::Biblios->find( $bibnum );
1926         my $itemcount = $biblio->items->count;
1927
1928         # If there are no items left,
1929         if ( $itemcount == 0 ) {
1930             # We delete the record
1931             my $delcheck = DelBiblio($bibnum);
1932
1933             if($delcheck) {
1934                 $error->{'delbiblio'} = 1;
1935             }
1936         }
1937     }
1938
1939     return $error;
1940 }
1941
1942 =head3 TransferOrder
1943
1944     my $newordernumber = TransferOrder($ordernumber, $basketno);
1945
1946 Transfer an order line to a basket.
1947 Mark $ordernumber as cancelled with an internal note 'Cancelled and transferred
1948 to BOOKSELLER on DATE' and create new order with internal note
1949 'Transferred from BOOKSELLER on DATE'.
1950 Move all attached items to the new order.
1951 Received orders cannot be transferred.
1952 Return the ordernumber of created order.
1953
1954 =cut
1955
1956 sub TransferOrder {
1957     my ($ordernumber, $basketno) = @_;
1958
1959     return unless ($ordernumber and $basketno);
1960
1961     my $order = Koha::Acquisition::Orders->find( $ordernumber ) or return;
1962     return if $order->datereceived;
1963
1964     $order = $order->unblessed;
1965
1966     my $basket = GetBasket($basketno);
1967     return unless $basket;
1968
1969     my $dbh = C4::Context->dbh;
1970     my ($query, $sth, $rv);
1971
1972     $query = q{
1973         UPDATE aqorders
1974         SET datecancellationprinted = CAST(NOW() AS date), orderstatus = ?
1975         WHERE ordernumber = ?
1976     };
1977     $sth = $dbh->prepare($query);
1978     $rv = $sth->execute('cancelled', $ordernumber);
1979
1980     delete $order->{'ordernumber'};
1981     delete $order->{parent_ordernumber};
1982     $order->{'basketno'} = $basketno;
1983
1984     my $newordernumber = Koha::Acquisition::Order->new($order)->store->ordernumber;
1985
1986     $query = q{
1987         UPDATE aqorders_items
1988         SET ordernumber = ?
1989         WHERE ordernumber = ?
1990     };
1991     $sth = $dbh->prepare($query);
1992     $sth->execute($newordernumber, $ordernumber);
1993
1994     $query = q{
1995         INSERT INTO aqorders_transfers (ordernumber_from, ordernumber_to)
1996         VALUES (?, ?)
1997     };
1998     $sth = $dbh->prepare($query);
1999     $sth->execute($ordernumber, $newordernumber);
2000
2001     return $newordernumber;
2002 }
2003
2004 =head3 get_rounding_sql
2005
2006     $rounding_sql = get_rounding_sql($column_name);
2007
2008 returns the correct SQL routine based on OrderPriceRounding system preference.
2009
2010 =cut
2011
2012 sub get_rounding_sql {
2013     my ( $round_string ) = @_;
2014     my $rounding_pref = C4::Context->preference('OrderPriceRounding') // q{};
2015     if ( $rounding_pref eq "nearest_cent"  ) {
2016         return "CAST($round_string*100 AS SIGNED)/100";
2017     }
2018     return $round_string;
2019 }
2020
2021 =head3 get_rounded_price
2022
2023     $rounded_price = get_rounded_price( $price );
2024
2025 returns a price rounded as specified in OrderPriceRounding system preference.
2026
2027 =cut
2028
2029 sub get_rounded_price {
2030     my ( $price ) =  @_;
2031     my $rounding_pref = C4::Context->preference('OrderPriceRounding') // q{};
2032     if( $rounding_pref eq 'nearest_cent' ) {
2033         return Koha::Number::Price->new( $price )->round();
2034     }
2035     return $price;
2036 }
2037
2038
2039 =head2 FUNCTIONS ABOUT PARCELS
2040
2041 =head3 GetParcels
2042
2043   $results = &GetParcels($bookseller, $order, $code, $datefrom, $dateto);
2044
2045 get a lists of parcels.
2046
2047 * Input arg :
2048
2049 =over
2050
2051 =item $bookseller
2052 is the bookseller this function has to get parcels.
2053
2054 =item $order
2055 To know on what criteria the results list has to be ordered.
2056
2057 =item $code
2058 is the booksellerinvoicenumber.
2059
2060 =item $datefrom & $dateto
2061 to know on what date this function has to filter its search.
2062
2063 =back
2064
2065 * return:
2066 a pointer on a hash list containing parcel informations as such :
2067
2068 =over
2069
2070 =item Creation date
2071
2072 =item Last operation
2073
2074 =item Number of biblio
2075
2076 =item Number of items
2077
2078 =back
2079
2080 =cut
2081
2082 sub GetParcels {
2083     my ($bookseller,$order, $code, $datefrom, $dateto) = @_;
2084     my $dbh    = C4::Context->dbh;
2085     my @query_params = ();
2086     my $strsth ="
2087         SELECT  aqinvoices.invoicenumber,
2088                 datereceived,purchaseordernumber,
2089                 count(DISTINCT biblionumber) AS biblio,
2090                 sum(quantity) AS itemsexpected,
2091                 sum(quantityreceived) AS itemsreceived
2092         FROM   aqorders LEFT JOIN aqbasket ON aqbasket.basketno = aqorders.basketno
2093         LEFT JOIN aqinvoices ON aqorders.invoiceid = aqinvoices.invoiceid
2094         WHERE aqbasket.booksellerid = ? and datereceived IS NOT NULL
2095     ";
2096     push @query_params, $bookseller;
2097
2098     if ( defined $code ) {
2099         $strsth .= ' and aqinvoices.invoicenumber like ? ';
2100         # add a % to the end of the code to allow stemming.
2101         push @query_params, "$code%";
2102     }
2103
2104     if ( defined $datefrom ) {
2105         $strsth .= ' and datereceived >= ? ';
2106         push @query_params, $datefrom;
2107     }
2108
2109     if ( defined $dateto ) {
2110         $strsth .=  'and datereceived <= ? ';
2111         push @query_params, $dateto;
2112     }
2113
2114     $strsth .= "group by aqinvoices.invoicenumber,datereceived ";
2115
2116     # can't use a placeholder to place this column name.
2117     # but, we could probably be checking to make sure it is a column that will be fetched.
2118     $strsth .= "order by $order " if ($order);
2119
2120     my $sth = $dbh->prepare($strsth);
2121
2122     $sth->execute( @query_params );
2123     my $results = $sth->fetchall_arrayref({});
2124     return @{$results};
2125 }
2126
2127 #------------------------------------------------------------#
2128
2129 =head3 GetLateOrders
2130
2131   @results = &GetLateOrders;
2132
2133 Searches for bookseller with late orders.
2134
2135 return:
2136 the table of supplier with late issues. This table is full of hashref.
2137
2138 =cut
2139
2140 sub GetLateOrders {
2141     my $delay      = shift;
2142     my $supplierid = shift;
2143     my $branch     = shift;
2144     my $estimateddeliverydatefrom = shift;
2145     my $estimateddeliverydateto = shift;
2146
2147     my $dbh = C4::Context->dbh;
2148
2149     #BEWARE, order of parenthesis and LEFT JOIN is important for speed
2150     my $dbdriver = C4::Context->config("db_scheme") || "mysql";
2151
2152     my @query_params = ();
2153     my $select = "
2154     SELECT aqbasket.basketno,
2155         aqorders.ordernumber,
2156         DATE(aqbasket.closedate)  AS orderdate,
2157         aqbasket.basketname       AS basketname,
2158         aqbasket.basketgroupid    AS basketgroupid,
2159         aqbasketgroups.name       AS basketgroupname,
2160         aqorders.rrp              AS unitpricesupplier,
2161         aqorders.ecost            AS unitpricelib,
2162         aqorders.claims_count     AS claims_count,
2163         aqorders.claimed_date     AS claimed_date,
2164         aqbudgets.budget_name     AS budget,
2165         borrowers.branchcode      AS branch,
2166         aqbooksellers.name        AS supplier,
2167         aqbooksellers.id          AS supplierid,
2168         biblio.author, biblio.title,
2169         biblioitems.publishercode AS publisher,
2170         biblioitems.publicationyear,
2171         ADDDATE(aqbasket.closedate, INTERVAL aqbooksellers.deliverytime DAY) AS estimateddeliverydate,
2172     ";
2173     my $from = "
2174     FROM
2175         aqorders LEFT JOIN biblio     ON biblio.biblionumber         = aqorders.biblionumber
2176         LEFT JOIN biblioitems         ON biblioitems.biblionumber    = biblio.biblionumber
2177         LEFT JOIN aqbudgets           ON aqorders.budget_id          = aqbudgets.budget_id,
2178         aqbasket LEFT JOIN borrowers  ON aqbasket.authorisedby       = borrowers.borrowernumber
2179         LEFT JOIN aqbooksellers       ON aqbasket.booksellerid       = aqbooksellers.id
2180         LEFT JOIN aqbasketgroups      ON aqbasket.basketgroupid      = aqbasketgroups.id
2181         WHERE aqorders.basketno = aqbasket.basketno
2182         AND ( datereceived = ''
2183             OR datereceived IS NULL
2184             OR aqorders.quantityreceived < aqorders.quantity
2185         )
2186         AND aqbasket.closedate IS NOT NULL
2187         AND (aqorders.datecancellationprinted IS NULL OR aqorders.datecancellationprinted='0000-00-00')
2188     ";
2189     if ($dbdriver eq "mysql") {
2190         $select .= "
2191         aqorders.quantity - COALESCE(aqorders.quantityreceived,0)                 AS quantity,
2192         (aqorders.quantity - COALESCE(aqorders.quantityreceived,0)) * aqorders.rrp AS subtotal,
2193         DATEDIFF(CAST(now() AS date),closedate) AS latesince
2194         ";
2195         if ( defined $delay ) {
2196             $from .= " AND (closedate <= DATE_SUB(CAST(now() AS date),INTERVAL ? DAY)) " ;
2197             push @query_params, $delay;
2198         }
2199         $from .= " AND aqorders.quantity - COALESCE(aqorders.quantityreceived,0) <> 0";
2200     } else {
2201         # FIXME: account for IFNULL as above
2202         $select .= "
2203                 aqorders.quantity                AS quantity,
2204                 aqorders.quantity * aqorders.rrp AS subtotal,
2205                 (CAST(now() AS date) - closedate)            AS latesince
2206         ";
2207         if ( defined $delay ) {
2208             $from .= " AND (closedate <= (CAST(now() AS date) -(INTERVAL ? DAY)) ";
2209             push @query_params, $delay;
2210         }
2211         $from .= " AND aqorders.quantity <> 0";
2212     }
2213     if (defined $supplierid) {
2214         $from .= ' AND aqbasket.booksellerid = ? ';
2215         push @query_params, $supplierid;
2216     }
2217     if (defined $branch) {
2218         $from .= ' AND borrowers.branchcode LIKE ? ';
2219         push @query_params, $branch;
2220     }
2221
2222     if ( defined $estimateddeliverydatefrom or defined $estimateddeliverydateto ) {
2223         $from .= ' AND aqbooksellers.deliverytime IS NOT NULL ';
2224     }
2225     if ( defined $estimateddeliverydatefrom ) {
2226         $from .= ' AND ADDDATE(aqbasket.closedate, INTERVAL aqbooksellers.deliverytime DAY) >= ?';
2227         push @query_params, $estimateddeliverydatefrom;
2228     }
2229     if ( defined $estimateddeliverydateto ) {
2230         $from .= ' AND ADDDATE(aqbasket.closedate, INTERVAL aqbooksellers.deliverytime DAY) <= ?';
2231         push @query_params, $estimateddeliverydateto;
2232     }
2233     if ( defined $estimateddeliverydatefrom and not defined $estimateddeliverydateto ) {
2234         $from .= ' AND ADDDATE(aqbasket.closedate, INTERVAL aqbooksellers.deliverytime DAY) <= CAST(now() AS date)';
2235     }
2236     if (C4::Context->preference("IndependentBranches")
2237             && !C4::Context->IsSuperLibrarian() ) {
2238         $from .= ' AND borrowers.branchcode LIKE ? ';
2239         push @query_params, C4::Context->userenv->{branch};
2240     }
2241     $from .= " AND orderstatus <> 'cancelled' ";
2242     my $query = "$select $from \nORDER BY latesince, basketno, borrowers.branchcode, supplier";
2243     $debug and print STDERR "GetLateOrders query: $query\nGetLateOrders args: " . join(" ",@query_params);
2244     my $sth = $dbh->prepare($query);
2245     $sth->execute(@query_params);
2246     my @results;
2247     while (my $data = $sth->fetchrow_hashref) {
2248         push @results, $data;
2249     }
2250     return @results;
2251 }
2252
2253 #------------------------------------------------------------#
2254
2255 =head3 GetHistory
2256
2257   \@order_loop = GetHistory( %params );
2258
2259 Retreives some acquisition history information
2260
2261 params:
2262   title
2263   author
2264   name
2265   isbn
2266   ean
2267   from_placed_on
2268   to_placed_on
2269   basket                  - search both basket name and number
2270   booksellerinvoicenumber
2271   basketgroupname
2272   budget
2273   orderstatus (note that orderstatus '' will retrieve orders
2274                of any status except cancelled)
2275   biblionumber
2276   get_canceled_order (if set to a true value, cancelled orders will
2277                       be included)
2278
2279 returns:
2280     $order_loop is a list of hashrefs that each look like this:
2281             {
2282                 'author'           => 'Twain, Mark',
2283                 'basketno'         => '1',
2284                 'biblionumber'     => '215',
2285                 'count'            => 1,
2286                 'creationdate'     => 'MM/DD/YYYY',
2287                 'datereceived'     => undef,
2288                 'ecost'            => '1.00',
2289                 'id'               => '1',
2290                 'invoicenumber'    => undef,
2291                 'name'             => '',
2292                 'ordernumber'      => '1',
2293                 'quantity'         => 1,
2294                 'quantityreceived' => undef,
2295                 'title'            => 'The Adventures of Huckleberry Finn'
2296             }
2297
2298 =cut
2299
2300 sub GetHistory {
2301 # don't run the query if there are no parameters (list would be too long for sure !)
2302     croak "No search params" unless @_;
2303     my %params = @_;
2304     my $title = $params{title};
2305     my $author = $params{author};
2306     my $isbn   = $params{isbn};
2307     my $ean    = $params{ean};
2308     my $name = $params{name};
2309     my $from_placed_on = $params{from_placed_on};
2310     my $to_placed_on = $params{to_placed_on};
2311     my $basket = $params{basket};
2312     my $booksellerinvoicenumber = $params{booksellerinvoicenumber};
2313     my $basketgroupname = $params{basketgroupname};
2314     my $budget = $params{budget};
2315     my $orderstatus = $params{orderstatus};
2316     my $biblionumber = $params{biblionumber};
2317     my $get_canceled_order = $params{get_canceled_order} || 0;
2318     my $ordernumber = $params{ordernumber};
2319     my $search_children_too = $params{search_children_too} || 0;
2320     my $created_by = $params{created_by} || [];
2321     my $ordernumbers = $params{ordernumbers} || [];
2322     my $additional_fields = $params{additional_fields} // [];
2323
2324     my @order_loop;
2325     my $total_qty         = 0;
2326     my $total_qtyreceived = 0;
2327     my $total_price       = 0;
2328
2329     #get variation of isbn
2330     my @isbn_params;
2331     my @isbns;
2332     if ($isbn){
2333         if ( C4::Context->preference("SearchWithISBNVariations") ){
2334             @isbns = C4::Koha::GetVariationsOfISBN( $isbn );
2335             foreach my $isb (@isbns){
2336                 push @isbn_params, '?';
2337             }
2338         }
2339         unless (@isbns){
2340             push @isbns, $isbn;
2341             push @isbn_params, '?';
2342         }
2343     }
2344
2345     my $dbh   = C4::Context->dbh;
2346     my $query ="
2347         SELECT
2348             COALESCE(biblio.title,     deletedbiblio.title)     AS title,
2349             COALESCE(biblio.author,    deletedbiblio.author)    AS author,
2350             COALESCE(biblioitems.isbn, deletedbiblioitems.isbn) AS isbn,
2351             COALESCE(biblioitems.ean,  deletedbiblioitems.ean)  AS ean,
2352             aqorders.basketno,
2353             aqbasket.basketname,
2354             aqbasket.basketgroupid,
2355             aqbasket.authorisedby,
2356             concat( borrowers.firstname,' ',borrowers.surname) AS authorisedbyname,
2357             aqbasketgroups.name as groupname,
2358             aqbooksellers.name,
2359             aqbasket.creationdate,
2360             aqorders.datereceived,
2361             aqorders.quantity,
2362             aqorders.quantityreceived,
2363             aqorders.ecost,
2364             aqorders.ordernumber,
2365             aqorders.invoiceid,
2366             aqinvoices.invoicenumber,
2367             aqbooksellers.id as id,
2368             aqorders.biblionumber,
2369             aqorders.orderstatus,
2370             aqorders.parent_ordernumber,
2371             aqbudgets.budget_name
2372             ";
2373     $query .= ", aqbudgets.budget_id AS budget" if defined $budget;
2374     $query .= "
2375         FROM aqorders
2376         LEFT JOIN aqbasket ON aqorders.basketno=aqbasket.basketno
2377         LEFT JOIN aqbasketgroups ON aqbasket.basketgroupid=aqbasketgroups.id
2378         LEFT JOIN aqbooksellers ON aqbasket.booksellerid=aqbooksellers.id
2379         LEFT JOIN biblioitems ON biblioitems.biblionumber=aqorders.biblionumber
2380         LEFT JOIN biblio ON biblio.biblionumber=aqorders.biblionumber
2381         LEFT JOIN aqbudgets ON aqorders.budget_id=aqbudgets.budget_id
2382         LEFT JOIN aqinvoices ON aqorders.invoiceid = aqinvoices.invoiceid
2383         LEFT JOIN deletedbiblio ON deletedbiblio.biblionumber=aqorders.biblionumber
2384         LEFT JOIN deletedbiblioitems ON deletedbiblioitems.biblionumber=aqorders.biblionumber
2385         LEFT JOIN borrowers ON aqbasket.authorisedby=borrowers.borrowernumber
2386         ";
2387
2388     $query .= " WHERE 1 ";
2389
2390     unless ($get_canceled_order or (defined $orderstatus and $orderstatus eq 'cancelled')) {
2391         $query .= " AND (datecancellationprinted is NULL or datecancellationprinted='0000-00-00') ";
2392     }
2393
2394     my @query_params  = ();
2395
2396     if ( $biblionumber ) {
2397         $query .= " AND biblio.biblionumber = ?";
2398         push @query_params, $biblionumber;
2399     }
2400
2401     if ( $title ) {
2402         $query .= " AND biblio.title LIKE ? ";
2403         $title =~ s/\s+/%/g;
2404         push @query_params, "%$title%";
2405     }
2406
2407     if ( $author ) {
2408         $query .= " AND biblio.author LIKE ? ";
2409         push @query_params, "%$author%";
2410     }
2411
2412     if ( @isbns ) {
2413         $query .= " AND ( biblioitems.isbn LIKE " . join (" OR biblioitems.isbn LIKE ", @isbn_params ) . ")";
2414         foreach my $isb (@isbns){
2415             push @query_params, "%$isb%";
2416         }
2417     }
2418
2419     if ( $ean ) {
2420         $query .= " AND biblioitems.ean = ? ";
2421         push @query_params, "$ean";
2422     }
2423     if ( $name ) {
2424         $query .= " AND aqbooksellers.name LIKE ? ";
2425         push @query_params, "%$name%";
2426     }
2427
2428     if ( $budget ) {
2429         $query .= " AND aqbudgets.budget_id = ? ";
2430         push @query_params, "$budget";
2431     }
2432
2433     if ( $from_placed_on ) {
2434         $query .= " AND creationdate >= ? ";
2435         push @query_params, $from_placed_on;
2436     }
2437
2438     if ( $to_placed_on ) {
2439         $query .= " AND creationdate <= ? ";
2440         push @query_params, $to_placed_on;
2441     }
2442
2443     if ( defined $orderstatus and $orderstatus ne '') {
2444         $query .= " AND aqorders.orderstatus = ? ";
2445         push @query_params, "$orderstatus";
2446     }
2447
2448     if ($basket) {
2449         if ($basket =~ m/^\d+$/) {
2450             $query .= " AND aqorders.basketno = ? ";
2451             push @query_params, $basket;
2452         } else {
2453             $query .= " AND aqbasket.basketname LIKE ? ";
2454             push @query_params, "%$basket%";
2455         }
2456     }
2457
2458     if ($booksellerinvoicenumber) {
2459         $query .= " AND aqinvoices.invoicenumber LIKE ? ";
2460         push @query_params, "%$booksellerinvoicenumber%";
2461     }
2462
2463     if ($basketgroupname) {
2464         $query .= " AND aqbasketgroups.name LIKE ? ";
2465         push @query_params, "%$basketgroupname%";
2466     }
2467
2468     if ($ordernumber) {
2469         $query .= " AND (aqorders.ordernumber = ? ";
2470         push @query_params, $ordernumber;
2471         if ($search_children_too) {
2472             $query .= " OR aqorders.parent_ordernumber = ? ";
2473             push @query_params, $ordernumber;
2474         }
2475         $query .= ") ";
2476     }
2477
2478     if ( @$created_by ) {
2479         $query .= ' AND aqbasket.authorisedby IN ( ' . join( ',', ('?') x @$created_by ) . ')';
2480         push @query_params, @$created_by;
2481     }
2482
2483     if ( @$ordernumbers ) {
2484         $query .= ' AND (aqorders.ordernumber IN ( ' . join (',', ('?') x @$ordernumbers ) . '))';
2485         push @query_params, @$ordernumbers;
2486     }
2487     if ( @$additional_fields ) {
2488         my @baskets = Koha::Acquisition::Baskets->filter_by_additional_fields($additional_fields);
2489
2490         return [] unless @baskets;
2491
2492         # No parameterization because record IDs come directly from DB
2493         $query .= ' AND aqbasket.basketno IN ( ' . join( ',', map { $_->basketno } @baskets ) . ' )';
2494     }
2495
2496     if ( C4::Context->preference("IndependentBranches") ) {
2497         unless ( C4::Context->IsSuperLibrarian() ) {
2498             $query .= " AND (borrowers.branchcode = ? OR borrowers.branchcode ='' ) ";
2499             push @query_params, C4::Context->userenv->{branch};
2500         }
2501     }
2502     $query .= " ORDER BY id";
2503
2504     return $dbh->selectall_arrayref( $query, { Slice => {} }, @query_params );
2505 }
2506
2507 =head2 GetRecentAcqui
2508
2509   $results = GetRecentAcqui($days);
2510
2511 C<$results> is a ref to a table which contains hashref
2512
2513 =cut
2514
2515 sub GetRecentAcqui {
2516     my $limit  = shift;
2517     my $dbh    = C4::Context->dbh;
2518     my $query = "
2519         SELECT *
2520         FROM   biblio
2521         ORDER BY timestamp DESC
2522         LIMIT  0,".$limit;
2523
2524     my $sth = $dbh->prepare($query);
2525     $sth->execute;
2526     my $results = $sth->fetchall_arrayref({});
2527     return $results;
2528 }
2529
2530 #------------------------------------------------------------#
2531
2532 =head3 AddClaim
2533
2534   &AddClaim($ordernumber);
2535
2536 Add a claim for an order
2537
2538 =cut
2539
2540 sub AddClaim {
2541     my ($ordernumber) = @_;
2542     my $dbh          = C4::Context->dbh;
2543     my $query        = "
2544         UPDATE aqorders SET
2545             claims_count = claims_count + 1,
2546             claimed_date = CURDATE()
2547         WHERE ordernumber = ?
2548         ";
2549     my $sth = $dbh->prepare($query);
2550     $sth->execute($ordernumber);
2551 }
2552
2553 =head3 GetInvoices
2554
2555     my @invoices = GetInvoices(
2556         invoicenumber => $invoicenumber,
2557         supplierid => $supplierid,
2558         suppliername => $suppliername,
2559         shipmentdatefrom => $shipmentdatefrom, # ISO format
2560         shipmentdateto => $shipmentdateto, # ISO format
2561         billingdatefrom => $billingdatefrom, # ISO format
2562         billingdateto => $billingdateto, # ISO format
2563         isbneanissn => $isbn_or_ean_or_issn,
2564         title => $title,
2565         author => $author,
2566         publisher => $publisher,
2567         publicationyear => $publicationyear,
2568         branchcode => $branchcode,
2569         order_by => $order_by
2570     );
2571
2572 Return a list of invoices that match all given criteria.
2573
2574 $order_by is "column_name (asc|desc)", where column_name is any of
2575 'invoicenumber', 'booksellerid', 'shipmentdate', 'billingdate', 'closedate',
2576 'shipmentcost', 'shipmentcost_budgetid'.
2577
2578 asc is the default if omitted
2579
2580 =cut
2581
2582 sub GetInvoices {
2583     my %args = @_;
2584
2585     my @columns = qw(invoicenumber booksellerid shipmentdate billingdate
2586         closedate shipmentcost shipmentcost_budgetid);
2587
2588     my $dbh = C4::Context->dbh;
2589     my $query = qq{
2590         SELECT aqinvoices.invoiceid, aqinvoices.invoicenumber, aqinvoices.booksellerid, aqinvoices.shipmentdate, aqinvoices.billingdate, aqinvoices.closedate, aqinvoices.shipmentcost, aqinvoices.shipmentcost_budgetid, aqinvoices.message_id,
2591             aqbooksellers.name AS suppliername,
2592           COUNT(
2593             DISTINCT IF(
2594               aqorders.datereceived IS NOT NULL,
2595               aqorders.biblionumber,
2596               NULL
2597             )
2598           ) AS receivedbiblios,
2599           COUNT(
2600              DISTINCT IF(
2601               aqorders.subscriptionid IS NOT NULL,
2602               aqorders.subscriptionid,
2603               NULL
2604             )
2605           ) AS is_linked_to_subscriptions,
2606           SUM(aqorders.quantityreceived) AS receiveditems
2607         FROM aqinvoices
2608           LEFT JOIN aqbooksellers ON aqbooksellers.id = aqinvoices.booksellerid
2609           LEFT JOIN aqorders ON aqorders.invoiceid = aqinvoices.invoiceid
2610           LEFT JOIN aqbasket ON aqbasket.basketno=aqorders.basketno
2611           LEFT JOIN borrowers ON aqbasket.authorisedby=borrowers.borrowernumber
2612           LEFT JOIN biblio ON aqorders.biblionumber = biblio.biblionumber
2613           LEFT JOIN biblioitems ON biblio.biblionumber = biblioitems.biblionumber
2614           LEFT JOIN subscription ON biblio.biblionumber = subscription.biblionumber
2615     };
2616
2617     my @bind_args;
2618     my @bind_strs;
2619     if($args{supplierid}) {
2620         push @bind_strs, " aqinvoices.booksellerid = ? ";
2621         push @bind_args, $args{supplierid};
2622     }
2623     if($args{invoicenumber}) {
2624         push @bind_strs, " aqinvoices.invoicenumber LIKE ? ";
2625         push @bind_args, "%$args{invoicenumber}%";
2626     }
2627     if($args{suppliername}) {
2628         push @bind_strs, " aqbooksellers.name LIKE ? ";
2629         push @bind_args, "%$args{suppliername}%";
2630     }
2631     if($args{shipmentdatefrom}) {
2632         push @bind_strs, " aqinvoices.shipmentdate >= ? ";
2633         push @bind_args, $args{shipmentdatefrom};
2634     }
2635     if($args{shipmentdateto}) {
2636         push @bind_strs, " aqinvoices.shipmentdate <= ? ";
2637         push @bind_args, $args{shipmentdateto};
2638     }
2639     if($args{billingdatefrom}) {
2640         push @bind_strs, " aqinvoices.billingdate >= ? ";
2641         push @bind_args, $args{billingdatefrom};
2642     }
2643     if($args{billingdateto}) {
2644         push @bind_strs, " aqinvoices.billingdate <= ? ";
2645         push @bind_args, $args{billingdateto};
2646     }
2647     if($args{isbneanissn}) {
2648         push @bind_strs, " (biblioitems.isbn LIKE CONCAT('%', ?, '%') OR biblioitems.ean LIKE CONCAT('%', ?, '%') OR biblioitems.issn LIKE CONCAT('%', ?, '%') ) ";
2649         push @bind_args, $args{isbneanissn}, $args{isbneanissn}, $args{isbneanissn};
2650     }
2651     if($args{title}) {
2652         push @bind_strs, " biblio.title LIKE CONCAT('%', ?, '%') ";
2653         push @bind_args, $args{title};
2654     }
2655     if($args{author}) {
2656         push @bind_strs, " biblio.author LIKE CONCAT('%', ?, '%') ";
2657         push @bind_args, $args{author};
2658     }
2659     if($args{publisher}) {
2660         push @bind_strs, " biblioitems.publishercode LIKE CONCAT('%', ?, '%') ";
2661         push @bind_args, $args{publisher};
2662     }
2663     if($args{publicationyear}) {
2664         push @bind_strs, " ((biblioitems.publicationyear LIKE CONCAT('%', ?, '%')) OR (biblio.copyrightdate LIKE CONCAT('%', ?, '%'))) ";
2665         push @bind_args, $args{publicationyear}, $args{publicationyear};
2666     }
2667     if($args{branchcode}) {
2668         push @bind_strs, " borrowers.branchcode = ? ";
2669         push @bind_args, $args{branchcode};
2670     }
2671     if($args{message_id}) {
2672         push @bind_strs, " aqinvoices.message_id = ? ";
2673         push @bind_args, $args{message_id};
2674     }
2675
2676     $query .= " WHERE " . join(" AND ", @bind_strs) if @bind_strs;
2677     $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";
2678
2679     if($args{order_by}) {
2680         my ($column, $direction) = split / /, $args{order_by};
2681         if(grep /^$column$/, @columns) {
2682             $direction ||= 'ASC';
2683             $query .= " ORDER BY $column $direction";
2684         }
2685     }
2686
2687     my $sth = $dbh->prepare($query);
2688     $sth->execute(@bind_args);
2689
2690     my $results = $sth->fetchall_arrayref({});
2691     return @$results;
2692 }
2693
2694 =head3 GetInvoice
2695
2696     my $invoice = GetInvoice($invoiceid);
2697
2698 Get informations about invoice with given $invoiceid
2699
2700 Return a hash filled with aqinvoices.* fields
2701
2702 =cut
2703
2704 sub GetInvoice {
2705     my ($invoiceid) = @_;
2706     my $invoice;
2707
2708     return unless $invoiceid;
2709
2710     my $dbh = C4::Context->dbh;
2711     my $query = qq{
2712         SELECT *
2713         FROM aqinvoices
2714         WHERE invoiceid = ?
2715     };
2716     my $sth = $dbh->prepare($query);
2717     $sth->execute($invoiceid);
2718
2719     $invoice = $sth->fetchrow_hashref;
2720     return $invoice;
2721 }
2722
2723 =head3 GetInvoiceDetails
2724
2725     my $invoice = GetInvoiceDetails($invoiceid)
2726
2727 Return informations about an invoice + the list of related order lines
2728
2729 Orders informations are in $invoice->{orders} (array ref)
2730
2731 =cut
2732
2733 sub GetInvoiceDetails {
2734     my ($invoiceid) = @_;
2735
2736     if ( !defined $invoiceid ) {
2737         carp 'GetInvoiceDetails called without an invoiceid';
2738         return;
2739     }
2740
2741     my $dbh = C4::Context->dbh;
2742     my $query = q{
2743         SELECT aqinvoices.*, aqbooksellers.name AS suppliername
2744         FROM aqinvoices
2745           LEFT JOIN aqbooksellers ON aqinvoices.booksellerid = aqbooksellers.id
2746         WHERE invoiceid = ?
2747     };
2748     my $sth = $dbh->prepare($query);
2749     $sth->execute($invoiceid);
2750
2751     my $invoice = $sth->fetchrow_hashref;
2752
2753     $query = q{
2754         SELECT aqorders.*,
2755                 biblio.*,
2756                 biblio.copyrightdate,
2757                 biblioitems.isbn,
2758                 biblioitems.publishercode,
2759                 biblioitems.publicationyear,
2760                 aqbasket.basketname,
2761                 aqbasketgroups.id AS basketgroupid,
2762                 aqbasketgroups.name AS basketgroupname
2763         FROM aqorders
2764           LEFT JOIN aqbasket ON aqorders.basketno = aqbasket.basketno
2765           LEFT JOIN aqbasketgroups ON aqbasket.basketgroupid = aqbasketgroups.id
2766           LEFT JOIN biblio ON aqorders.biblionumber = biblio.biblionumber
2767           LEFT JOIN biblioitems ON aqorders.biblionumber = biblioitems.biblionumber
2768         WHERE invoiceid = ?
2769     };
2770     $sth = $dbh->prepare($query);
2771     $sth->execute($invoiceid);
2772     $invoice->{orders} = $sth->fetchall_arrayref({});
2773     $invoice->{orders} ||= []; # force an empty arrayref if fetchall_arrayref fails
2774
2775     return $invoice;
2776 }
2777
2778 =head3 AddInvoice
2779
2780     my $invoiceid = AddInvoice(
2781         invoicenumber => $invoicenumber,
2782         booksellerid => $booksellerid,
2783         shipmentdate => $shipmentdate,
2784         billingdate => $billingdate,
2785         closedate => $closedate,
2786         shipmentcost => $shipmentcost,
2787         shipmentcost_budgetid => $shipmentcost_budgetid
2788     );
2789
2790 Create a new invoice and return its id or undef if it fails.
2791
2792 =cut
2793
2794 sub AddInvoice {
2795     my %invoice = @_;
2796
2797     return unless(%invoice and $invoice{invoicenumber});
2798
2799     my @columns = qw(invoicenumber booksellerid shipmentdate billingdate
2800         closedate shipmentcost shipmentcost_budgetid message_id);
2801
2802     my @set_strs;
2803     my @set_args;
2804     foreach my $key (keys %invoice) {
2805         if(0 < grep(/^$key$/, @columns)) {
2806             push @set_strs, "$key = ?";
2807             push @set_args, ($invoice{$key} || undef);
2808         }
2809     }
2810
2811     my $rv;
2812     if(@set_args > 0) {
2813         my $dbh = C4::Context->dbh;
2814         my $query = "INSERT INTO aqinvoices SET ";
2815         $query .= join (",", @set_strs);
2816         my $sth = $dbh->prepare($query);
2817         $rv = $sth->execute(@set_args);
2818         if($rv) {
2819             $rv = $dbh->last_insert_id(undef, undef, 'aqinvoices', undef);
2820         }
2821     }
2822     return $rv;
2823 }
2824
2825 =head3 ModInvoice
2826
2827     ModInvoice(
2828         invoiceid => $invoiceid,    # Mandatory
2829         invoicenumber => $invoicenumber,
2830         booksellerid => $booksellerid,
2831         shipmentdate => $shipmentdate,
2832         billingdate => $billingdate,
2833         closedate => $closedate,
2834         shipmentcost => $shipmentcost,
2835         shipmentcost_budgetid => $shipmentcost_budgetid
2836     );
2837
2838 Modify an invoice, invoiceid is mandatory.
2839
2840 Return undef if it fails.
2841
2842 =cut
2843
2844 sub ModInvoice {
2845     my %invoice = @_;
2846
2847     return unless(%invoice and $invoice{invoiceid});
2848
2849     my @columns = qw(invoicenumber booksellerid shipmentdate billingdate
2850         closedate shipmentcost shipmentcost_budgetid);
2851
2852     my @set_strs;
2853     my @set_args;
2854     foreach my $key (keys %invoice) {
2855         if(0 < grep(/^$key$/, @columns)) {
2856             push @set_strs, "$key = ?";
2857             push @set_args, ($invoice{$key} || undef);
2858         }
2859     }
2860
2861     my $dbh = C4::Context->dbh;
2862     my $query = "UPDATE aqinvoices SET ";
2863     $query .= join(",", @set_strs);
2864     $query .= " WHERE invoiceid = ?";
2865
2866     my $sth = $dbh->prepare($query);
2867     $sth->execute(@set_args, $invoice{invoiceid});
2868 }
2869
2870 =head3 CloseInvoice
2871
2872     CloseInvoice($invoiceid);
2873
2874 Close an invoice.
2875
2876 Equivalent to ModInvoice(invoiceid => $invoiceid, closedate => undef);
2877
2878 =cut
2879
2880 sub CloseInvoice {
2881     my ($invoiceid) = @_;
2882
2883     return unless $invoiceid;
2884
2885     my $dbh = C4::Context->dbh;
2886     my $query = qq{
2887         UPDATE aqinvoices
2888         SET closedate = CAST(NOW() AS DATE)
2889         WHERE invoiceid = ?
2890     };
2891     my $sth = $dbh->prepare($query);
2892     $sth->execute($invoiceid);
2893 }
2894
2895 =head3 ReopenInvoice
2896
2897     ReopenInvoice($invoiceid);
2898
2899 Reopen an invoice
2900
2901 Equivalent to ModInvoice(invoiceid => $invoiceid, closedate => output_pref({ dt=>dt_from_string, dateonly=>1, otputpref=>'iso' }))
2902
2903 =cut
2904
2905 sub ReopenInvoice {
2906     my ($invoiceid) = @_;
2907
2908     return unless $invoiceid;
2909
2910     my $dbh = C4::Context->dbh;
2911     my $query = qq{
2912         UPDATE aqinvoices
2913         SET closedate = NULL
2914         WHERE invoiceid = ?
2915     };
2916     my $sth = $dbh->prepare($query);
2917     $sth->execute($invoiceid);
2918 }
2919
2920 =head3 DelInvoice
2921
2922     DelInvoice($invoiceid);
2923
2924 Delete an invoice if there are no items attached to it.
2925
2926 =cut
2927
2928 sub DelInvoice {
2929     my ($invoiceid) = @_;
2930
2931     return unless $invoiceid;
2932
2933     my $dbh   = C4::Context->dbh;
2934     my $query = qq{
2935         SELECT COUNT(*)
2936         FROM aqorders
2937         WHERE invoiceid = ?
2938     };
2939     my $sth = $dbh->prepare($query);
2940     $sth->execute($invoiceid);
2941     my $res = $sth->fetchrow_arrayref;
2942     if ( $res && $res->[0] == 0 ) {
2943         $query = qq{
2944             DELETE FROM aqinvoices
2945             WHERE invoiceid = ?
2946         };
2947         my $sth = $dbh->prepare($query);
2948         return ( $sth->execute($invoiceid) > 0 );
2949     }
2950     return;
2951 }
2952
2953 =head3 MergeInvoices
2954
2955     MergeInvoices($invoiceid, \@sourceids);
2956
2957 Merge the invoices identified by the IDs in \@sourceids into
2958 the invoice identified by $invoiceid.
2959
2960 =cut
2961
2962 sub MergeInvoices {
2963     my ($invoiceid, $sourceids) = @_;
2964
2965     return unless $invoiceid;
2966     foreach my $sourceid (@$sourceids) {
2967         next if $sourceid == $invoiceid;
2968         my $source = GetInvoiceDetails($sourceid);
2969         foreach my $order (@{$source->{'orders'}}) {
2970             $order->{'invoiceid'} = $invoiceid;
2971             ModOrder($order);
2972         }
2973         DelInvoice($source->{'invoiceid'});
2974     }
2975     return;
2976 }
2977
2978 =head3 GetBiblioCountByBasketno
2979
2980 $biblio_count = &GetBiblioCountByBasketno($basketno);
2981
2982 Looks up the biblio's count that has basketno value $basketno
2983
2984 Returns a quantity
2985
2986 =cut
2987
2988 sub GetBiblioCountByBasketno {
2989     my ($basketno) = @_;
2990     my $dbh          = C4::Context->dbh;
2991     my $query        = "
2992         SELECT COUNT( DISTINCT( biblionumber ) )
2993         FROM   aqorders
2994         WHERE  basketno = ?
2995             AND (datecancellationprinted IS NULL OR datecancellationprinted='0000-00-00')
2996         ";
2997
2998     my $sth = $dbh->prepare($query);
2999     $sth->execute($basketno);
3000     return $sth->fetchrow;
3001 }
3002
3003 =head3 populate_order_with_prices
3004
3005 $order = populate_order_with_prices({
3006     order        => $order #a hashref with the order values
3007     booksellerid => $booksellerid #FIXME - should obtain from order basket
3008     receiving    => 1 # boolean representing order stage, should pass only this or ordering
3009     ordering     => 1 # boolean representing order stage
3010 });
3011
3012
3013 Sets calculated values for an order - all values are stored with pull precision regardless of rounding preference except fot
3014 tax value which is calculated on rounded values if requested
3015
3016 For ordering the values set are:
3017     rrp_tax_included
3018     rrp_tax_excluded
3019     ecost_tax_included
3020     ecost_tax_excluded
3021     tax_value_on_ordering
3022 For receiving the value set are:
3023     unitprice_tax_included
3024     unitprice_tax_excluded
3025     tax_value_on_receiving
3026
3027 Note: When receiving if the rounded value of the unitprice matches the rounded value of the ecost then then ecost (full precision) is used.
3028
3029 Returns a hashref of the order
3030
3031 FIXME: Move this to Koha::Acquisition::Order.pm
3032
3033 =cut
3034
3035 sub populate_order_with_prices {
3036     my ($params) = @_;
3037
3038     my $order        = $params->{order};
3039     my $booksellerid = $params->{booksellerid};
3040     return unless $booksellerid;
3041
3042     my $bookseller = Koha::Acquisition::Booksellers->find( $booksellerid );
3043
3044     my $receiving = $params->{receiving};
3045     my $ordering  = $params->{ordering};
3046     my $discount  = $order->{discount};
3047     $discount /= 100 if $discount > 1;
3048
3049     if ($ordering) {
3050         $order->{tax_rate_on_ordering} //= $order->{tax_rate};
3051         if ( $bookseller->listincgst ) {
3052             # The user entered the rrp tax included
3053             $order->{rrp_tax_included} = $order->{rrp};
3054
3055             # rrp tax excluded = rrp tax included / ( 1 + tax rate )
3056             $order->{rrp_tax_excluded} = $order->{rrp_tax_included} / ( 1 + $order->{tax_rate_on_ordering} );
3057
3058             # ecost tax included = rrp tax included  ( 1 - discount )
3059             $order->{ecost_tax_included} = $order->{rrp_tax_included} * ( 1 - $discount );
3060
3061             # ecost tax excluded = rrp tax excluded * ( 1 - discount )
3062             $order->{ecost_tax_excluded} = $order->{rrp_tax_excluded} * ( 1 - $discount );
3063
3064             # tax value = quantity * ecost tax excluded * tax rate
3065             $order->{tax_value_on_ordering} = ( get_rounded_price($order->{ecost_tax_included}) - get_rounded_price($order->{ecost_tax_excluded}) ) * $order->{quantity};
3066
3067         }
3068         else {
3069             # The user entered the rrp tax excluded
3070             $order->{rrp_tax_excluded} = $order->{rrp};
3071
3072             # rrp tax included = rrp tax excluded * ( 1 - tax rate )
3073             $order->{rrp_tax_included} = $order->{rrp_tax_excluded} * ( 1 + $order->{tax_rate_on_ordering} );
3074
3075             # ecost tax excluded = rrp tax excluded * ( 1 - discount )
3076             $order->{ecost_tax_excluded} = $order->{rrp_tax_excluded} * ( 1 - $discount );
3077
3078             # ecost tax included = rrp tax excluded * ( 1 + tax rate ) * ( 1 - discount ) = ecost tax excluded * ( 1 + tax rate )
3079             $order->{ecost_tax_included} = $order->{ecost_tax_excluded} * ( 1 + $order->{tax_rate_on_ordering} );
3080
3081             # tax value = quantity * ecost tax included * tax rate
3082             $order->{tax_value_on_ordering} = $order->{quantity} * get_rounded_price($order->{ecost_tax_excluded}) * $order->{tax_rate_on_ordering};
3083         }
3084     }
3085
3086     if ($receiving) {
3087         $order->{tax_rate_on_receiving} //= $order->{tax_rate};
3088         if ( $bookseller->invoiceincgst ) {
3089             # Trick for unitprice. If the unit price rounded value is the same as the ecost rounded value
3090             # we need to keep the exact ecost value
3091             if ( Koha::Number::Price->new( $order->{unitprice} )->round == Koha::Number::Price->new( $order->{ecost_tax_included} )->round ) {
3092                 $order->{unitprice} = $order->{ecost_tax_included};
3093             }
3094
3095             # The user entered the unit price tax included
3096             $order->{unitprice_tax_included} = $order->{unitprice};
3097
3098             # unit price tax excluded = unit price tax included / ( 1 + tax rate )
3099             $order->{unitprice_tax_excluded} = $order->{unitprice_tax_included} / ( 1 + $order->{tax_rate_on_receiving} );
3100         }
3101         else {
3102             # Trick for unitprice. If the unit price rounded value is the same as the ecost rounded value
3103             # we need to keep the exact ecost value
3104             if ( Koha::Number::Price->new( $order->{unitprice} )->round == Koha::Number::Price->new( $order->{ecost_tax_excluded} )->round ) {
3105                 $order->{unitprice} = $order->{ecost_tax_excluded};
3106             }
3107
3108             # The user entered the unit price tax excluded
3109             $order->{unitprice_tax_excluded} = $order->{unitprice};
3110
3111
3112             # unit price tax included = unit price tax included * ( 1 + tax rate )
3113             $order->{unitprice_tax_included} = $order->{unitprice_tax_excluded} * ( 1 + $order->{tax_rate_on_receiving} );
3114         }
3115
3116         # tax value = quantity * unit price tax excluded * tax rate
3117         $order->{tax_value_on_receiving} = $order->{quantity} * get_rounded_price($order->{unitprice_tax_excluded}) * $order->{tax_rate_on_receiving};
3118     }
3119
3120     return $order;
3121 }
3122
3123 =head3 GetOrderUsers
3124
3125     $order_users_ids = &GetOrderUsers($ordernumber);
3126
3127 Returns a list of all borrowernumbers that are in order users list
3128
3129 =cut
3130
3131 sub GetOrderUsers {
3132     my ($ordernumber) = @_;
3133
3134     return unless $ordernumber;
3135
3136     my $query = q|
3137         SELECT borrowernumber
3138         FROM aqorder_users
3139         WHERE ordernumber = ?
3140     |;
3141     my $dbh = C4::Context->dbh;
3142     my $sth = $dbh->prepare($query);
3143     $sth->execute($ordernumber);
3144     my $results = $sth->fetchall_arrayref( {} );
3145
3146     my @borrowernumbers;
3147     foreach (@$results) {
3148         push @borrowernumbers, $_->{'borrowernumber'};
3149     }
3150
3151     return @borrowernumbers;
3152 }
3153
3154 =head3 ModOrderUsers
3155
3156     my @order_users_ids = (1, 2, 3);
3157     &ModOrderUsers($ordernumber, @basketusers_ids);
3158
3159 Delete all users from order users list, and add users in C<@order_users_ids>
3160 to this users list.
3161
3162 =cut
3163
3164 sub ModOrderUsers {
3165     my ( $ordernumber, @order_users_ids ) = @_;
3166
3167     return unless $ordernumber;
3168
3169     my $dbh   = C4::Context->dbh;
3170     my $query = q|
3171         DELETE FROM aqorder_users
3172         WHERE ordernumber = ?
3173     |;
3174     my $sth = $dbh->prepare($query);
3175     $sth->execute($ordernumber);
3176
3177     $query = q|
3178         INSERT INTO aqorder_users (ordernumber, borrowernumber)
3179         VALUES (?, ?)
3180     |;
3181     $sth = $dbh->prepare($query);
3182     foreach my $order_user_id (@order_users_ids) {
3183         $sth->execute( $ordernumber, $order_user_id );
3184     }
3185 }
3186
3187 sub NotifyOrderUsers {
3188     my ($ordernumber) = @_;
3189
3190     my @borrowernumbers = GetOrderUsers($ordernumber);
3191     return unless @borrowernumbers;
3192
3193     my $order = GetOrder( $ordernumber );
3194     for my $borrowernumber (@borrowernumbers) {
3195         my $patron = Koha::Patrons->find( $borrowernumber );
3196         my $library = $patron->library->unblessed;
3197         my $biblio = Koha::Biblios->find( $order->{biblionumber} )->unblessed;
3198         my $letter = C4::Letters::GetPreparedLetter(
3199             module      => 'acquisition',
3200             letter_code => 'ACQ_NOTIF_ON_RECEIV',
3201             branchcode  => $library->{branchcode},
3202             lang        => $patron->lang,
3203             tables      => {
3204                 'branches'    => $library,
3205                 'borrowers'   => $patron->unblessed,
3206                 'biblio'      => $biblio,
3207                 'aqorders'    => $order,
3208             },
3209         );
3210         if ( $letter ) {
3211             C4::Letters::EnqueueLetter(
3212                 {
3213                     letter         => $letter,
3214                     borrowernumber => $borrowernumber,
3215                     LibraryName    => C4::Context->preference("LibraryName"),
3216                     message_transport_type => 'email',
3217                 }
3218             ) or warn "can't enqueue letter $letter";
3219         }
3220     }
3221 }
3222
3223 =head3 FillWithDefaultValues
3224
3225 FillWithDefaultValues( $marc_record );
3226
3227 This will update the record with default value defined in the ACQ framework.
3228 For all existing fields, if a default value exists and there are no subfield, it will be created.
3229 If the field does not exist, it will be created too.
3230
3231 =cut
3232
3233 sub FillWithDefaultValues {
3234     my ($record) = @_;
3235     my $tagslib = C4::Biblio::GetMarcStructure( 1, 'ACQ', { unsafe => 1 } );
3236     if ($tagslib) {
3237         my ($itemfield) =
3238           C4::Biblio::GetMarcFromKohaField( 'items.itemnumber', '' );
3239         for my $tag ( sort keys %$tagslib ) {
3240             next unless $tag;
3241             next if $tag == $itemfield;
3242             for my $subfield ( sort keys %{ $tagslib->{$tag} } ) {
3243                 next if IsMarcStructureInternal($tagslib->{$tag}{$subfield});
3244                 my $defaultvalue = $tagslib->{$tag}{$subfield}{defaultvalue};
3245                 if ( defined $defaultvalue and $defaultvalue ne '' ) {
3246                     my @fields = $record->field($tag);
3247                     if (@fields) {
3248                         for my $field (@fields) {
3249                             unless ( defined $field->subfield($subfield) ) {
3250                                 $field->add_subfields(
3251                                     $subfield => $defaultvalue );
3252                             }
3253                         }
3254                     }
3255                     else {
3256                         $record->insert_fields_ordered(
3257                             MARC::Field->new(
3258                                 $tag, '', '', $subfield => $defaultvalue
3259                             )
3260                         );
3261                     }
3262                 }
3263             }
3264         }
3265     }
3266 }
3267
3268 1;
3269 __END__
3270
3271 =head1 AUTHOR
3272
3273 Koha Development Team <http://koha-community.org/>
3274
3275 =cut