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