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