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