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|, order_internalnote = ?| if defined $order->{order_internalnote};
1447         $query .= q| WHERE ordernumber = ?|;
1448         my $sth = $dbh->prepare($query);
1449
1450         $sth->execute(
1451             ( $is_standing ? 1 : ($order->{quantity} - $quantrec) ),
1452             ( defined $order->{order_internalnote} ? $order->{order_internalnote} : () ),
1453             $order->{ordernumber}
1454         );
1455
1456         # Recalculate tax_value
1457         $dbh->do(q|
1458             UPDATE aqorders
1459             SET
1460                 tax_value_on_ordering = quantity * ecost_tax_excluded * tax_rate_on_ordering,
1461                 tax_value_on_receiving = quantity * unitprice_tax_excluded * tax_rate_on_receiving
1462             WHERE ordernumber = ?
1463         |, undef, $order->{ordernumber});
1464
1465         delete $order->{ordernumber};
1466         $order->{budget_id} = ( $budget_id || $order->{budget_id} );
1467         $order->{quantity} = $quantrec;
1468         $order->{quantityreceived} = $quantrec;
1469         $order->{ecost_tax_excluded} //= 0;
1470         $order->{tax_rate_on_ordering} //= 0;
1471         $order->{unitprice_tax_excluded} //= 0;
1472         $order->{tax_rate_on_receiving} //= 0;
1473         $order->{tax_value_on_ordering} = $order->{quantity} * $order->{ecost_tax_excluded} * $order->{tax_rate_on_ordering};
1474         $order->{tax_value_on_receiving} = $order->{quantity} * $order->{unitprice_tax_excluded} * $order->{tax_rate_on_receiving};
1475         $order->{datereceived} = $datereceived;
1476         $order->{invoiceid} = $invoice->{invoiceid};
1477         $order->{orderstatus} = 'complete';
1478         $new_ordernumber = Koha::Acquisition::Order->new($order)->store->ordernumber; # TODO What if the store fails?
1479
1480         if ($received_items) {
1481             foreach my $itemnumber (@$received_items) {
1482                 ModItemOrder($itemnumber, $new_ordernumber);
1483             }
1484         }
1485     } else {
1486         my $query = q|
1487             UPDATE aqorders
1488             SET quantityreceived = ?,
1489                 datereceived = ?,
1490                 invoiceid = ?,
1491                 budget_id = ?,
1492                 orderstatus = 'complete'
1493         |;
1494
1495         $query .= q|
1496             , replacementprice = ?
1497         | if defined $order->{replacementprice};
1498
1499         $query .= q|
1500             , unitprice = ?, unitprice_tax_included = ?, unitprice_tax_excluded = ?
1501         | if defined $order->{unitprice};
1502
1503         $query .= q|
1504             ,tax_value_on_receiving = ?
1505         | if defined $order->{tax_value_on_receiving};
1506
1507         $query .= q|
1508             ,tax_rate_on_receiving = ?
1509         | if defined $order->{tax_rate_on_receiving};
1510
1511         $query .= q|
1512             , order_internalnote = ?
1513         | if defined $order->{order_internalnote};
1514
1515         $query .= q| where biblionumber=? and ordernumber=?|;
1516
1517         my $sth = $dbh->prepare( $query );
1518         my @params = ( $quantrec, $datereceived, $invoice->{invoiceid}, ( $budget_id ? $budget_id : $order->{budget_id} ) );
1519
1520         if ( defined $order->{replacementprice} ) {
1521             push @params, $order->{replacementprice};
1522         }
1523
1524         if ( defined $order->{unitprice} ) {
1525             push @params, $order->{unitprice}, $order->{unitprice_tax_included}, $order->{unitprice_tax_excluded};
1526         }
1527
1528         if ( defined $order->{tax_value_on_receiving} ) {
1529             push @params, $order->{tax_value_on_receiving};
1530         }
1531
1532         if ( defined $order->{tax_rate_on_receiving} ) {
1533             push @params, $order->{tax_rate_on_receiving};
1534         }
1535
1536         if ( defined $order->{order_internalnote} ) {
1537             push @params, $order->{order_internalnote};
1538         }
1539
1540         push @params, ( $biblionumber, $order->{ordernumber} );
1541
1542         $sth->execute( @params );
1543
1544         # All items have been received, sent a notification to users
1545         NotifyOrderUsers( $order->{ordernumber} );
1546
1547     }
1548     return ($datereceived, $new_ordernumber);
1549 }
1550
1551 =head3 CancelReceipt
1552
1553     my $parent_ordernumber = CancelReceipt($ordernumber);
1554
1555     Cancel an order line receipt and update the parent order line, as if no
1556     receipt was made.
1557     If items are created at receipt (AcqCreateItem = receiving) then delete
1558     these items.
1559
1560 =cut
1561
1562 sub CancelReceipt {
1563     my $ordernumber = shift;
1564
1565     return unless $ordernumber;
1566
1567     my $dbh = C4::Context->dbh;
1568     my $query = qq{
1569         SELECT datereceived, parent_ordernumber, quantity
1570         FROM aqorders
1571         WHERE ordernumber = ?
1572     };
1573     my $sth = $dbh->prepare($query);
1574     $sth->execute($ordernumber);
1575     my $order = $sth->fetchrow_hashref;
1576     unless($order) {
1577         warn "CancelReceipt: order $ordernumber does not exist";
1578         return;
1579     }
1580     unless($order->{'datereceived'}) {
1581         warn "CancelReceipt: order $ordernumber is not received";
1582         return;
1583     }
1584
1585     my $parent_ordernumber = $order->{'parent_ordernumber'};
1586
1587     my $order_obj = Koha::Acquisition::Orders->find( $ordernumber ); # FIXME rewrite all this subroutine using this object
1588     my @itemnumbers = $order_obj->items->get_column('itemnumber');
1589
1590     if($parent_ordernumber == $ordernumber || not $parent_ordernumber) {
1591         # The order line has no parent, just mark it as not received
1592         $query = qq{
1593             UPDATE aqorders
1594             SET quantityreceived = ?,
1595                 datereceived = ?,
1596                 invoiceid = ?,
1597                 orderstatus = 'ordered'
1598             WHERE ordernumber = ?
1599         };
1600         $sth = $dbh->prepare($query);
1601         $sth->execute(0, undef, undef, $ordernumber);
1602         _cancel_items_receipt( $order_obj );
1603     } else {
1604         # The order line has a parent, increase parent quantity and delete
1605         # the order line.
1606         $query = qq{
1607             SELECT quantity, datereceived
1608             FROM aqorders
1609             WHERE ordernumber = ?
1610         };
1611         $sth = $dbh->prepare($query);
1612         $sth->execute($parent_ordernumber);
1613         my $parent_order = $sth->fetchrow_hashref;
1614         unless($parent_order) {
1615             warn "Parent order $parent_ordernumber does not exist.";
1616             return;
1617         }
1618         if($parent_order->{'datereceived'}) {
1619             warn "CancelReceipt: parent order is received.".
1620                 " Can't cancel receipt.";
1621             return;
1622         }
1623         $query = qq{
1624             UPDATE aqorders
1625             SET quantity = ?,
1626                 orderstatus = 'ordered'
1627             WHERE ordernumber = ?
1628         };
1629         $sth = $dbh->prepare($query);
1630         my $rv = $sth->execute(
1631             $order->{'quantity'} + $parent_order->{'quantity'},
1632             $parent_ordernumber
1633         );
1634         unless($rv) {
1635             warn "Cannot update parent order line, so do not cancel".
1636                 " receipt";
1637             return;
1638         }
1639
1640         # Recalculate tax_value
1641         $dbh->do(q|
1642             UPDATE aqorders
1643             SET
1644                 tax_value_on_ordering = quantity * ecost_tax_excluded * tax_rate_on_ordering,
1645                 tax_value_on_receiving = quantity * unitprice_tax_excluded * tax_rate_on_receiving
1646             WHERE ordernumber = ?
1647         |, undef, $parent_ordernumber);
1648
1649         _cancel_items_receipt( $order_obj, $parent_ordernumber );
1650         # Delete order line
1651         $query = qq{
1652             DELETE FROM aqorders
1653             WHERE ordernumber = ?
1654         };
1655         $sth = $dbh->prepare($query);
1656         $sth->execute($ordernumber);
1657
1658     }
1659
1660     if( $order_obj->basket->effective_create_items eq 'ordering' ) {
1661         my @affects = split q{\|}, C4::Context->preference("AcqItemSetSubfieldsWhenReceiptIsCancelled");
1662         if ( @affects ) {
1663             for my $in ( @itemnumbers ) {
1664                 my $item = Koha::Items->find( $in ); # FIXME We do not need that, we already have Koha::Items from $order_obj->items
1665                 my $biblio = $item->biblio;
1666                 my ( $itemfield ) = GetMarcFromKohaField( 'items.itemnumber', $biblio->frameworkcode );
1667                 my $item_marc = C4::Items::GetMarcItem( $biblio->biblionumber, $in );
1668                 for my $affect ( @affects ) {
1669                     my ( $sf, $v ) = split q{=}, $affect, 2;
1670                     foreach ( $item_marc->field($itemfield) ) {
1671                         $_->update( $sf => $v );
1672                     }
1673                 }
1674                 C4::Items::ModItemFromMarc( $item_marc, $biblio->biblionumber, $in );
1675             }
1676         }
1677     }
1678
1679     return $parent_ordernumber;
1680 }
1681
1682 sub _cancel_items_receipt {
1683     my ( $order, $parent_ordernumber ) = @_;
1684     $parent_ordernumber ||= $order->ordernumber;
1685
1686     my $items = $order->items;
1687     if ( $order->basket->effective_create_items eq 'receiving' ) {
1688         # Remove items that were created at receipt
1689         my $query = qq{
1690             DELETE FROM items, aqorders_items
1691             USING items, aqorders_items
1692             WHERE items.itemnumber = ? AND aqorders_items.itemnumber = ?
1693         };
1694         my $dbh = C4::Context->dbh;
1695         my $sth = $dbh->prepare($query);
1696         while ( my $item = $items->next ) {
1697             $sth->execute($item->itemnumber, $item->itemnumber);
1698         }
1699     } else {
1700         # Update items
1701         while ( my $item = $items->next ) {
1702             ModItemOrder($item->itemnumber, $parent_ordernumber);
1703         }
1704     }
1705 }
1706
1707 #------------------------------------------------------------#
1708
1709 =head3 SearchOrders
1710
1711 @results = &SearchOrders({
1712     ordernumber => $ordernumber,
1713     search => $search,
1714     ean => $ean,
1715     booksellerid => $booksellerid,
1716     basketno => $basketno,
1717     basketname => $basketname,
1718     basketgroupname => $basketgroupname,
1719     owner => $owner,
1720     pending => $pending
1721     ordered => $ordered
1722     biblionumber => $biblionumber,
1723     budget_id => $budget_id
1724 });
1725
1726 Searches for orders filtered by criteria.
1727
1728 C<$ordernumber> Finds matching orders or transferred orders by ordernumber.
1729 C<$search> Finds orders matching %$search% in title, author, or isbn.
1730 C<$owner> Finds order for the logged in user.
1731 C<$pending> Finds pending orders. Ignores completed and cancelled orders.
1732 C<$ordered> Finds orders to receive only (status 'ordered' or 'partial').
1733
1734
1735 C<@results> is an array of references-to-hash with the keys are fields
1736 from aqorders, biblio, biblioitems and aqbasket tables.
1737
1738 =cut
1739
1740 sub SearchOrders {
1741     my ( $params ) = @_;
1742     my $ordernumber = $params->{ordernumber};
1743     my $search = $params->{search};
1744     my $ean = $params->{ean};
1745     my $booksellerid = $params->{booksellerid};
1746     my $basketno = $params->{basketno};
1747     my $basketname = $params->{basketname};
1748     my $basketgroupname = $params->{basketgroupname};
1749     my $owner = $params->{owner};
1750     my $pending = $params->{pending};
1751     my $ordered = $params->{ordered};
1752     my $biblionumber = $params->{biblionumber};
1753     my $budget_id = $params->{budget_id};
1754
1755     my $dbh = C4::Context->dbh;
1756     my @args = ();
1757     my $query = q{
1758         SELECT aqbasket.basketno,
1759                borrowers.surname,
1760                borrowers.firstname,
1761                biblio.*,
1762                biblioitems.isbn,
1763                biblioitems.biblioitemnumber,
1764                biblioitems.publishercode,
1765                biblioitems.publicationyear,
1766                aqbasket.authorisedby,
1767                aqbasket.booksellerid,
1768                aqbasket.closedate,
1769                aqbasket.creationdate,
1770                aqbasket.basketname,
1771                aqbasketgroups.id as basketgroupid,
1772                aqbasketgroups.name as basketgroupname,
1773                aqorders.*
1774         FROM aqorders
1775             LEFT JOIN aqbasket ON aqorders.basketno = aqbasket.basketno
1776             LEFT JOIN aqbasketgroups ON aqbasket.basketgroupid = aqbasketgroups.id
1777             LEFT JOIN borrowers ON aqbasket.authorisedby=borrowers.borrowernumber
1778             LEFT JOIN biblio ON aqorders.biblionumber=biblio.biblionumber
1779             LEFT JOIN biblioitems ON biblioitems.biblionumber=biblio.biblionumber
1780     };
1781
1782     # If we search on ordernumber, we retrieve the transferred order if a transfer has been done.
1783     $query .= q{
1784             LEFT JOIN aqorders_transfers ON aqorders_transfers.ordernumber_to = aqorders.ordernumber
1785     } if $ordernumber;
1786
1787     $query .= q{
1788         WHERE (datecancellationprinted is NULL)
1789     };
1790
1791     if ( $pending or $ordered ) {
1792         $query .= q{
1793             AND (
1794                 ( aqbasket.is_standing AND aqorders.orderstatus IN ( "new", "ordered", "partial" ) )
1795                 OR (
1796                     ( quantity > quantityreceived OR quantityreceived is NULL )
1797         };
1798
1799         if ( $ordered ) {
1800             $query .= q{ AND aqorders.orderstatus IN ( "ordered", "partial" )};
1801         }
1802         $query .= q{
1803                 )
1804             )
1805         };
1806     }
1807
1808     my $userenv = C4::Context->userenv;
1809     if ( C4::Context->preference("IndependentBranches") ) {
1810         unless ( C4::Context->IsSuperLibrarian() ) {
1811             $query .= q{
1812                 AND (
1813                     borrowers.branchcode = ?
1814                     OR borrowers.branchcode  = ''
1815                 )
1816             };
1817             push @args, $userenv->{branch};
1818         }
1819     }
1820
1821     if ( $ordernumber ) {
1822         $query .= ' AND ( aqorders.ordernumber = ? OR aqorders_transfers.ordernumber_from = ? ) ';
1823         push @args, ( $ordernumber, $ordernumber );
1824     }
1825     if ( $biblionumber ) {
1826         $query .= 'AND aqorders.biblionumber = ?';
1827         push @args, $biblionumber;
1828     }
1829     if( $search ) {
1830         $query .= ' AND (biblio.title LIKE ? OR biblio.author LIKE ? OR biblioitems.isbn LIKE ?)';
1831         push @args, ("%$search%","%$search%","%$search%");
1832     }
1833     if ( $ean ) {
1834         $query .= ' AND biblioitems.ean = ?';
1835         push @args, $ean;
1836     }
1837     if ( $booksellerid ) {
1838         $query .= 'AND aqbasket.booksellerid = ?';
1839         push @args, $booksellerid;
1840     }
1841     if( $basketno ) {
1842         $query .= 'AND aqbasket.basketno = ?';
1843         push @args, $basketno;
1844     }
1845     if( $basketname ) {
1846         $query .= 'AND aqbasket.basketname LIKE ?';
1847         push @args, "%$basketname%";
1848     }
1849     if( $basketgroupname ) {
1850         $query .= ' AND aqbasketgroups.name LIKE ?';
1851         push @args, "%$basketgroupname%";
1852     }
1853
1854     if ( $owner ) {
1855         $query .= ' AND aqbasket.authorisedby=? ';
1856         push @args, $userenv->{'number'};
1857     }
1858
1859     if ( $budget_id ) {
1860         $query .= ' AND aqorders.budget_id = ?';
1861         push @args, $budget_id;
1862     }
1863
1864     $query .= ' ORDER BY aqbasket.basketno';
1865
1866     my $sth = $dbh->prepare($query);
1867     $sth->execute(@args);
1868     return $sth->fetchall_arrayref({});
1869 }
1870
1871 #------------------------------------------------------------#
1872
1873 =head3 DelOrder
1874
1875   &DelOrder($biblionumber, $ordernumber);
1876
1877 Cancel the order with the given order and biblio numbers. It does not
1878 delete any entries in the aqorders table, it merely marks them as
1879 cancelled.
1880
1881 =cut
1882
1883 sub DelOrder {
1884     my ( $bibnum, $ordernumber, $delete_biblio, $reason ) = @_;
1885
1886     my $error;
1887     my $dbh = C4::Context->dbh;
1888     my $query = "
1889         UPDATE aqorders
1890         SET    datecancellationprinted=now(), orderstatus='cancelled'
1891     ";
1892     if($reason) {
1893         $query .= ", cancellationreason = ? ";
1894     }
1895     $query .= "
1896         WHERE biblionumber=? AND ordernumber=?
1897     ";
1898     my $sth = $dbh->prepare($query);
1899     if($reason) {
1900         $sth->execute($reason, $bibnum, $ordernumber);
1901     } else {
1902         $sth->execute( $bibnum, $ordernumber );
1903     }
1904     $sth->finish;
1905
1906     my $order = Koha::Acquisition::Orders->find($ordernumber);
1907     my $items = $order->items;
1908     while ( my $item = $items->next ) { # Should be moved to Koha::Acquisition::Order->delete
1909         my $delcheck = C4::Items::DelItemCheck( $bibnum, $item->itemnumber );
1910
1911         if($delcheck != 1) {
1912             $error->{'delitem'} = 1;
1913         }
1914     }
1915
1916     if($delete_biblio) {
1917         # We get the number of remaining items
1918         my $biblio = Koha::Biblios->find( $bibnum );
1919         my $itemcount = $biblio->items->count;
1920
1921         # If there are no items left,
1922         if ( $itemcount == 0 ) {
1923             # We delete the record
1924             my $delcheck = DelBiblio($bibnum);
1925
1926             if($delcheck) {
1927                 $error->{'delbiblio'} = 1;
1928             }
1929         }
1930     }
1931
1932     return $error;
1933 }
1934
1935 =head3 TransferOrder
1936
1937     my $newordernumber = TransferOrder($ordernumber, $basketno);
1938
1939 Transfer an order line to a basket.
1940 Mark $ordernumber as cancelled with an internal note 'Cancelled and transferred
1941 to BOOKSELLER on DATE' and create new order with internal note
1942 'Transferred from BOOKSELLER on DATE'.
1943 Move all attached items to the new order.
1944 Received orders cannot be transferred.
1945 Return the ordernumber of created order.
1946
1947 =cut
1948
1949 sub TransferOrder {
1950     my ($ordernumber, $basketno) = @_;
1951
1952     return unless ($ordernumber and $basketno);
1953
1954     my $order = Koha::Acquisition::Orders->find( $ordernumber ) or return;
1955     return if $order->datereceived;
1956
1957     $order = $order->unblessed;
1958
1959     my $basket = GetBasket($basketno);
1960     return unless $basket;
1961
1962     my $dbh = C4::Context->dbh;
1963     my ($query, $sth, $rv);
1964
1965     $query = q{
1966         UPDATE aqorders
1967         SET datecancellationprinted = CAST(NOW() AS date), orderstatus = ?
1968         WHERE ordernumber = ?
1969     };
1970     $sth = $dbh->prepare($query);
1971     $rv = $sth->execute('cancelled', $ordernumber);
1972
1973     delete $order->{'ordernumber'};
1974     delete $order->{parent_ordernumber};
1975     $order->{'basketno'} = $basketno;
1976
1977     my $newordernumber = Koha::Acquisition::Order->new($order)->store->ordernumber;
1978
1979     $query = q{
1980         UPDATE aqorders_items
1981         SET ordernumber = ?
1982         WHERE ordernumber = ?
1983     };
1984     $sth = $dbh->prepare($query);
1985     $sth->execute($newordernumber, $ordernumber);
1986
1987     $query = q{
1988         INSERT INTO aqorders_transfers (ordernumber_from, ordernumber_to)
1989         VALUES (?, ?)
1990     };
1991     $sth = $dbh->prepare($query);
1992     $sth->execute($ordernumber, $newordernumber);
1993
1994     return $newordernumber;
1995 }
1996
1997 =head2 FUNCTIONS ABOUT PARCELS
1998
1999 =head3 GetParcels
2000
2001   $results = &GetParcels($bookseller, $order, $code, $datefrom, $dateto);
2002
2003 get a lists of parcels.
2004
2005 * Input arg :
2006
2007 =over
2008
2009 =item $bookseller
2010 is the bookseller this function has to get parcels.
2011
2012 =item $order
2013 To know on what criteria the results list has to be ordered.
2014
2015 =item $code
2016 is the booksellerinvoicenumber.
2017
2018 =item $datefrom & $dateto
2019 to know on what date this function has to filter its search.
2020
2021 =back
2022
2023 * return:
2024 a pointer on a hash list containing parcel informations as such :
2025
2026 =over
2027
2028 =item Creation date
2029
2030 =item Last operation
2031
2032 =item Number of biblio
2033
2034 =item Number of items
2035
2036 =back
2037
2038 =cut
2039
2040 sub GetParcels {
2041     my ($bookseller,$order, $code, $datefrom, $dateto) = @_;
2042     my $dbh    = C4::Context->dbh;
2043     my @query_params = ();
2044     my $strsth ="
2045         SELECT  aqinvoices.invoicenumber,
2046                 datereceived,purchaseordernumber,
2047                 count(DISTINCT biblionumber) AS biblio,
2048                 sum(quantity) AS itemsexpected,
2049                 sum(quantityreceived) AS itemsreceived
2050         FROM   aqorders LEFT JOIN aqbasket ON aqbasket.basketno = aqorders.basketno
2051         LEFT JOIN aqinvoices ON aqorders.invoiceid = aqinvoices.invoiceid
2052         WHERE aqbasket.booksellerid = ? and datereceived IS NOT NULL
2053     ";
2054     push @query_params, $bookseller;
2055
2056     if ( defined $code ) {
2057         $strsth .= ' and aqinvoices.invoicenumber like ? ';
2058         # add a % to the end of the code to allow stemming.
2059         push @query_params, "$code%";
2060     }
2061
2062     if ( defined $datefrom ) {
2063         $strsth .= ' and datereceived >= ? ';
2064         push @query_params, $datefrom;
2065     }
2066
2067     if ( defined $dateto ) {
2068         $strsth .=  'and datereceived <= ? ';
2069         push @query_params, $dateto;
2070     }
2071
2072     $strsth .= "group by aqinvoices.invoicenumber,datereceived ";
2073
2074     # can't use a placeholder to place this column name.
2075     # but, we could probably be checking to make sure it is a column that will be fetched.
2076     $strsth .= "order by $order " if ($order);
2077
2078     my $sth = $dbh->prepare($strsth);
2079
2080     $sth->execute( @query_params );
2081     my $results = $sth->fetchall_arrayref({});
2082     return @{$results};
2083 }
2084
2085 #------------------------------------------------------------#
2086
2087 =head3 GetLateOrders
2088
2089   @results = &GetLateOrders;
2090
2091 Searches for bookseller with late orders.
2092
2093 return:
2094 the table of supplier with late issues. This table is full of hashref.
2095
2096 =cut
2097
2098 sub GetLateOrders {
2099     my $delay      = shift;
2100     my $supplierid = shift;
2101     my $branch     = shift;
2102     my $estimateddeliverydatefrom = shift;
2103     my $estimateddeliverydateto = shift;
2104
2105     my $dbh = C4::Context->dbh;
2106
2107     #BEWARE, order of parenthesis and LEFT JOIN is important for speed
2108     my $dbdriver = C4::Context->config("db_scheme") || "mysql";
2109
2110     my @query_params = ();
2111     my $select = "
2112     SELECT aqbasket.basketno,
2113         aqorders.ordernumber,
2114         DATE(aqbasket.closedate)  AS orderdate,
2115         aqbasket.basketname       AS basketname,
2116         aqbasket.basketgroupid    AS basketgroupid,
2117         aqbasketgroups.name       AS basketgroupname,
2118         aqorders.rrp              AS unitpricesupplier,
2119         aqorders.ecost            AS unitpricelib,
2120         aqorders.claims_count     AS claims_count,
2121         aqorders.claimed_date     AS claimed_date,
2122         aqbudgets.budget_name     AS budget,
2123         borrowers.branchcode      AS branch,
2124         aqbooksellers.name        AS supplier,
2125         aqbooksellers.id          AS supplierid,
2126         biblio.author, biblio.title,
2127         biblioitems.publishercode AS publisher,
2128         biblioitems.publicationyear,
2129         ADDDATE(aqbasket.closedate, INTERVAL aqbooksellers.deliverytime DAY) AS estimateddeliverydate,
2130     ";
2131     my $from = "
2132     FROM
2133         aqorders LEFT JOIN biblio     ON biblio.biblionumber         = aqorders.biblionumber
2134         LEFT JOIN biblioitems         ON biblioitems.biblionumber    = biblio.biblionumber
2135         LEFT JOIN aqbudgets           ON aqorders.budget_id          = aqbudgets.budget_id,
2136         aqbasket LEFT JOIN borrowers  ON aqbasket.authorisedby       = borrowers.borrowernumber
2137         LEFT JOIN aqbooksellers       ON aqbasket.booksellerid       = aqbooksellers.id
2138         LEFT JOIN aqbasketgroups      ON aqbasket.basketgroupid      = aqbasketgroups.id
2139         WHERE aqorders.basketno = aqbasket.basketno
2140         AND ( datereceived = ''
2141             OR datereceived IS NULL
2142             OR aqorders.quantityreceived < aqorders.quantity
2143         )
2144         AND aqbasket.closedate IS NOT NULL
2145         AND (aqorders.datecancellationprinted IS NULL OR aqorders.datecancellationprinted='0000-00-00')
2146     ";
2147     if ($dbdriver eq "mysql") {
2148         $select .= "
2149         aqorders.quantity - COALESCE(aqorders.quantityreceived,0)                 AS quantity,
2150         (aqorders.quantity - COALESCE(aqorders.quantityreceived,0)) * aqorders.rrp AS subtotal,
2151         DATEDIFF(CAST(now() AS date),closedate) AS latesince
2152         ";
2153         if ( defined $delay ) {
2154             $from .= " AND (closedate <= DATE_SUB(CAST(now() AS date),INTERVAL ? DAY)) " ;
2155             push @query_params, $delay;
2156         }
2157         $from .= " AND aqorders.quantity - COALESCE(aqorders.quantityreceived,0) <> 0";
2158     } else {
2159         # FIXME: account for IFNULL as above
2160         $select .= "
2161                 aqorders.quantity                AS quantity,
2162                 aqorders.quantity * aqorders.rrp AS subtotal,
2163                 (CAST(now() AS date) - closedate)            AS latesince
2164         ";
2165         if ( defined $delay ) {
2166             $from .= " AND (closedate <= (CAST(now() AS date) -(INTERVAL ? DAY)) ";
2167             push @query_params, $delay;
2168         }
2169         $from .= " AND aqorders.quantity <> 0";
2170     }
2171     if (defined $supplierid) {
2172         $from .= ' AND aqbasket.booksellerid = ? ';
2173         push @query_params, $supplierid;
2174     }
2175     if (defined $branch) {
2176         $from .= ' AND borrowers.branchcode LIKE ? ';
2177         push @query_params, $branch;
2178     }
2179
2180     if ( defined $estimateddeliverydatefrom or defined $estimateddeliverydateto ) {
2181         $from .= ' AND aqbooksellers.deliverytime IS NOT NULL ';
2182     }
2183     if ( defined $estimateddeliverydatefrom ) {
2184         $from .= ' AND ADDDATE(aqbasket.closedate, INTERVAL aqbooksellers.deliverytime DAY) >= ?';
2185         push @query_params, $estimateddeliverydatefrom;
2186     }
2187     if ( defined $estimateddeliverydateto ) {
2188         $from .= ' AND ADDDATE(aqbasket.closedate, INTERVAL aqbooksellers.deliverytime DAY) <= ?';
2189         push @query_params, $estimateddeliverydateto;
2190     }
2191     if ( defined $estimateddeliverydatefrom and not defined $estimateddeliverydateto ) {
2192         $from .= ' AND ADDDATE(aqbasket.closedate, INTERVAL aqbooksellers.deliverytime DAY) <= CAST(now() AS date)';
2193     }
2194     if (C4::Context->preference("IndependentBranches")
2195             && !C4::Context->IsSuperLibrarian() ) {
2196         $from .= ' AND borrowers.branchcode LIKE ? ';
2197         push @query_params, C4::Context->userenv->{branch};
2198     }
2199     $from .= " AND orderstatus <> 'cancelled' ";
2200     my $query = "$select $from \nORDER BY latesince, basketno, borrowers.branchcode, supplier";
2201     $debug and print STDERR "GetLateOrders query: $query\nGetLateOrders args: " . join(" ",@query_params);
2202     my $sth = $dbh->prepare($query);
2203     $sth->execute(@query_params);
2204     my @results;
2205     while (my $data = $sth->fetchrow_hashref) {
2206         push @results, $data;
2207     }
2208     return @results;
2209 }
2210
2211 #------------------------------------------------------------#
2212
2213 =head3 GetHistory
2214
2215   \@order_loop = GetHistory( %params );
2216
2217 Retreives some acquisition history information
2218
2219 params:
2220   title
2221   author
2222   name
2223   isbn
2224   ean
2225   from_placed_on
2226   to_placed_on
2227   basket                  - search both basket name and number
2228   booksellerinvoicenumber
2229   basketgroupname
2230   budget
2231   orderstatus (note that orderstatus '' will retrieve orders
2232                of any status except cancelled)
2233   biblionumber
2234   get_canceled_order (if set to a true value, cancelled orders will
2235                       be included)
2236
2237 returns:
2238     $order_loop is a list of hashrefs that each look like this:
2239             {
2240                 'author'           => 'Twain, Mark',
2241                 'basketno'         => '1',
2242                 'biblionumber'     => '215',
2243                 'count'            => 1,
2244                 'creationdate'     => 'MM/DD/YYYY',
2245                 'datereceived'     => undef,
2246                 'ecost'            => '1.00',
2247                 'id'               => '1',
2248                 'invoicenumber'    => undef,
2249                 'name'             => '',
2250                 'ordernumber'      => '1',
2251                 'quantity'         => 1,
2252                 'quantityreceived' => undef,
2253                 'title'            => 'The Adventures of Huckleberry Finn'
2254             }
2255
2256 =cut
2257
2258 sub GetHistory {
2259 # don't run the query if there are no parameters (list would be too long for sure !)
2260     croak "No search params" unless @_;
2261     my %params = @_;
2262     my $title = $params{title};
2263     my $author = $params{author};
2264     my $isbn   = $params{isbn};
2265     my $ean    = $params{ean};
2266     my $name = $params{name};
2267     my $from_placed_on = $params{from_placed_on};
2268     my $to_placed_on = $params{to_placed_on};
2269     my $basket = $params{basket};
2270     my $booksellerinvoicenumber = $params{booksellerinvoicenumber};
2271     my $basketgroupname = $params{basketgroupname};
2272     my $budget = $params{budget};
2273     my $orderstatus = $params{orderstatus};
2274     my $biblionumber = $params{biblionumber};
2275     my $get_canceled_order = $params{get_canceled_order} || 0;
2276     my $ordernumber = $params{ordernumber};
2277     my $search_children_too = $params{search_children_too} || 0;
2278     my $created_by = $params{created_by} || [];
2279     my $ordernumbers = $params{ordernumbers} || [];
2280
2281     my @order_loop;
2282     my $total_qty         = 0;
2283     my $total_qtyreceived = 0;
2284     my $total_price       = 0;
2285
2286     #get variation of isbn
2287     my @isbn_params;
2288     my @isbns;
2289     if ($isbn){
2290         if ( C4::Context->preference("SearchWithISBNVariations") ){
2291             @isbns = C4::Koha::GetVariationsOfISBN( $isbn );
2292             foreach my $isb (@isbns){
2293                 push @isbn_params, '?';
2294             }
2295         }
2296         unless (@isbns){
2297             push @isbns, $isbn;
2298             push @isbn_params, '?';
2299         }
2300     }
2301
2302     my $dbh   = C4::Context->dbh;
2303     my $query ="
2304         SELECT
2305             COALESCE(biblio.title,     deletedbiblio.title)     AS title,
2306             COALESCE(biblio.author,    deletedbiblio.author)    AS author,
2307             COALESCE(biblioitems.isbn, deletedbiblioitems.isbn) AS isbn,
2308             COALESCE(biblioitems.ean,  deletedbiblioitems.ean)  AS ean,
2309             aqorders.basketno,
2310             aqbasket.basketname,
2311             aqbasket.basketgroupid,
2312             aqbasket.authorisedby,
2313             concat( borrowers.firstname,' ',borrowers.surname) AS authorisedbyname,
2314             aqbasketgroups.name as groupname,
2315             aqbooksellers.name,
2316             aqbasket.creationdate,
2317             aqorders.datereceived,
2318             aqorders.quantity,
2319             aqorders.quantityreceived,
2320             aqorders.ecost,
2321             aqorders.ordernumber,
2322             aqorders.invoiceid,
2323             aqinvoices.invoicenumber,
2324             aqbooksellers.id as id,
2325             aqorders.biblionumber,
2326             aqorders.orderstatus,
2327             aqorders.parent_ordernumber,
2328             aqbudgets.budget_name
2329             ";
2330     $query .= ", aqbudgets.budget_id AS budget" if defined $budget;
2331     $query .= "
2332         FROM aqorders
2333         LEFT JOIN aqbasket ON aqorders.basketno=aqbasket.basketno
2334         LEFT JOIN aqbasketgroups ON aqbasket.basketgroupid=aqbasketgroups.id
2335         LEFT JOIN aqbooksellers ON aqbasket.booksellerid=aqbooksellers.id
2336         LEFT JOIN biblioitems ON biblioitems.biblionumber=aqorders.biblionumber
2337         LEFT JOIN biblio ON biblio.biblionumber=aqorders.biblionumber
2338         LEFT JOIN aqbudgets ON aqorders.budget_id=aqbudgets.budget_id
2339         LEFT JOIN aqinvoices ON aqorders.invoiceid = aqinvoices.invoiceid
2340         LEFT JOIN deletedbiblio ON deletedbiblio.biblionumber=aqorders.biblionumber
2341         LEFT JOIN deletedbiblioitems ON deletedbiblioitems.biblionumber=aqorders.biblionumber
2342         LEFT JOIN borrowers ON aqbasket.authorisedby=borrowers.borrowernumber
2343         ";
2344
2345     $query .= " WHERE 1 ";
2346
2347     unless ($get_canceled_order or (defined $orderstatus and $orderstatus eq 'cancelled')) {
2348         $query .= " AND (datecancellationprinted is NULL or datecancellationprinted='0000-00-00') ";
2349     }
2350
2351     my @query_params  = ();
2352
2353     if ( $biblionumber ) {
2354         $query .= " AND biblio.biblionumber = ?";
2355         push @query_params, $biblionumber;
2356     }
2357
2358     if ( $title ) {
2359         $query .= " AND biblio.title LIKE ? ";
2360         $title =~ s/\s+/%/g;
2361         push @query_params, "%$title%";
2362     }
2363
2364     if ( $author ) {
2365         $query .= " AND biblio.author LIKE ? ";
2366         push @query_params, "%$author%";
2367     }
2368
2369     if ( @isbns ) {
2370         $query .= " AND ( biblioitems.isbn LIKE " . join (" OR biblioitems.isbn LIKE ", @isbn_params ) . ")";
2371         foreach my $isb (@isbns){
2372             push @query_params, "%$isb%";
2373         }
2374     }
2375
2376     if ( $ean ) {
2377         $query .= " AND biblioitems.ean = ? ";
2378         push @query_params, "$ean";
2379     }
2380     if ( $name ) {
2381         $query .= " AND aqbooksellers.name LIKE ? ";
2382         push @query_params, "%$name%";
2383     }
2384
2385     if ( $budget ) {
2386         $query .= " AND aqbudgets.budget_id = ? ";
2387         push @query_params, "$budget";
2388     }
2389
2390     if ( $from_placed_on ) {
2391         $query .= " AND creationdate >= ? ";
2392         push @query_params, $from_placed_on;
2393     }
2394
2395     if ( $to_placed_on ) {
2396         $query .= " AND creationdate <= ? ";
2397         push @query_params, $to_placed_on;
2398     }
2399
2400     if ( defined $orderstatus and $orderstatus ne '') {
2401         $query .= " AND aqorders.orderstatus = ? ";
2402         push @query_params, "$orderstatus";
2403     }
2404
2405     if ($basket) {
2406         if ($basket =~ m/^\d+$/) {
2407             $query .= " AND aqorders.basketno = ? ";
2408             push @query_params, $basket;
2409         } else {
2410             $query .= " AND aqbasket.basketname LIKE ? ";
2411             push @query_params, "%$basket%";
2412         }
2413     }
2414
2415     if ($booksellerinvoicenumber) {
2416         $query .= " AND aqinvoices.invoicenumber LIKE ? ";
2417         push @query_params, "%$booksellerinvoicenumber%";
2418     }
2419
2420     if ($basketgroupname) {
2421         $query .= " AND aqbasketgroups.name LIKE ? ";
2422         push @query_params, "%$basketgroupname%";
2423     }
2424
2425     if ($ordernumber) {
2426         $query .= " AND (aqorders.ordernumber = ? ";
2427         push @query_params, $ordernumber;
2428         if ($search_children_too) {
2429             $query .= " OR aqorders.parent_ordernumber = ? ";
2430             push @query_params, $ordernumber;
2431         }
2432         $query .= ") ";
2433     }
2434
2435     if ( @$created_by ) {
2436         $query .= ' AND aqbasket.authorisedby IN ( ' . join( ',', ('?') x @$created_by ) . ')';
2437         push @query_params, @$created_by;
2438     }
2439
2440     if ( @$ordernumbers ) {
2441         $query .= ' AND (aqorders.ordernumber IN ( ' . join (',', ('?') x @$ordernumbers ) . '))';
2442         push @query_params, @$ordernumbers;
2443     }
2444
2445     if ( C4::Context->preference("IndependentBranches") ) {
2446         unless ( C4::Context->IsSuperLibrarian() ) {
2447             $query .= " AND (borrowers.branchcode = ? OR borrowers.branchcode ='' ) ";
2448             push @query_params, C4::Context->userenv->{branch};
2449         }
2450     }
2451     $query .= " ORDER BY id";
2452
2453     return $dbh->selectall_arrayref( $query, { Slice => {} }, @query_params );
2454 }
2455
2456 =head2 GetRecentAcqui
2457
2458   $results = GetRecentAcqui($days);
2459
2460 C<$results> is a ref to a table which contains hashref
2461
2462 =cut
2463
2464 sub GetRecentAcqui {
2465     my $limit  = shift;
2466     my $dbh    = C4::Context->dbh;
2467     my $query = "
2468         SELECT *
2469         FROM   biblio
2470         ORDER BY timestamp DESC
2471         LIMIT  0,".$limit;
2472
2473     my $sth = $dbh->prepare($query);
2474     $sth->execute;
2475     my $results = $sth->fetchall_arrayref({});
2476     return $results;
2477 }
2478
2479 #------------------------------------------------------------#
2480
2481 =head3 AddClaim
2482
2483   &AddClaim($ordernumber);
2484
2485 Add a claim for an order
2486
2487 =cut
2488
2489 sub AddClaim {
2490     my ($ordernumber) = @_;
2491     my $dbh          = C4::Context->dbh;
2492     my $query        = "
2493         UPDATE aqorders SET
2494             claims_count = claims_count + 1,
2495             claimed_date = CURDATE()
2496         WHERE ordernumber = ?
2497         ";
2498     my $sth = $dbh->prepare($query);
2499     $sth->execute($ordernumber);
2500 }
2501
2502 =head3 GetInvoices
2503
2504     my @invoices = GetInvoices(
2505         invoicenumber => $invoicenumber,
2506         supplierid => $supplierid,
2507         suppliername => $suppliername,
2508         shipmentdatefrom => $shipmentdatefrom, # ISO format
2509         shipmentdateto => $shipmentdateto, # ISO format
2510         billingdatefrom => $billingdatefrom, # ISO format
2511         billingdateto => $billingdateto, # ISO format
2512         isbneanissn => $isbn_or_ean_or_issn,
2513         title => $title,
2514         author => $author,
2515         publisher => $publisher,
2516         publicationyear => $publicationyear,
2517         branchcode => $branchcode,
2518         order_by => $order_by
2519     );
2520
2521 Return a list of invoices that match all given criteria.
2522
2523 $order_by is "column_name (asc|desc)", where column_name is any of
2524 'invoicenumber', 'booksellerid', 'shipmentdate', 'billingdate', 'closedate',
2525 'shipmentcost', 'shipmentcost_budgetid'.
2526
2527 asc is the default if omitted
2528
2529 =cut
2530
2531 sub GetInvoices {
2532     my %args = @_;
2533
2534     my @columns = qw(invoicenumber booksellerid shipmentdate billingdate
2535         closedate shipmentcost shipmentcost_budgetid);
2536
2537     my $dbh = C4::Context->dbh;
2538     my $query = qq{
2539         SELECT aqinvoices.invoiceid, aqinvoices.invoicenumber, aqinvoices.booksellerid, aqinvoices.shipmentdate, aqinvoices.billingdate, aqinvoices.closedate, aqinvoices.shipmentcost, aqinvoices.shipmentcost_budgetid, aqinvoices.message_id,
2540             aqbooksellers.name AS suppliername,
2541           COUNT(
2542             DISTINCT IF(
2543               aqorders.datereceived IS NOT NULL,
2544               aqorders.biblionumber,
2545               NULL
2546             )
2547           ) AS receivedbiblios,
2548           COUNT(
2549              DISTINCT IF(
2550               aqorders.subscriptionid IS NOT NULL,
2551               aqorders.subscriptionid,
2552               NULL
2553             )
2554           ) AS is_linked_to_subscriptions,
2555           SUM(aqorders.quantityreceived) AS receiveditems
2556         FROM aqinvoices
2557           LEFT JOIN aqbooksellers ON aqbooksellers.id = aqinvoices.booksellerid
2558           LEFT JOIN aqorders ON aqorders.invoiceid = aqinvoices.invoiceid
2559           LEFT JOIN aqbasket ON aqbasket.basketno=aqorders.basketno
2560           LEFT JOIN borrowers ON aqbasket.authorisedby=borrowers.borrowernumber
2561           LEFT JOIN biblio ON aqorders.biblionumber = biblio.biblionumber
2562           LEFT JOIN biblioitems ON biblio.biblionumber = biblioitems.biblionumber
2563           LEFT JOIN subscription ON biblio.biblionumber = subscription.biblionumber
2564     };
2565
2566     my @bind_args;
2567     my @bind_strs;
2568     if($args{supplierid}) {
2569         push @bind_strs, " aqinvoices.booksellerid = ? ";
2570         push @bind_args, $args{supplierid};
2571     }
2572     if($args{invoicenumber}) {
2573         push @bind_strs, " aqinvoices.invoicenumber LIKE ? ";
2574         push @bind_args, "%$args{invoicenumber}%";
2575     }
2576     if($args{suppliername}) {
2577         push @bind_strs, " aqbooksellers.name LIKE ? ";
2578         push @bind_args, "%$args{suppliername}%";
2579     }
2580     if($args{shipmentdatefrom}) {
2581         push @bind_strs, " aqinvoices.shipmentdate >= ? ";
2582         push @bind_args, $args{shipmentdatefrom};
2583     }
2584     if($args{shipmentdateto}) {
2585         push @bind_strs, " aqinvoices.shipmentdate <= ? ";
2586         push @bind_args, $args{shipmentdateto};
2587     }
2588     if($args{billingdatefrom}) {
2589         push @bind_strs, " aqinvoices.billingdate >= ? ";
2590         push @bind_args, $args{billingdatefrom};
2591     }
2592     if($args{billingdateto}) {
2593         push @bind_strs, " aqinvoices.billingdate <= ? ";
2594         push @bind_args, $args{billingdateto};
2595     }
2596     if($args{isbneanissn}) {
2597         push @bind_strs, " (biblioitems.isbn LIKE CONCAT('%', ?, '%') OR biblioitems.ean LIKE CONCAT('%', ?, '%') OR biblioitems.issn LIKE CONCAT('%', ?, '%') ) ";
2598         push @bind_args, $args{isbneanissn}, $args{isbneanissn}, $args{isbneanissn};
2599     }
2600     if($args{title}) {
2601         push @bind_strs, " biblio.title LIKE CONCAT('%', ?, '%') ";
2602         push @bind_args, $args{title};
2603     }
2604     if($args{author}) {
2605         push @bind_strs, " biblio.author LIKE CONCAT('%', ?, '%') ";
2606         push @bind_args, $args{author};
2607     }
2608     if($args{publisher}) {
2609         push @bind_strs, " biblioitems.publishercode LIKE CONCAT('%', ?, '%') ";
2610         push @bind_args, $args{publisher};
2611     }
2612     if($args{publicationyear}) {
2613         push @bind_strs, " ((biblioitems.publicationyear LIKE CONCAT('%', ?, '%')) OR (biblio.copyrightdate LIKE CONCAT('%', ?, '%'))) ";
2614         push @bind_args, $args{publicationyear}, $args{publicationyear};
2615     }
2616     if($args{branchcode}) {
2617         push @bind_strs, " borrowers.branchcode = ? ";
2618         push @bind_args, $args{branchcode};
2619     }
2620     if($args{message_id}) {
2621         push @bind_strs, " aqinvoices.message_id = ? ";
2622         push @bind_args, $args{message_id};
2623     }
2624
2625     $query .= " WHERE " . join(" AND ", @bind_strs) if @bind_strs;
2626     $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";
2627
2628     if($args{order_by}) {
2629         my ($column, $direction) = split / /, $args{order_by};
2630         if(grep /^$column$/, @columns) {
2631             $direction ||= 'ASC';
2632             $query .= " ORDER BY $column $direction";
2633         }
2634     }
2635
2636     my $sth = $dbh->prepare($query);
2637     $sth->execute(@bind_args);
2638
2639     my $results = $sth->fetchall_arrayref({});
2640     return @$results;
2641 }
2642
2643 =head3 GetInvoice
2644
2645     my $invoice = GetInvoice($invoiceid);
2646
2647 Get informations about invoice with given $invoiceid
2648
2649 Return a hash filled with aqinvoices.* fields
2650
2651 =cut
2652
2653 sub GetInvoice {
2654     my ($invoiceid) = @_;
2655     my $invoice;
2656
2657     return unless $invoiceid;
2658
2659     my $dbh = C4::Context->dbh;
2660     my $query = qq{
2661         SELECT *
2662         FROM aqinvoices
2663         WHERE invoiceid = ?
2664     };
2665     my $sth = $dbh->prepare($query);
2666     $sth->execute($invoiceid);
2667
2668     $invoice = $sth->fetchrow_hashref;
2669     return $invoice;
2670 }
2671
2672 =head3 GetInvoiceDetails
2673
2674     my $invoice = GetInvoiceDetails($invoiceid)
2675
2676 Return informations about an invoice + the list of related order lines
2677
2678 Orders informations are in $invoice->{orders} (array ref)
2679
2680 =cut
2681
2682 sub GetInvoiceDetails {
2683     my ($invoiceid) = @_;
2684
2685     if ( !defined $invoiceid ) {
2686         carp 'GetInvoiceDetails called without an invoiceid';
2687         return;
2688     }
2689
2690     my $dbh = C4::Context->dbh;
2691     my $query = q{
2692         SELECT aqinvoices.*, aqbooksellers.name AS suppliername
2693         FROM aqinvoices
2694           LEFT JOIN aqbooksellers ON aqinvoices.booksellerid = aqbooksellers.id
2695         WHERE invoiceid = ?
2696     };
2697     my $sth = $dbh->prepare($query);
2698     $sth->execute($invoiceid);
2699
2700     my $invoice = $sth->fetchrow_hashref;
2701
2702     $query = q{
2703         SELECT aqorders.*,
2704                 biblio.*,
2705                 biblio.copyrightdate,
2706                 biblioitems.isbn,
2707                 biblioitems.publishercode,
2708                 biblioitems.publicationyear,
2709                 aqbasket.basketname,
2710                 aqbasketgroups.id AS basketgroupid,
2711                 aqbasketgroups.name AS basketgroupname
2712         FROM aqorders
2713           LEFT JOIN aqbasket ON aqorders.basketno = aqbasket.basketno
2714           LEFT JOIN aqbasketgroups ON aqbasket.basketgroupid = aqbasketgroups.id
2715           LEFT JOIN biblio ON aqorders.biblionumber = biblio.biblionumber
2716           LEFT JOIN biblioitems ON aqorders.biblionumber = biblioitems.biblionumber
2717         WHERE invoiceid = ?
2718     };
2719     $sth = $dbh->prepare($query);
2720     $sth->execute($invoiceid);
2721     $invoice->{orders} = $sth->fetchall_arrayref({});
2722     $invoice->{orders} ||= []; # force an empty arrayref if fetchall_arrayref fails
2723
2724     return $invoice;
2725 }
2726
2727 =head3 AddInvoice
2728
2729     my $invoiceid = AddInvoice(
2730         invoicenumber => $invoicenumber,
2731         booksellerid => $booksellerid,
2732         shipmentdate => $shipmentdate,
2733         billingdate => $billingdate,
2734         closedate => $closedate,
2735         shipmentcost => $shipmentcost,
2736         shipmentcost_budgetid => $shipmentcost_budgetid
2737     );
2738
2739 Create a new invoice and return its id or undef if it fails.
2740
2741 =cut
2742
2743 sub AddInvoice {
2744     my %invoice = @_;
2745
2746     return unless(%invoice and $invoice{invoicenumber});
2747
2748     my @columns = qw(invoicenumber booksellerid shipmentdate billingdate
2749         closedate shipmentcost shipmentcost_budgetid message_id);
2750
2751     my @set_strs;
2752     my @set_args;
2753     foreach my $key (keys %invoice) {
2754         if(0 < grep(/^$key$/, @columns)) {
2755             push @set_strs, "$key = ?";
2756             push @set_args, ($invoice{$key} || undef);
2757         }
2758     }
2759
2760     my $rv;
2761     if(@set_args > 0) {
2762         my $dbh = C4::Context->dbh;
2763         my $query = "INSERT INTO aqinvoices SET ";
2764         $query .= join (",", @set_strs);
2765         my $sth = $dbh->prepare($query);
2766         $rv = $sth->execute(@set_args);
2767         if($rv) {
2768             $rv = $dbh->last_insert_id(undef, undef, 'aqinvoices', undef);
2769         }
2770     }
2771     return $rv;
2772 }
2773
2774 =head3 ModInvoice
2775
2776     ModInvoice(
2777         invoiceid => $invoiceid,    # Mandatory
2778         invoicenumber => $invoicenumber,
2779         booksellerid => $booksellerid,
2780         shipmentdate => $shipmentdate,
2781         billingdate => $billingdate,
2782         closedate => $closedate,
2783         shipmentcost => $shipmentcost,
2784         shipmentcost_budgetid => $shipmentcost_budgetid
2785     );
2786
2787 Modify an invoice, invoiceid is mandatory.
2788
2789 Return undef if it fails.
2790
2791 =cut
2792
2793 sub ModInvoice {
2794     my %invoice = @_;
2795
2796     return unless(%invoice and $invoice{invoiceid});
2797
2798     my @columns = qw(invoicenumber booksellerid shipmentdate billingdate
2799         closedate shipmentcost shipmentcost_budgetid);
2800
2801     my @set_strs;
2802     my @set_args;
2803     foreach my $key (keys %invoice) {
2804         if(0 < grep(/^$key$/, @columns)) {
2805             push @set_strs, "$key = ?";
2806             push @set_args, ($invoice{$key} || undef);
2807         }
2808     }
2809
2810     my $dbh = C4::Context->dbh;
2811     my $query = "UPDATE aqinvoices SET ";
2812     $query .= join(",", @set_strs);
2813     $query .= " WHERE invoiceid = ?";
2814
2815     my $sth = $dbh->prepare($query);
2816     $sth->execute(@set_args, $invoice{invoiceid});
2817 }
2818
2819 =head3 CloseInvoice
2820
2821     CloseInvoice($invoiceid);
2822
2823 Close an invoice.
2824
2825 Equivalent to ModInvoice(invoiceid => $invoiceid, closedate => undef);
2826
2827 =cut
2828
2829 sub CloseInvoice {
2830     my ($invoiceid) = @_;
2831
2832     return unless $invoiceid;
2833
2834     my $dbh = C4::Context->dbh;
2835     my $query = qq{
2836         UPDATE aqinvoices
2837         SET closedate = CAST(NOW() AS DATE)
2838         WHERE invoiceid = ?
2839     };
2840     my $sth = $dbh->prepare($query);
2841     $sth->execute($invoiceid);
2842 }
2843
2844 =head3 ReopenInvoice
2845
2846     ReopenInvoice($invoiceid);
2847
2848 Reopen an invoice
2849
2850 Equivalent to ModInvoice(invoiceid => $invoiceid, closedate => output_pref({ dt=>dt_from_string, dateonly=>1, otputpref=>'iso' }))
2851
2852 =cut
2853
2854 sub ReopenInvoice {
2855     my ($invoiceid) = @_;
2856
2857     return unless $invoiceid;
2858
2859     my $dbh = C4::Context->dbh;
2860     my $query = qq{
2861         UPDATE aqinvoices
2862         SET closedate = NULL
2863         WHERE invoiceid = ?
2864     };
2865     my $sth = $dbh->prepare($query);
2866     $sth->execute($invoiceid);
2867 }
2868
2869 =head3 DelInvoice
2870
2871     DelInvoice($invoiceid);
2872
2873 Delete an invoice if there are no items attached to it.
2874
2875 =cut
2876
2877 sub DelInvoice {
2878     my ($invoiceid) = @_;
2879
2880     return unless $invoiceid;
2881
2882     my $dbh   = C4::Context->dbh;
2883     my $query = qq{
2884         SELECT COUNT(*)
2885         FROM aqorders
2886         WHERE invoiceid = ?
2887     };
2888     my $sth = $dbh->prepare($query);
2889     $sth->execute($invoiceid);
2890     my $res = $sth->fetchrow_arrayref;
2891     if ( $res && $res->[0] == 0 ) {
2892         $query = qq{
2893             DELETE FROM aqinvoices
2894             WHERE invoiceid = ?
2895         };
2896         my $sth = $dbh->prepare($query);
2897         return ( $sth->execute($invoiceid) > 0 );
2898     }
2899     return;
2900 }
2901
2902 =head3 MergeInvoices
2903
2904     MergeInvoices($invoiceid, \@sourceids);
2905
2906 Merge the invoices identified by the IDs in \@sourceids into
2907 the invoice identified by $invoiceid.
2908
2909 =cut
2910
2911 sub MergeInvoices {
2912     my ($invoiceid, $sourceids) = @_;
2913
2914     return unless $invoiceid;
2915     foreach my $sourceid (@$sourceids) {
2916         next if $sourceid == $invoiceid;
2917         my $source = GetInvoiceDetails($sourceid);
2918         foreach my $order (@{$source->{'orders'}}) {
2919             $order->{'invoiceid'} = $invoiceid;
2920             ModOrder($order);
2921         }
2922         DelInvoice($source->{'invoiceid'});
2923     }
2924     return;
2925 }
2926
2927 =head3 GetBiblioCountByBasketno
2928
2929 $biblio_count = &GetBiblioCountByBasketno($basketno);
2930
2931 Looks up the biblio's count that has basketno value $basketno
2932
2933 Returns a quantity
2934
2935 =cut
2936
2937 sub GetBiblioCountByBasketno {
2938     my ($basketno) = @_;
2939     my $dbh          = C4::Context->dbh;
2940     my $query        = "
2941         SELECT COUNT( DISTINCT( biblionumber ) )
2942         FROM   aqorders
2943         WHERE  basketno = ?
2944             AND (datecancellationprinted IS NULL OR datecancellationprinted='0000-00-00')
2945         ";
2946
2947     my $sth = $dbh->prepare($query);
2948     $sth->execute($basketno);
2949     return $sth->fetchrow;
2950 }
2951
2952 # Note this subroutine should be moved to Koha::Acquisition::Order
2953 # Will do when a DBIC decision will be taken.
2954 sub populate_order_with_prices {
2955     my ($params) = @_;
2956
2957     my $order        = $params->{order};
2958     my $booksellerid = $params->{booksellerid};
2959     return unless $booksellerid;
2960
2961     my $bookseller = Koha::Acquisition::Booksellers->find( $booksellerid );
2962
2963     my $receiving = $params->{receiving};
2964     my $ordering  = $params->{ordering};
2965     my $discount  = $order->{discount};
2966     $discount /= 100 if $discount > 1;
2967
2968     if ($ordering) {
2969         $order->{tax_rate_on_ordering} //= $order->{tax_rate};
2970         if ( $bookseller->listincgst ) {
2971             # The user entered the rrp tax included
2972             $order->{rrp_tax_included} = $order->{rrp};
2973
2974             # rrp tax excluded = rrp tax included / ( 1 + tax rate )
2975             $order->{rrp_tax_excluded} = $order->{rrp_tax_included} / ( 1 + $order->{tax_rate_on_ordering} );
2976
2977             # ecost tax excluded = rrp tax excluded * ( 1 - discount )
2978             $order->{ecost_tax_excluded} = $order->{rrp_tax_excluded} * ( 1 - $discount );
2979
2980             # ecost tax included = rrp tax included  ( 1 - discount )
2981             $order->{ecost_tax_included} = $order->{rrp_tax_included} * ( 1 - $discount );
2982         }
2983         else {
2984             # The user entered the rrp tax excluded
2985             $order->{rrp_tax_excluded} = $order->{rrp};
2986
2987             # rrp tax included = rrp tax excluded * ( 1 - tax rate )
2988             $order->{rrp_tax_included} = $order->{rrp_tax_excluded} * ( 1 + $order->{tax_rate_on_ordering} );
2989
2990             # ecost tax excluded = rrp tax excluded * ( 1 - discount )
2991             $order->{ecost_tax_excluded} = $order->{rrp_tax_excluded} * ( 1 - $discount );
2992
2993             # ecost tax included = rrp tax excluded * ( 1 + tax rate ) * ( 1 - discount )
2994             $order->{ecost_tax_included} =
2995                 $order->{rrp_tax_excluded} *
2996                 ( 1 + $order->{tax_rate_on_ordering} ) *
2997                 ( 1 - $discount );
2998         }
2999
3000         # tax value = quantity * ecost tax excluded * tax rate
3001         $order->{tax_value_on_ordering} =
3002             $order->{quantity} * $order->{ecost_tax_excluded} * $order->{tax_rate_on_ordering};
3003     }
3004
3005     if ($receiving) {
3006         $order->{tax_rate_on_receiving} //= $order->{tax_rate};
3007         if ( $bookseller->invoiceincgst ) {
3008             # Trick for unitprice. If the unit price rounded value is the same as the ecost rounded value
3009             # we need to keep the exact ecost value
3010             if ( Koha::Number::Price->new( $order->{unitprice} )->round == Koha::Number::Price->new( $order->{ecost_tax_included} )->round ) {
3011                 $order->{unitprice} = $order->{ecost_tax_included};
3012             }
3013
3014             # The user entered the unit price tax included
3015             $order->{unitprice_tax_included} = $order->{unitprice};
3016
3017             # unit price tax excluded = unit price tax included / ( 1 + tax rate )
3018             $order->{unitprice_tax_excluded} = $order->{unitprice_tax_included} / ( 1 + $order->{tax_rate_on_receiving} );
3019         }
3020         else {
3021             # Trick for unitprice. If the unit price rounded value is the same as the ecost rounded value
3022             # we need to keep the exact ecost value
3023             if ( Koha::Number::Price->new( $order->{unitprice} )->round == Koha::Number::Price->new( $order->{ecost_tax_excluded} )->round ) {
3024                 $order->{unitprice} = $order->{ecost_tax_excluded};
3025             }
3026
3027             # The user entered the unit price tax excluded
3028             $order->{unitprice_tax_excluded} = $order->{unitprice};
3029
3030
3031             # unit price tax included = unit price tax included * ( 1 + tax rate )
3032             $order->{unitprice_tax_included} = $order->{unitprice_tax_excluded} * ( 1 + $order->{tax_rate_on_receiving} );
3033         }
3034
3035         # tax value = quantity * unit price tax excluded * tax rate
3036         $order->{tax_value_on_receiving} = $order->{quantity} * $order->{unitprice_tax_excluded} * $order->{tax_rate_on_receiving};
3037     }
3038
3039     return $order;
3040 }
3041
3042 =head3 GetOrderUsers
3043
3044     $order_users_ids = &GetOrderUsers($ordernumber);
3045
3046 Returns a list of all borrowernumbers that are in order users list
3047
3048 =cut
3049
3050 sub GetOrderUsers {
3051     my ($ordernumber) = @_;
3052
3053     return unless $ordernumber;
3054
3055     my $query = q|
3056         SELECT borrowernumber
3057         FROM aqorder_users
3058         WHERE ordernumber = ?
3059     |;
3060     my $dbh = C4::Context->dbh;
3061     my $sth = $dbh->prepare($query);
3062     $sth->execute($ordernumber);
3063     my $results = $sth->fetchall_arrayref( {} );
3064
3065     my @borrowernumbers;
3066     foreach (@$results) {
3067         push @borrowernumbers, $_->{'borrowernumber'};
3068     }
3069
3070     return @borrowernumbers;
3071 }
3072
3073 =head3 ModOrderUsers
3074
3075     my @order_users_ids = (1, 2, 3);
3076     &ModOrderUsers($ordernumber, @basketusers_ids);
3077
3078 Delete all users from order users list, and add users in C<@order_users_ids>
3079 to this users list.
3080
3081 =cut
3082
3083 sub ModOrderUsers {
3084     my ( $ordernumber, @order_users_ids ) = @_;
3085
3086     return unless $ordernumber;
3087
3088     my $dbh   = C4::Context->dbh;
3089     my $query = q|
3090         DELETE FROM aqorder_users
3091         WHERE ordernumber = ?
3092     |;
3093     my $sth = $dbh->prepare($query);
3094     $sth->execute($ordernumber);
3095
3096     $query = q|
3097         INSERT INTO aqorder_users (ordernumber, borrowernumber)
3098         VALUES (?, ?)
3099     |;
3100     $sth = $dbh->prepare($query);
3101     foreach my $order_user_id (@order_users_ids) {
3102         $sth->execute( $ordernumber, $order_user_id );
3103     }
3104 }
3105
3106 sub NotifyOrderUsers {
3107     my ($ordernumber) = @_;
3108
3109     my @borrowernumbers = GetOrderUsers($ordernumber);
3110     return unless @borrowernumbers;
3111
3112     my $order = GetOrder( $ordernumber );
3113     for my $borrowernumber (@borrowernumbers) {
3114         my $patron = Koha::Patrons->find( $borrowernumber );
3115         my $library = $patron->library->unblessed;
3116         my $biblio = Koha::Biblios->find( $order->{biblionumber} )->unblessed;
3117         my $letter = C4::Letters::GetPreparedLetter(
3118             module      => 'acquisition',
3119             letter_code => 'ACQ_NOTIF_ON_RECEIV',
3120             branchcode  => $library->{branchcode},
3121             lang        => $patron->lang,
3122             tables      => {
3123                 'branches'    => $library,
3124                 'borrowers'   => $patron->unblessed,
3125                 'biblio'      => $biblio,
3126                 'aqorders'    => $order,
3127             },
3128         );
3129         if ( $letter ) {
3130             C4::Letters::EnqueueLetter(
3131                 {
3132                     letter         => $letter,
3133                     borrowernumber => $borrowernumber,
3134                     LibraryName    => C4::Context->preference("LibraryName"),
3135                     message_transport_type => 'email',
3136                 }
3137             ) or warn "can't enqueue letter $letter";
3138         }
3139     }
3140 }
3141
3142 =head3 FillWithDefaultValues
3143
3144 FillWithDefaultValues( $marc_record );
3145
3146 This will update the record with default value defined in the ACQ framework.
3147 For all existing fields, if a default value exists and there are no subfield, it will be created.
3148 If the field does not exist, it will be created too.
3149
3150 =cut
3151
3152 sub FillWithDefaultValues {
3153     my ($record) = @_;
3154     my $tagslib = C4::Biblio::GetMarcStructure( 1, 'ACQ', { unsafe => 1 } );
3155     if ($tagslib) {
3156         my ($itemfield) =
3157           C4::Biblio::GetMarcFromKohaField( 'items.itemnumber', '' );
3158         for my $tag ( sort keys %$tagslib ) {
3159             next unless $tag;
3160             next if $tag == $itemfield;
3161             for my $subfield ( sort keys %{ $tagslib->{$tag} } ) {
3162                 next if IsMarcStructureInternal($tagslib->{$tag}{$subfield});
3163                 my $defaultvalue = $tagslib->{$tag}{$subfield}{defaultvalue};
3164                 if ( defined $defaultvalue and $defaultvalue ne '' ) {
3165                     my @fields = $record->field($tag);
3166                     if (@fields) {
3167                         for my $field (@fields) {
3168                             unless ( defined $field->subfield($subfield) ) {
3169                                 $field->add_subfields(
3170                                     $subfield => $defaultvalue );
3171                             }
3172                         }
3173                     }
3174                     else {
3175                         $record->insert_fields_ordered(
3176                             MARC::Field->new(
3177                                 $tag, '', '', $subfield => $defaultvalue
3178                             )
3179                         );
3180                     }
3181                 }
3182             }
3183         }
3184     }
3185 }
3186
3187 1;
3188 __END__
3189
3190 =head1 AUTHOR
3191
3192 Koha Development Team <http://koha-community.org/>
3193
3194 =cut