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