C4/Acquisition.pm

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