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     my $error;
1896     my $dbh = C4::Context->dbh;
1897     my $query = "
1898         UPDATE aqorders
1899         SET    datecancellationprinted=now(), orderstatus='cancelled'
1900     ";
1901     if($reason) {
1902         $query .= ", cancellationreason = ? ";
1903     }
1904     $query .= "
1905         WHERE biblionumber=? AND ordernumber=?
1906     ";
1907     my $sth = $dbh->prepare($query);
1908     if($reason) {
1909         $sth->execute($reason, $bibnum, $ordernumber);
1910     } else {
1911         $sth->execute( $bibnum, $ordernumber );
1912     }
1913     $sth->finish;
1914
1915     my $order = Koha::Acquisition::Orders->find($ordernumber);
1916     my $items = $order->items;
1917     while ( my $item = $items->next ) { # Should be moved to Koha::Acquisition::Order->delete
1918         my $delcheck = C4::Items::DelItemCheck( $bibnum, $item->itemnumber );
1919
1920         if($delcheck != 1) {
1921             $error->{'delitem'} = 1;
1922         }
1923     }
1924
1925     if($delete_biblio) {
1926         # We get the number of remaining items
1927         my $biblio = Koha::Biblios->find( $bibnum );
1928         my $itemcount = $biblio->items->count;
1929
1930         # If there are no items left,
1931         if ( $itemcount == 0 ) {
1932             # We delete the record
1933             my $delcheck = DelBiblio($bibnum);
1934
1935             if($delcheck) {
1936                 $error->{'delbiblio'} = 1;
1937             }
1938         }
1939     }
1940
1941     return $error;
1942 }
1943
1944 =head3 TransferOrder
1945
1946     my $newordernumber = TransferOrder($ordernumber, $basketno);
1947
1948 Transfer an order line to a basket.
1949 Mark $ordernumber as cancelled with an internal note 'Cancelled and transferred
1950 to BOOKSELLER on DATE' and create new order with internal note
1951 'Transferred from BOOKSELLER on DATE'.
1952 Move all attached items to the new order.
1953 Received orders cannot be transferred.
1954 Return the ordernumber of created order.
1955
1956 =cut
1957
1958 sub TransferOrder {
1959     my ($ordernumber, $basketno) = @_;
1960
1961     return unless ($ordernumber and $basketno);
1962
1963     my $order = Koha::Acquisition::Orders->find( $ordernumber ) or return;
1964     return if $order->datereceived;
1965
1966     $order = $order->unblessed;
1967
1968     my $basket = GetBasket($basketno);
1969     return unless $basket;
1970
1971     my $dbh = C4::Context->dbh;
1972     my ($query, $sth, $rv);
1973
1974     $query = q{
1975         UPDATE aqorders
1976         SET datecancellationprinted = CAST(NOW() AS date), orderstatus = ?
1977         WHERE ordernumber = ?
1978     };
1979     $sth = $dbh->prepare($query);
1980     $rv = $sth->execute('cancelled', $ordernumber);
1981
1982     delete $order->{'ordernumber'};
1983     delete $order->{parent_ordernumber};
1984     $order->{'basketno'} = $basketno;
1985
1986     my $newordernumber = Koha::Acquisition::Order->new($order)->store->ordernumber;
1987
1988     $query = q{
1989         UPDATE aqorders_items
1990         SET ordernumber = ?
1991         WHERE ordernumber = ?
1992     };
1993     $sth = $dbh->prepare($query);
1994     $sth->execute($newordernumber, $ordernumber);
1995
1996     $query = q{
1997         INSERT INTO aqorders_transfers (ordernumber_from, ordernumber_to)
1998         VALUES (?, ?)
1999     };
2000     $sth = $dbh->prepare($query);
2001     $sth->execute($ordernumber, $newordernumber);
2002
2003     return $newordernumber;
2004 }
2005
2006 =head3 get_rounding_sql
2007
2008     $rounding_sql = get_rounding_sql($column_name);
2009
2010 returns the correct SQL routine based on OrderPriceRounding system preference.
2011
2012 =cut
2013
2014 sub get_rounding_sql {
2015     my ( $round_string ) = @_;
2016     my $rounding_pref = C4::Context->preference('OrderPriceRounding') // q{};
2017     if ( $rounding_pref eq "nearest_cent"  ) {
2018         return "CAST($round_string*100 AS SIGNED)/100";
2019     }
2020     return $round_string;
2021 }
2022
2023 =head3 get_rounded_price
2024
2025     $rounded_price = get_rounded_price( $price );
2026
2027 returns a price rounded as specified in OrderPriceRounding system preference.
2028
2029 =cut
2030
2031 sub get_rounded_price {
2032     my ( $price ) =  @_;
2033     my $rounding_pref = C4::Context->preference('OrderPriceRounding') // q{};
2034     if( $rounding_pref eq 'nearest_cent' ) {
2035         return Koha::Number::Price->new( $price )->round();
2036     }
2037     return $price;
2038 }
2039
2040
2041 =head2 FUNCTIONS ABOUT PARCELS
2042
2043 =head3 GetParcels
2044
2045   $results = &GetParcels($bookseller, $order, $code, $datefrom, $dateto);
2046
2047 get a lists of parcels.
2048
2049 * Input arg :
2050
2051 =over
2052
2053 =item $bookseller
2054 is the bookseller this function has to get parcels.
2055
2056 =item $order
2057 To know on what criteria the results list has to be ordered.
2058
2059 =item $code
2060 is the booksellerinvoicenumber.
2061
2062 =item $datefrom & $dateto
2063 to know on what date this function has to filter its search.
2064
2065 =back
2066
2067 * return:
2068 a pointer on a hash list containing parcel informations as such :
2069
2070 =over
2071
2072 =item Creation date
2073
2074 =item Last operation
2075
2076 =item Number of biblio
2077
2078 =item Number of items
2079
2080 =back
2081
2082 =cut
2083
2084 sub GetParcels {
2085     my ($bookseller,$order, $code, $datefrom, $dateto) = @_;
2086     my $dbh    = C4::Context->dbh;
2087     my @query_params = ();
2088     my $strsth ="
2089         SELECT  aqinvoices.invoicenumber,
2090                 datereceived,purchaseordernumber,
2091                 count(DISTINCT biblionumber) AS biblio,
2092                 sum(quantity) AS itemsexpected,
2093                 sum(quantityreceived) AS itemsreceived
2094         FROM   aqorders LEFT JOIN aqbasket ON aqbasket.basketno = aqorders.basketno
2095         LEFT JOIN aqinvoices ON aqorders.invoiceid = aqinvoices.invoiceid
2096         WHERE aqbasket.booksellerid = ? and datereceived IS NOT NULL
2097     ";
2098     push @query_params, $bookseller;
2099
2100     if ( defined $code ) {
2101         $strsth .= ' and aqinvoices.invoicenumber like ? ';
2102         # add a % to the end of the code to allow stemming.
2103         push @query_params, "$code%";
2104     }
2105
2106     if ( defined $datefrom ) {
2107         $strsth .= ' and datereceived >= ? ';
2108         push @query_params, $datefrom;
2109     }
2110
2111     if ( defined $dateto ) {
2112         $strsth .=  'and datereceived <= ? ';
2113         push @query_params, $dateto;
2114     }
2115
2116     $strsth .= "group by aqinvoices.invoicenumber,datereceived ";
2117
2118     # can't use a placeholder to place this column name.
2119     # but, we could probably be checking to make sure it is a column that will be fetched.
2120     $strsth .= "order by $order " if ($order);
2121
2122     my $sth = $dbh->prepare($strsth);
2123
2124     $sth->execute( @query_params );
2125     my $results = $sth->fetchall_arrayref({});
2126     return @{$results};
2127 }
2128
2129 #------------------------------------------------------------#
2130
2131 =head3 GetLateOrders
2132
2133   @results = &GetLateOrders;
2134
2135 Searches for bookseller with late orders.
2136
2137 return:
2138 the table of supplier with late issues. This table is full of hashref.
2139
2140 =cut
2141
2142 sub GetLateOrders {
2143     my $delay      = shift;
2144     my $supplierid = shift;
2145     my $branch     = shift;
2146     my $estimateddeliverydatefrom = shift;
2147     my $estimateddeliverydateto = shift;
2148
2149     my $dbh = C4::Context->dbh;
2150
2151     #BEWARE, order of parenthesis and LEFT JOIN is important for speed
2152     my $dbdriver = C4::Context->config("db_scheme") || "mysql";
2153
2154     my @query_params = ();
2155     my $select = "
2156     SELECT aqbasket.basketno,
2157         aqorders.ordernumber,
2158         DATE(aqbasket.closedate)  AS orderdate,
2159         aqbasket.basketname       AS basketname,
2160         aqbasket.basketgroupid    AS basketgroupid,
2161         aqbasketgroups.name       AS basketgroupname,
2162         aqorders.rrp              AS unitpricesupplier,
2163         aqorders.ecost            AS unitpricelib,
2164         aqorders.claims_count     AS claims_count,
2165         aqorders.claimed_date     AS claimed_date,
2166         aqbudgets.budget_name     AS budget,
2167         borrowers.branchcode      AS branch,
2168         aqbooksellers.name        AS supplier,
2169         aqbooksellers.id          AS supplierid,
2170         biblio.author, biblio.title,
2171         biblioitems.publishercode AS publisher,
2172         biblioitems.publicationyear,
2173         ADDDATE(aqbasket.closedate, INTERVAL aqbooksellers.deliverytime DAY) AS estimateddeliverydate,
2174     ";
2175     my $from = "
2176     FROM
2177         aqorders LEFT JOIN biblio     ON biblio.biblionumber         = aqorders.biblionumber
2178         LEFT JOIN biblioitems         ON biblioitems.biblionumber    = biblio.biblionumber
2179         LEFT JOIN aqbudgets           ON aqorders.budget_id          = aqbudgets.budget_id,
2180         aqbasket LEFT JOIN borrowers  ON aqbasket.authorisedby       = borrowers.borrowernumber
2181         LEFT JOIN aqbooksellers       ON aqbasket.booksellerid       = aqbooksellers.id
2182         LEFT JOIN aqbasketgroups      ON aqbasket.basketgroupid      = aqbasketgroups.id
2183         WHERE aqorders.basketno = aqbasket.basketno
2184         AND ( datereceived = ''
2185             OR datereceived IS NULL
2186             OR aqorders.quantityreceived < aqorders.quantity
2187         )
2188         AND aqbasket.closedate IS NOT NULL
2189         AND (aqorders.datecancellationprinted IS NULL OR aqorders.datecancellationprinted='0000-00-00')
2190     ";
2191     if ($dbdriver eq "mysql") {
2192         $select .= "
2193         aqorders.quantity - COALESCE(aqorders.quantityreceived,0)                 AS quantity,
2194         (aqorders.quantity - COALESCE(aqorders.quantityreceived,0)) * aqorders.rrp AS subtotal,
2195         DATEDIFF(CAST(now() AS date),closedate) AS latesince
2196         ";
2197         if ( defined $delay ) {
2198             $from .= " AND (closedate <= DATE_SUB(CAST(now() AS date),INTERVAL ? DAY)) " ;
2199             push @query_params, $delay;
2200         }
2201         $from .= " AND aqorders.quantity - COALESCE(aqorders.quantityreceived,0) <> 0";
2202     } else {
2203         # FIXME: account for IFNULL as above
2204         $select .= "
2205                 aqorders.quantity                AS quantity,
2206                 aqorders.quantity * aqorders.rrp AS subtotal,
2207                 (CAST(now() AS date) - closedate)            AS latesince
2208         ";
2209         if ( defined $delay ) {
2210             $from .= " AND (closedate <= (CAST(now() AS date) -(INTERVAL ? DAY)) ";
2211             push @query_params, $delay;
2212         }
2213         $from .= " AND aqorders.quantity <> 0";
2214     }
2215     if (defined $supplierid) {
2216         $from .= ' AND aqbasket.booksellerid = ? ';
2217         push @query_params, $supplierid;
2218     }
2219     if (defined $branch) {
2220         $from .= ' AND borrowers.branchcode LIKE ? ';
2221         push @query_params, $branch;
2222     }
2223
2224     if ( defined $estimateddeliverydatefrom or defined $estimateddeliverydateto ) {
2225         $from .= ' AND aqbooksellers.deliverytime IS NOT NULL ';
2226     }
2227     if ( defined $estimateddeliverydatefrom ) {
2228         $from .= ' AND ADDDATE(aqbasket.closedate, INTERVAL aqbooksellers.deliverytime DAY) >= ?';
2229         push @query_params, $estimateddeliverydatefrom;
2230     }
2231     if ( defined $estimateddeliverydateto ) {
2232         $from .= ' AND ADDDATE(aqbasket.closedate, INTERVAL aqbooksellers.deliverytime DAY) <= ?';
2233         push @query_params, $estimateddeliverydateto;
2234     }
2235     if ( defined $estimateddeliverydatefrom and not defined $estimateddeliverydateto ) {
2236         $from .= ' AND ADDDATE(aqbasket.closedate, INTERVAL aqbooksellers.deliverytime DAY) <= CAST(now() AS date)';
2237     }
2238     if (C4::Context->preference("IndependentBranches")
2239             && !C4::Context->IsSuperLibrarian() ) {
2240         $from .= ' AND borrowers.branchcode LIKE ? ';
2241         push @query_params, C4::Context->userenv->{branch};
2242     }
2243     $from .= " AND orderstatus <> 'cancelled' ";
2244     my $query = "$select $from \nORDER BY latesince, basketno, borrowers.branchcode, supplier";
2245     $debug and print STDERR "GetLateOrders query: $query\nGetLateOrders args: " . join(" ",@query_params);
2246     my $sth = $dbh->prepare($query);
2247     $sth->execute(@query_params);
2248     my @results;
2249     while (my $data = $sth->fetchrow_hashref) {
2250         push @results, $data;
2251     }
2252     return @results;
2253 }
2254
2255 #------------------------------------------------------------#
2256
2257 =head3 GetHistory
2258
2259   \@order_loop = GetHistory( %params );
2260
2261 Retreives some acquisition history information
2262
2263 params:
2264   title
2265   author
2266   name
2267   isbn
2268   ean
2269   from_placed_on
2270   to_placed_on
2271   basket                  - search both basket name and number
2272   booksellerinvoicenumber
2273   basketgroupname
2274   budget
2275   orderstatus (note that orderstatus '' will retrieve orders
2276                of any status except cancelled)
2277   biblionumber
2278   get_canceled_order (if set to a true value, cancelled orders will
2279                       be included)
2280
2281 returns:
2282     $order_loop is a list of hashrefs that each look like this:
2283             {
2284                 'author'           => 'Twain, Mark',
2285                 'basketno'         => '1',
2286                 'biblionumber'     => '215',
2287                 'count'            => 1,
2288                 'creationdate'     => 'MM/DD/YYYY',
2289                 'datereceived'     => undef,
2290                 'ecost'            => '1.00',
2291                 'id'               => '1',
2292                 'invoicenumber'    => undef,
2293                 'name'             => '',
2294                 'ordernumber'      => '1',
2295                 'quantity'         => 1,
2296                 'quantityreceived' => undef,
2297                 'title'            => 'The Adventures of Huckleberry Finn'
2298             }
2299
2300 =cut
2301
2302 sub GetHistory {
2303 # don't run the query if there are no parameters (list would be too long for sure !)
2304     croak "No search params" unless @_;
2305     my %params = @_;
2306     my $title = $params{title};
2307     my $author = $params{author};
2308     my $isbn   = $params{isbn};
2309     my $ean    = $params{ean};
2310     my $name = $params{name};
2311     my $from_placed_on = $params{from_placed_on};
2312     my $to_placed_on = $params{to_placed_on};
2313     my $basket = $params{basket};
2314     my $booksellerinvoicenumber = $params{booksellerinvoicenumber};
2315     my $basketgroupname = $params{basketgroupname};
2316     my $budget = $params{budget};
2317     my $orderstatus = $params{orderstatus};
2318     my $biblionumber = $params{biblionumber};
2319     my $get_canceled_order = $params{get_canceled_order} || 0;
2320     my $ordernumber = $params{ordernumber};
2321     my $search_children_too = $params{search_children_too} || 0;
2322     my $created_by = $params{created_by} || [];
2323     my $ordernumbers = $params{ordernumbers} || [];
2324
2325     my @order_loop;
2326     my $total_qty         = 0;
2327     my $total_qtyreceived = 0;
2328     my $total_price       = 0;
2329
2330     #get variation of isbn
2331     my @isbn_params;
2332     my @isbns;
2333     if ($isbn){
2334         if ( C4::Context->preference("SearchWithISBNVariations") ){
2335             @isbns = C4::Koha::GetVariationsOfISBN( $isbn );
2336             foreach my $isb (@isbns){
2337                 push @isbn_params, '?';
2338             }
2339         }
2340         unless (@isbns){
2341             push @isbns, $isbn;
2342             push @isbn_params, '?';
2343         }
2344     }
2345
2346     my $dbh   = C4::Context->dbh;
2347     my $query ="
2348         SELECT
2349             COALESCE(biblio.title,     deletedbiblio.title)     AS title,
2350             COALESCE(biblio.author,    deletedbiblio.author)    AS author,
2351             COALESCE(biblioitems.isbn, deletedbiblioitems.isbn) AS isbn,
2352             COALESCE(biblioitems.ean,  deletedbiblioitems.ean)  AS ean,
2353             aqorders.basketno,
2354             aqbasket.basketname,
2355             aqbasket.basketgroupid,
2356             aqbasket.authorisedby,
2357             concat( borrowers.firstname,' ',borrowers.surname) AS authorisedbyname,
2358             aqbasketgroups.name as groupname,
2359             aqbooksellers.name,
2360             aqbasket.creationdate,
2361             aqorders.datereceived,
2362             aqorders.quantity,
2363             aqorders.quantityreceived,
2364             aqorders.ecost,
2365             aqorders.ordernumber,
2366             aqorders.invoiceid,
2367             aqinvoices.invoicenumber,
2368             aqbooksellers.id as id,
2369             aqorders.biblionumber,
2370             aqorders.orderstatus,
2371             aqorders.parent_ordernumber,
2372             aqbudgets.budget_name
2373             ";
2374     $query .= ", aqbudgets.budget_id AS budget" if defined $budget;
2375     $query .= "
2376         FROM aqorders
2377         LEFT JOIN aqbasket ON aqorders.basketno=aqbasket.basketno
2378         LEFT JOIN aqbasketgroups ON aqbasket.basketgroupid=aqbasketgroups.id
2379         LEFT JOIN aqbooksellers ON aqbasket.booksellerid=aqbooksellers.id
2380         LEFT JOIN biblioitems ON biblioitems.biblionumber=aqorders.biblionumber
2381         LEFT JOIN biblio ON biblio.biblionumber=aqorders.biblionumber
2382         LEFT JOIN aqbudgets ON aqorders.budget_id=aqbudgets.budget_id
2383         LEFT JOIN aqinvoices ON aqorders.invoiceid = aqinvoices.invoiceid
2384         LEFT JOIN deletedbiblio ON deletedbiblio.biblionumber=aqorders.biblionumber
2385         LEFT JOIN deletedbiblioitems ON deletedbiblioitems.biblionumber=aqorders.biblionumber
2386         LEFT JOIN borrowers ON aqbasket.authorisedby=borrowers.borrowernumber
2387         ";
2388
2389     $query .= " WHERE 1 ";
2390
2391     unless ($get_canceled_order or (defined $orderstatus and $orderstatus eq 'cancelled')) {
2392         $query .= " AND (datecancellationprinted is NULL or datecancellationprinted='0000-00-00') ";
2393     }
2394
2395     my @query_params  = ();
2396
2397     if ( $biblionumber ) {
2398         $query .= " AND biblio.biblionumber = ?";
2399         push @query_params, $biblionumber;
2400     }
2401
2402     if ( $title ) {
2403         $query .= " AND biblio.title LIKE ? ";
2404         $title =~ s/\s+/%/g;
2405         push @query_params, "%$title%";
2406     }
2407
2408     if ( $author ) {
2409         $query .= " AND biblio.author LIKE ? ";
2410         push @query_params, "%$author%";
2411     }
2412
2413     if ( @isbns ) {
2414         $query .= " AND ( biblioitems.isbn LIKE " . join (" OR biblioitems.isbn LIKE ", @isbn_params ) . ")";
2415         foreach my $isb (@isbns){
2416             push @query_params, "%$isb%";
2417         }
2418     }
2419
2420     if ( $ean ) {
2421         $query .= " AND biblioitems.ean = ? ";
2422         push @query_params, "$ean";
2423     }
2424     if ( $name ) {
2425         $query .= " AND aqbooksellers.name LIKE ? ";
2426         push @query_params, "%$name%";
2427     }
2428
2429     if ( $budget ) {
2430         $query .= " AND aqbudgets.budget_id = ? ";
2431         push @query_params, "$budget";
2432     }
2433
2434     if ( $from_placed_on ) {
2435         $query .= " AND creationdate >= ? ";
2436         push @query_params, $from_placed_on;
2437     }
2438
2439     if ( $to_placed_on ) {
2440         $query .= " AND creationdate <= ? ";
2441         push @query_params, $to_placed_on;
2442     }
2443
2444     if ( defined $orderstatus and $orderstatus ne '') {
2445         $query .= " AND aqorders.orderstatus = ? ";
2446         push @query_params, "$orderstatus";
2447     }
2448
2449     if ($basket) {
2450         if ($basket =~ m/^\d+$/) {
2451             $query .= " AND aqorders.basketno = ? ";
2452             push @query_params, $basket;
2453         } else {
2454             $query .= " AND aqbasket.basketname LIKE ? ";
2455             push @query_params, "%$basket%";
2456         }
2457     }
2458
2459     if ($booksellerinvoicenumber) {
2460         $query .= " AND aqinvoices.invoicenumber LIKE ? ";
2461         push @query_params, "%$booksellerinvoicenumber%";
2462     }
2463
2464     if ($basketgroupname) {
2465         $query .= " AND aqbasketgroups.name LIKE ? ";
2466         push @query_params, "%$basketgroupname%";
2467     }
2468
2469     if ($ordernumber) {
2470         $query .= " AND (aqorders.ordernumber = ? ";
2471         push @query_params, $ordernumber;
2472         if ($search_children_too) {
2473             $query .= " OR aqorders.parent_ordernumber = ? ";
2474             push @query_params, $ordernumber;
2475         }
2476         $query .= ") ";
2477     }
2478
2479     if ( @$created_by ) {
2480         $query .= ' AND aqbasket.authorisedby IN ( ' . join( ',', ('?') x @$created_by ) . ')';
2481         push @query_params, @$created_by;
2482     }
2483
2484     if ( @$ordernumbers ) {
2485         $query .= ' AND (aqorders.ordernumber IN ( ' . join (',', ('?') x @$ordernumbers ) . '))';
2486         push @query_params, @$ordernumbers;
2487     }
2488
2489     if ( C4::Context->preference("IndependentBranches") ) {
2490         unless ( C4::Context->IsSuperLibrarian() ) {
2491             $query .= " AND (borrowers.branchcode = ? OR borrowers.branchcode ='' ) ";
2492             push @query_params, C4::Context->userenv->{branch};
2493         }
2494     }
2495     $query .= " ORDER BY id";
2496
2497     return $dbh->selectall_arrayref( $query, { Slice => {} }, @query_params );
2498 }
2499
2500 =head2 GetRecentAcqui
2501
2502   $results = GetRecentAcqui($days);
2503
2504 C<$results> is a ref to a table which contains hashref
2505
2506 =cut
2507
2508 sub GetRecentAcqui {
2509     my $limit  = shift;
2510     my $dbh    = C4::Context->dbh;
2511     my $query = "
2512         SELECT *
2513         FROM   biblio
2514         ORDER BY timestamp DESC
2515         LIMIT  0,".$limit;
2516
2517     my $sth = $dbh->prepare($query);
2518     $sth->execute;
2519     my $results = $sth->fetchall_arrayref({});
2520     return $results;
2521 }
2522
2523 #------------------------------------------------------------#
2524
2525 =head3 AddClaim
2526
2527   &AddClaim($ordernumber);
2528
2529 Add a claim for an order
2530
2531 =cut
2532
2533 sub AddClaim {
2534     my ($ordernumber) = @_;
2535     my $dbh          = C4::Context->dbh;
2536     my $query        = "
2537         UPDATE aqorders SET
2538             claims_count = claims_count + 1,
2539             claimed_date = CURDATE()
2540         WHERE ordernumber = ?
2541         ";
2542     my $sth = $dbh->prepare($query);
2543     $sth->execute($ordernumber);
2544 }
2545
2546 =head3 GetInvoices
2547
2548     my @invoices = GetInvoices(
2549         invoicenumber => $invoicenumber,
2550         supplierid => $supplierid,
2551         suppliername => $suppliername,
2552         shipmentdatefrom => $shipmentdatefrom, # ISO format
2553         shipmentdateto => $shipmentdateto, # ISO format
2554         billingdatefrom => $billingdatefrom, # ISO format
2555         billingdateto => $billingdateto, # ISO format
2556         isbneanissn => $isbn_or_ean_or_issn,
2557         title => $title,
2558         author => $author,
2559         publisher => $publisher,
2560         publicationyear => $publicationyear,
2561         branchcode => $branchcode,
2562         order_by => $order_by
2563     );
2564
2565 Return a list of invoices that match all given criteria.
2566
2567 $order_by is "column_name (asc|desc)", where column_name is any of
2568 'invoicenumber', 'booksellerid', 'shipmentdate', 'billingdate', 'closedate',
2569 'shipmentcost', 'shipmentcost_budgetid'.
2570
2571 asc is the default if omitted
2572
2573 =cut
2574
2575 sub GetInvoices {
2576     my %args = @_;
2577
2578     my @columns = qw(invoicenumber booksellerid shipmentdate billingdate
2579         closedate shipmentcost shipmentcost_budgetid);
2580
2581     my $dbh = C4::Context->dbh;
2582     my $query = qq{
2583         SELECT aqinvoices.invoiceid, aqinvoices.invoicenumber, aqinvoices.booksellerid, aqinvoices.shipmentdate, aqinvoices.billingdate, aqinvoices.closedate, aqinvoices.shipmentcost, aqinvoices.shipmentcost_budgetid, aqinvoices.message_id,
2584             aqbooksellers.name AS suppliername,
2585           COUNT(
2586             DISTINCT IF(
2587               aqorders.datereceived IS NOT NULL,
2588               aqorders.biblionumber,
2589               NULL
2590             )
2591           ) AS receivedbiblios,
2592           COUNT(
2593              DISTINCT IF(
2594               aqorders.subscriptionid IS NOT NULL,
2595               aqorders.subscriptionid,
2596               NULL
2597             )
2598           ) AS is_linked_to_subscriptions,
2599           SUM(aqorders.quantityreceived) AS receiveditems
2600         FROM aqinvoices
2601           LEFT JOIN aqbooksellers ON aqbooksellers.id = aqinvoices.booksellerid
2602           LEFT JOIN aqorders ON aqorders.invoiceid = aqinvoices.invoiceid
2603           LEFT JOIN aqbasket ON aqbasket.basketno=aqorders.basketno
2604           LEFT JOIN borrowers ON aqbasket.authorisedby=borrowers.borrowernumber
2605           LEFT JOIN biblio ON aqorders.biblionumber = biblio.biblionumber
2606           LEFT JOIN biblioitems ON biblio.biblionumber = biblioitems.biblionumber
2607           LEFT JOIN subscription ON biblio.biblionumber = subscription.biblionumber
2608     };
2609
2610     my @bind_args;
2611     my @bind_strs;
2612     if($args{supplierid}) {
2613         push @bind_strs, " aqinvoices.booksellerid = ? ";
2614         push @bind_args, $args{supplierid};
2615     }
2616     if($args{invoicenumber}) {
2617         push @bind_strs, " aqinvoices.invoicenumber LIKE ? ";
2618         push @bind_args, "%$args{invoicenumber}%";
2619     }
2620     if($args{suppliername}) {
2621         push @bind_strs, " aqbooksellers.name LIKE ? ";
2622         push @bind_args, "%$args{suppliername}%";
2623     }
2624     if($args{shipmentdatefrom}) {
2625         push @bind_strs, " aqinvoices.shipmentdate >= ? ";
2626         push @bind_args, $args{shipmentdatefrom};
2627     }
2628     if($args{shipmentdateto}) {
2629         push @bind_strs, " aqinvoices.shipmentdate <= ? ";
2630         push @bind_args, $args{shipmentdateto};
2631     }
2632     if($args{billingdatefrom}) {
2633         push @bind_strs, " aqinvoices.billingdate >= ? ";
2634         push @bind_args, $args{billingdatefrom};
2635     }
2636     if($args{billingdateto}) {
2637         push @bind_strs, " aqinvoices.billingdate <= ? ";
2638         push @bind_args, $args{billingdateto};
2639     }
2640     if($args{isbneanissn}) {
2641         push @bind_strs, " (biblioitems.isbn LIKE CONCAT('%', ?, '%') OR biblioitems.ean LIKE CONCAT('%', ?, '%') OR biblioitems.issn LIKE CONCAT('%', ?, '%') ) ";
2642         push @bind_args, $args{isbneanissn}, $args{isbneanissn}, $args{isbneanissn};
2643     }
2644     if($args{title}) {
2645         push @bind_strs, " biblio.title LIKE CONCAT('%', ?, '%') ";
2646         push @bind_args, $args{title};
2647     }
2648     if($args{author}) {
2649         push @bind_strs, " biblio.author LIKE CONCAT('%', ?, '%') ";
2650         push @bind_args, $args{author};
2651     }
2652     if($args{publisher}) {
2653         push @bind_strs, " biblioitems.publishercode LIKE CONCAT('%', ?, '%') ";
2654         push @bind_args, $args{publisher};
2655     }
2656     if($args{publicationyear}) {
2657         push @bind_strs, " ((biblioitems.publicationyear LIKE CONCAT('%', ?, '%')) OR (biblio.copyrightdate LIKE CONCAT('%', ?, '%'))) ";
2658         push @bind_args, $args{publicationyear}, $args{publicationyear};
2659     }
2660     if($args{branchcode}) {
2661         push @bind_strs, " borrowers.branchcode = ? ";
2662         push @bind_args, $args{branchcode};
2663     }
2664     if($args{message_id}) {
2665         push @bind_strs, " aqinvoices.message_id = ? ";
2666         push @bind_args, $args{message_id};
2667     }
2668
2669     $query .= " WHERE " . join(" AND ", @bind_strs) if @bind_strs;
2670     $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";
2671
2672     if($args{order_by}) {
2673         my ($column, $direction) = split / /, $args{order_by};
2674         if(grep /^$column$/, @columns) {
2675             $direction ||= 'ASC';
2676             $query .= " ORDER BY $column $direction";
2677         }
2678     }
2679
2680     my $sth = $dbh->prepare($query);
2681     $sth->execute(@bind_args);
2682
2683     my $results = $sth->fetchall_arrayref({});
2684     return @$results;
2685 }
2686
2687 =head3 GetInvoice
2688
2689     my $invoice = GetInvoice($invoiceid);
2690
2691 Get informations about invoice with given $invoiceid
2692
2693 Return a hash filled with aqinvoices.* fields
2694
2695 =cut
2696
2697 sub GetInvoice {
2698     my ($invoiceid) = @_;
2699     my $invoice;
2700
2701     return unless $invoiceid;
2702
2703     my $dbh = C4::Context->dbh;
2704     my $query = qq{
2705         SELECT *
2706         FROM aqinvoices
2707         WHERE invoiceid = ?
2708     };
2709     my $sth = $dbh->prepare($query);
2710     $sth->execute($invoiceid);
2711
2712     $invoice = $sth->fetchrow_hashref;
2713     return $invoice;
2714 }
2715
2716 =head3 GetInvoiceDetails
2717
2718     my $invoice = GetInvoiceDetails($invoiceid)
2719
2720 Return informations about an invoice + the list of related order lines
2721
2722 Orders informations are in $invoice->{orders} (array ref)
2723
2724 =cut
2725
2726 sub GetInvoiceDetails {
2727     my ($invoiceid) = @_;
2728
2729     if ( !defined $invoiceid ) {
2730         carp 'GetInvoiceDetails called without an invoiceid';
2731         return;
2732     }
2733
2734     my $dbh = C4::Context->dbh;
2735     my $query = q{
2736         SELECT aqinvoices.*, aqbooksellers.name AS suppliername
2737         FROM aqinvoices
2738           LEFT JOIN aqbooksellers ON aqinvoices.booksellerid = aqbooksellers.id
2739         WHERE invoiceid = ?
2740     };
2741     my $sth = $dbh->prepare($query);
2742     $sth->execute($invoiceid);
2743
2744     my $invoice = $sth->fetchrow_hashref;
2745
2746     $query = q{
2747         SELECT aqorders.*,
2748                 biblio.*,
2749                 biblio.copyrightdate,
2750                 biblioitems.isbn,
2751                 biblioitems.publishercode,
2752                 biblioitems.publicationyear,
2753                 aqbasket.basketname,
2754                 aqbasketgroups.id AS basketgroupid,
2755                 aqbasketgroups.name AS basketgroupname
2756         FROM aqorders
2757           LEFT JOIN aqbasket ON aqorders.basketno = aqbasket.basketno
2758           LEFT JOIN aqbasketgroups ON aqbasket.basketgroupid = aqbasketgroups.id
2759           LEFT JOIN biblio ON aqorders.biblionumber = biblio.biblionumber
2760           LEFT JOIN biblioitems ON aqorders.biblionumber = biblioitems.biblionumber
2761         WHERE invoiceid = ?
2762     };
2763     $sth = $dbh->prepare($query);
2764     $sth->execute($invoiceid);
2765     $invoice->{orders} = $sth->fetchall_arrayref({});
2766     $invoice->{orders} ||= []; # force an empty arrayref if fetchall_arrayref fails
2767
2768     return $invoice;
2769 }
2770
2771 =head3 AddInvoice
2772
2773     my $invoiceid = AddInvoice(
2774         invoicenumber => $invoicenumber,
2775         booksellerid => $booksellerid,
2776         shipmentdate => $shipmentdate,
2777         billingdate => $billingdate,
2778         closedate => $closedate,
2779         shipmentcost => $shipmentcost,
2780         shipmentcost_budgetid => $shipmentcost_budgetid
2781     );
2782
2783 Create a new invoice and return its id or undef if it fails.
2784
2785 =cut
2786
2787 sub AddInvoice {
2788     my %invoice = @_;
2789
2790     return unless(%invoice and $invoice{invoicenumber});
2791
2792     my @columns = qw(invoicenumber booksellerid shipmentdate billingdate
2793         closedate shipmentcost shipmentcost_budgetid message_id);
2794
2795     my @set_strs;
2796     my @set_args;
2797     foreach my $key (keys %invoice) {
2798         if(0 < grep(/^$key$/, @columns)) {
2799             push @set_strs, "$key = ?";
2800             push @set_args, ($invoice{$key} || undef);
2801         }
2802     }
2803
2804     my $rv;
2805     if(@set_args > 0) {
2806         my $dbh = C4::Context->dbh;
2807         my $query = "INSERT INTO aqinvoices SET ";
2808         $query .= join (",", @set_strs);
2809         my $sth = $dbh->prepare($query);
2810         $rv = $sth->execute(@set_args);
2811         if($rv) {
2812             $rv = $dbh->last_insert_id(undef, undef, 'aqinvoices', undef);
2813         }
2814     }
2815     return $rv;
2816 }
2817
2818 =head3 ModInvoice
2819
2820     ModInvoice(
2821         invoiceid => $invoiceid,    # Mandatory
2822         invoicenumber => $invoicenumber,
2823         booksellerid => $booksellerid,
2824         shipmentdate => $shipmentdate,
2825         billingdate => $billingdate,
2826         closedate => $closedate,
2827         shipmentcost => $shipmentcost,
2828         shipmentcost_budgetid => $shipmentcost_budgetid
2829     );
2830
2831 Modify an invoice, invoiceid is mandatory.
2832
2833 Return undef if it fails.
2834
2835 =cut
2836
2837 sub ModInvoice {
2838     my %invoice = @_;
2839
2840     return unless(%invoice and $invoice{invoiceid});
2841
2842     my @columns = qw(invoicenumber booksellerid shipmentdate billingdate
2843         closedate shipmentcost shipmentcost_budgetid);
2844
2845     my @set_strs;
2846     my @set_args;
2847     foreach my $key (keys %invoice) {
2848         if(0 < grep(/^$key$/, @columns)) {
2849             push @set_strs, "$key = ?";
2850             push @set_args, ($invoice{$key} || undef);
2851         }
2852     }
2853
2854     my $dbh = C4::Context->dbh;
2855     my $query = "UPDATE aqinvoices SET ";
2856     $query .= join(",", @set_strs);
2857     $query .= " WHERE invoiceid = ?";
2858
2859     my $sth = $dbh->prepare($query);
2860     $sth->execute(@set_args, $invoice{invoiceid});
2861 }
2862
2863 =head3 CloseInvoice
2864
2865     CloseInvoice($invoiceid);
2866
2867 Close an invoice.
2868
2869 Equivalent to ModInvoice(invoiceid => $invoiceid, closedate => undef);
2870
2871 =cut
2872
2873 sub CloseInvoice {
2874     my ($invoiceid) = @_;
2875
2876     return unless $invoiceid;
2877
2878     my $dbh = C4::Context->dbh;
2879     my $query = qq{
2880         UPDATE aqinvoices
2881         SET closedate = CAST(NOW() AS DATE)
2882         WHERE invoiceid = ?
2883     };
2884     my $sth = $dbh->prepare($query);
2885     $sth->execute($invoiceid);
2886 }
2887
2888 =head3 ReopenInvoice
2889
2890     ReopenInvoice($invoiceid);
2891
2892 Reopen an invoice
2893
2894 Equivalent to ModInvoice(invoiceid => $invoiceid, closedate => output_pref({ dt=>dt_from_string, dateonly=>1, otputpref=>'iso' }))
2895
2896 =cut
2897
2898 sub ReopenInvoice {
2899     my ($invoiceid) = @_;
2900
2901     return unless $invoiceid;
2902
2903     my $dbh = C4::Context->dbh;
2904     my $query = qq{
2905         UPDATE aqinvoices
2906         SET closedate = NULL
2907         WHERE invoiceid = ?
2908     };
2909     my $sth = $dbh->prepare($query);
2910     $sth->execute($invoiceid);
2911 }
2912
2913 =head3 DelInvoice
2914
2915     DelInvoice($invoiceid);
2916
2917 Delete an invoice if there are no items attached to it.
2918
2919 =cut
2920
2921 sub DelInvoice {
2922     my ($invoiceid) = @_;
2923
2924     return unless $invoiceid;
2925
2926     my $dbh   = C4::Context->dbh;
2927     my $query = qq{
2928         SELECT COUNT(*)
2929         FROM aqorders
2930         WHERE invoiceid = ?
2931     };
2932     my $sth = $dbh->prepare($query);
2933     $sth->execute($invoiceid);
2934     my $res = $sth->fetchrow_arrayref;
2935     if ( $res && $res->[0] == 0 ) {
2936         $query = qq{
2937             DELETE FROM aqinvoices
2938             WHERE invoiceid = ?
2939         };
2940         my $sth = $dbh->prepare($query);
2941         return ( $sth->execute($invoiceid) > 0 );
2942     }
2943     return;
2944 }
2945
2946 =head3 MergeInvoices
2947
2948     MergeInvoices($invoiceid, \@sourceids);
2949
2950 Merge the invoices identified by the IDs in \@sourceids into
2951 the invoice identified by $invoiceid.
2952
2953 =cut
2954
2955 sub MergeInvoices {
2956     my ($invoiceid, $sourceids) = @_;
2957
2958     return unless $invoiceid;
2959     foreach my $sourceid (@$sourceids) {
2960         next if $sourceid == $invoiceid;
2961         my $source = GetInvoiceDetails($sourceid);
2962         foreach my $order (@{$source->{'orders'}}) {
2963             $order->{'invoiceid'} = $invoiceid;
2964             ModOrder($order);
2965         }
2966         DelInvoice($source->{'invoiceid'});
2967     }
2968     return;
2969 }
2970
2971 =head3 GetBiblioCountByBasketno
2972
2973 $biblio_count = &GetBiblioCountByBasketno($basketno);
2974
2975 Looks up the biblio's count that has basketno value $basketno
2976
2977 Returns a quantity
2978
2979 =cut
2980
2981 sub GetBiblioCountByBasketno {
2982     my ($basketno) = @_;
2983     my $dbh          = C4::Context->dbh;
2984     my $query        = "
2985         SELECT COUNT( DISTINCT( biblionumber ) )
2986         FROM   aqorders
2987         WHERE  basketno = ?
2988             AND (datecancellationprinted IS NULL OR datecancellationprinted='0000-00-00')
2989         ";
2990
2991     my $sth = $dbh->prepare($query);
2992     $sth->execute($basketno);
2993     return $sth->fetchrow;
2994 }
2995
2996 =head3 populate_order_with_prices
2997
2998 $order = populate_order_with_prices({
2999     order        => $order #a hashref with the order values
3000     booksellerid => $booksellerid #FIXME - should obtain from order basket
3001     receiving    => 1 # boolean representing order stage, should pass only this or ordering
3002     ordering     => 1 # boolean representing order stage
3003 });
3004
3005
3006 Sets calculated values for an order - all values are stored with pull precision regardless of rounding preference except fot
3007 tax value which is calculated on rounded values if requested
3008
3009 For ordering the values set are:
3010     rrp_tax_included
3011     rrp_tax_excluded
3012     ecost_tax_included
3013     ecost_tax_excluded
3014     tax_value_on_ordering
3015 For receiving the value set are:
3016     unitprice_tax_included
3017     unitprice_tax_excluded
3018     tax_value_on_receiving
3019
3020 Note: When receiving if the rounded value of the unitprice matches the rounded value of the ecost then then ecost (full precision) is used.
3021
3022 Returns a hashref of the order
3023
3024 FIXME: Move this to Koha::Acquisition::Order.pm
3025
3026 =cut
3027
3028 sub populate_order_with_prices {
3029     my ($params) = @_;
3030
3031     my $order        = $params->{order};
3032     my $booksellerid = $params->{booksellerid};
3033     return unless $booksellerid;
3034
3035     my $bookseller = Koha::Acquisition::Booksellers->find( $booksellerid );
3036
3037     my $receiving = $params->{receiving};
3038     my $ordering  = $params->{ordering};
3039     my $discount  = $order->{discount};
3040     $discount /= 100 if $discount > 1;
3041
3042     if ($ordering) {
3043         $order->{tax_rate_on_ordering} //= $order->{tax_rate};
3044         if ( $bookseller->listincgst ) {
3045             # The user entered the rrp tax included
3046             $order->{rrp_tax_included} = $order->{rrp};
3047
3048             # rrp tax excluded = rrp tax included / ( 1 + tax rate )
3049             $order->{rrp_tax_excluded} = $order->{rrp_tax_included} / ( 1 + $order->{tax_rate_on_ordering} );
3050
3051             # ecost tax included = rrp tax included  ( 1 - discount )
3052             $order->{ecost_tax_included} = $order->{rrp_tax_included} * ( 1 - $discount );
3053
3054             # ecost tax excluded = rrp tax excluded * ( 1 - discount )
3055             $order->{ecost_tax_excluded} = $order->{rrp_tax_excluded} * ( 1 - $discount );
3056
3057             # tax value = quantity * ecost tax excluded * tax rate
3058             $order->{tax_value_on_ordering} = ( get_rounded_price($order->{ecost_tax_included}) - get_rounded_price($order->{ecost_tax_excluded}) ) * $order->{quantity};
3059
3060         }
3061         else {
3062             # The user entered the rrp tax excluded
3063             $order->{rrp_tax_excluded} = $order->{rrp};
3064
3065             # rrp tax included = rrp tax excluded * ( 1 - tax rate )
3066             $order->{rrp_tax_included} = $order->{rrp_tax_excluded} * ( 1 + $order->{tax_rate_on_ordering} );
3067
3068             # ecost tax excluded = rrp tax excluded * ( 1 - discount )
3069             $order->{ecost_tax_excluded} = $order->{rrp_tax_excluded} * ( 1 - $discount );
3070
3071             # ecost tax included = rrp tax excluded * ( 1 + tax rate ) * ( 1 - discount ) = ecost tax excluded * ( 1 + tax rate )
3072             $order->{ecost_tax_included} = $order->{ecost_tax_excluded} * ( 1 + $order->{tax_rate_on_ordering} );
3073
3074             # tax value = quantity * ecost tax included * tax rate
3075             $order->{tax_value_on_ordering} = $order->{quantity} * get_rounded_price($order->{ecost_tax_excluded}) * $order->{tax_rate_on_ordering};
3076         }
3077     }
3078
3079     if ($receiving) {
3080         $order->{tax_rate_on_receiving} //= $order->{tax_rate};
3081         if ( $bookseller->invoiceincgst ) {
3082             # Trick for unitprice. If the unit price rounded value is the same as the ecost rounded value
3083             # we need to keep the exact ecost value
3084             if ( Koha::Number::Price->new( $order->{unitprice} )->round == Koha::Number::Price->new( $order->{ecost_tax_included} )->round ) {
3085                 $order->{unitprice} = $order->{ecost_tax_included};
3086             }
3087
3088             # The user entered the unit price tax included
3089             $order->{unitprice_tax_included} = $order->{unitprice};
3090
3091             # unit price tax excluded = unit price tax included / ( 1 + tax rate )
3092             $order->{unitprice_tax_excluded} = $order->{unitprice_tax_included} / ( 1 + $order->{tax_rate_on_receiving} );
3093         }
3094         else {
3095             # Trick for unitprice. If the unit price rounded value is the same as the ecost rounded value
3096             # we need to keep the exact ecost value
3097             if ( Koha::Number::Price->new( $order->{unitprice} )->round == Koha::Number::Price->new( $order->{ecost_tax_excluded} )->round ) {
3098                 $order->{unitprice} = $order->{ecost_tax_excluded};
3099             }
3100
3101             # The user entered the unit price tax excluded
3102             $order->{unitprice_tax_excluded} = $order->{unitprice};
3103
3104
3105             # unit price tax included = unit price tax included * ( 1 + tax rate )
3106             $order->{unitprice_tax_included} = $order->{unitprice_tax_excluded} * ( 1 + $order->{tax_rate_on_receiving} );
3107         }
3108
3109         # tax value = quantity * unit price tax excluded * tax rate
3110         $order->{tax_value_on_receiving} = $order->{quantity} * get_rounded_price($order->{unitprice_tax_excluded}) * $order->{tax_rate_on_receiving};
3111     }
3112
3113     return $order;
3114 }
3115
3116 =head3 GetOrderUsers
3117
3118     $order_users_ids = &GetOrderUsers($ordernumber);
3119
3120 Returns a list of all borrowernumbers that are in order users list
3121
3122 =cut
3123
3124 sub GetOrderUsers {
3125     my ($ordernumber) = @_;
3126
3127     return unless $ordernumber;
3128
3129     my $query = q|
3130         SELECT borrowernumber
3131         FROM aqorder_users
3132         WHERE ordernumber = ?
3133     |;
3134     my $dbh = C4::Context->dbh;
3135     my $sth = $dbh->prepare($query);
3136     $sth->execute($ordernumber);
3137     my $results = $sth->fetchall_arrayref( {} );
3138
3139     my @borrowernumbers;
3140     foreach (@$results) {
3141         push @borrowernumbers, $_->{'borrowernumber'};
3142     }
3143
3144     return @borrowernumbers;
3145 }
3146
3147 =head3 ModOrderUsers
3148
3149     my @order_users_ids = (1, 2, 3);
3150     &ModOrderUsers($ordernumber, @basketusers_ids);
3151
3152 Delete all users from order users list, and add users in C<@order_users_ids>
3153 to this users list.
3154
3155 =cut
3156
3157 sub ModOrderUsers {
3158     my ( $ordernumber, @order_users_ids ) = @_;
3159
3160     return unless $ordernumber;
3161
3162     my $dbh   = C4::Context->dbh;
3163     my $query = q|
3164         DELETE FROM aqorder_users
3165         WHERE ordernumber = ?
3166     |;
3167     my $sth = $dbh->prepare($query);
3168     $sth->execute($ordernumber);
3169
3170     $query = q|
3171         INSERT INTO aqorder_users (ordernumber, borrowernumber)
3172         VALUES (?, ?)
3173     |;
3174     $sth = $dbh->prepare($query);
3175     foreach my $order_user_id (@order_users_ids) {
3176         $sth->execute( $ordernumber, $order_user_id );
3177     }
3178 }
3179
3180 sub NotifyOrderUsers {
3181     my ($ordernumber) = @_;
3182
3183     my @borrowernumbers = GetOrderUsers($ordernumber);
3184     return unless @borrowernumbers;
3185
3186     my $order = GetOrder( $ordernumber );
3187     for my $borrowernumber (@borrowernumbers) {
3188         my $patron = Koha::Patrons->find( $borrowernumber );
3189         my $library = $patron->library->unblessed;
3190         my $biblio = Koha::Biblios->find( $order->{biblionumber} )->unblessed;
3191         my $letter = C4::Letters::GetPreparedLetter(
3192             module      => 'acquisition',
3193             letter_code => 'ACQ_NOTIF_ON_RECEIV',
3194             branchcode  => $library->{branchcode},
3195             lang        => $patron->lang,
3196             tables      => {
3197                 'branches'    => $library,
3198                 'borrowers'   => $patron->unblessed,
3199                 'biblio'      => $biblio,
3200                 'aqorders'    => $order,
3201             },
3202         );
3203         if ( $letter ) {
3204             C4::Letters::EnqueueLetter(
3205                 {
3206                     letter         => $letter,
3207                     borrowernumber => $borrowernumber,
3208                     LibraryName    => C4::Context->preference("LibraryName"),
3209                     message_transport_type => 'email',
3210                 }
3211             ) or warn "can't enqueue letter $letter";
3212         }
3213     }
3214 }
3215
3216 =head3 FillWithDefaultValues
3217
3218 FillWithDefaultValues( $marc_record );
3219
3220 This will update the record with default value defined in the ACQ framework.
3221 For all existing fields, if a default value exists and there are no subfield, it will be created.
3222 If the field does not exist, it will be created too.
3223
3224 =cut
3225
3226 sub FillWithDefaultValues {
3227     my ($record) = @_;
3228     my $tagslib = C4::Biblio::GetMarcStructure( 1, 'ACQ', { unsafe => 1 } );
3229     if ($tagslib) {
3230         my ($itemfield) =
3231           C4::Biblio::GetMarcFromKohaField( 'items.itemnumber', '' );
3232         for my $tag ( sort keys %$tagslib ) {
3233             next unless $tag;
3234             next if $tag == $itemfield;
3235             for my $subfield ( sort keys %{ $tagslib->{$tag} } ) {
3236                 next if IsMarcStructureInternal($tagslib->{$tag}{$subfield});
3237                 my $defaultvalue = $tagslib->{$tag}{$subfield}{defaultvalue};
3238                 if ( defined $defaultvalue and $defaultvalue ne '' ) {
3239                     my @fields = $record->field($tag);
3240                     if (@fields) {
3241                         for my $field (@fields) {
3242                             unless ( defined $field->subfield($subfield) ) {
3243                                 $field->add_subfields(
3244                                     $subfield => $defaultvalue );
3245                             }
3246                         }
3247                     }
3248                     else {
3249                         $record->insert_fields_ordered(
3250                             MARC::Field->new(
3251                                 $tag, '', '', $subfield => $defaultvalue
3252                             )
3253                         );
3254                     }
3255                 }
3256             }
3257         }
3258     }
3259 }
3260
3261 1;
3262 __END__
3263
3264 =head1 AUTHOR
3265
3266 Koha Development Team <http://koha-community.org/>
3267
3268 =cut