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