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