C4/Acquisition.pm

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