C4/Acquisition.pm

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