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