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