C4/Acquisition.pm

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