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