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