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