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