C4/Acquisition.pm

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