C4/Acquisition.pm

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