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
2303     my @order_loop;
2304     my $total_qty         = 0;
2305     my $total_qtyreceived = 0;
2306     my $total_price       = 0;
2307
2308     #get variation of isbn
2309     my @isbn_params;
2310     my @isbns;
2311     if ($isbn){
2312         if ( C4::Context->preference("SearchWithISBNVariations") ){
2313             @isbns = C4::Koha::GetVariationsOfISBN( $isbn );
2314             foreach my $isb (@isbns){
2315                 push @isbn_params, '?';
2316             }
2317         }
2318         unless (@isbns){
2319             push @isbns, $isbn;
2320             push @isbn_params, '?';
2321         }
2322     }
2323
2324     my $dbh   = C4::Context->dbh;
2325     my $query ="
2326         SELECT
2327             COALESCE(biblio.title,     deletedbiblio.title)     AS title,
2328             COALESCE(biblio.author,    deletedbiblio.author)    AS author,
2329             COALESCE(biblioitems.isbn, deletedbiblioitems.isbn) AS isbn,
2330             COALESCE(biblioitems.ean,  deletedbiblioitems.ean)  AS ean,
2331             aqorders.basketno,
2332             aqbasket.basketname,
2333             aqbasket.basketgroupid,
2334             aqbasket.authorisedby,
2335             concat( borrowers.firstname,' ',borrowers.surname) AS authorisedbyname,
2336             aqbasketgroups.name as groupname,
2337             aqbooksellers.name,
2338             aqbasket.creationdate,
2339             aqorders.datereceived,
2340             aqorders.quantity,
2341             aqorders.quantityreceived,
2342             aqorders.ecost,
2343             aqorders.ordernumber,
2344             aqorders.invoiceid,
2345             aqinvoices.invoicenumber,
2346             aqbooksellers.id as id,
2347             aqorders.biblionumber,
2348             aqorders.orderstatus,
2349             aqorders.parent_ordernumber,
2350             aqbudgets.budget_name
2351             ";
2352     $query .= ", aqbudgets.budget_id AS budget" if defined $budget;
2353     $query .= "
2354         FROM aqorders
2355         LEFT JOIN aqbasket ON aqorders.basketno=aqbasket.basketno
2356         LEFT JOIN aqbasketgroups ON aqbasket.basketgroupid=aqbasketgroups.id
2357         LEFT JOIN aqbooksellers ON aqbasket.booksellerid=aqbooksellers.id
2358         LEFT JOIN biblioitems ON biblioitems.biblionumber=aqorders.biblionumber
2359         LEFT JOIN biblio ON biblio.biblionumber=aqorders.biblionumber
2360         LEFT JOIN aqbudgets ON aqorders.budget_id=aqbudgets.budget_id
2361         LEFT JOIN aqinvoices ON aqorders.invoiceid = aqinvoices.invoiceid
2362         LEFT JOIN deletedbiblio ON deletedbiblio.biblionumber=aqorders.biblionumber
2363         LEFT JOIN deletedbiblioitems ON deletedbiblioitems.biblionumber=aqorders.biblionumber
2364         LEFT JOIN borrowers ON aqbasket.authorisedby=borrowers.borrowernumber
2365         ";
2366
2367     $query .= " WHERE 1 ";
2368
2369     unless ($get_canceled_order or (defined $orderstatus and $orderstatus eq 'cancelled')) {
2370         $query .= " AND (datecancellationprinted is NULL or datecancellationprinted='0000-00-00') ";
2371     }
2372
2373     my @query_params  = ();
2374
2375     if ( $biblionumber ) {
2376         $query .= " AND biblio.biblionumber = ?";
2377         push @query_params, $biblionumber;
2378     }
2379
2380     if ( $title ) {
2381         $query .= " AND biblio.title LIKE ? ";
2382         $title =~ s/\s+/%/g;
2383         push @query_params, "%$title%";
2384     }
2385
2386     if ( $author ) {
2387         $query .= " AND biblio.author LIKE ? ";
2388         push @query_params, "%$author%";
2389     }
2390
2391     if ( @isbns ) {
2392         $query .= " AND ( biblioitems.isbn LIKE " . join (" OR biblioitems.isbn LIKE ", @isbn_params ) . ")";
2393         foreach my $isb (@isbns){
2394             push @query_params, "%$isb%";
2395         }
2396     }
2397
2398     if ( $ean ) {
2399         $query .= " AND biblioitems.ean = ? ";
2400         push @query_params, "$ean";
2401     }
2402     if ( $name ) {
2403         $query .= " AND aqbooksellers.name LIKE ? ";
2404         push @query_params, "%$name%";
2405     }
2406
2407     if ( $budget ) {
2408         $query .= " AND aqbudgets.budget_id = ? ";
2409         push @query_params, "$budget";
2410     }
2411
2412     if ( $from_placed_on ) {
2413         $query .= " AND creationdate >= ? ";
2414         push @query_params, $from_placed_on;
2415     }
2416
2417     if ( $to_placed_on ) {
2418         $query .= " AND creationdate <= ? ";
2419         push @query_params, $to_placed_on;
2420     }
2421
2422     if ( defined $orderstatus and $orderstatus ne '') {
2423         $query .= " AND aqorders.orderstatus = ? ";
2424         push @query_params, "$orderstatus";
2425     }
2426
2427     if ($basket) {
2428         if ($basket =~ m/^\d+$/) {
2429             $query .= " AND aqorders.basketno = ? ";
2430             push @query_params, $basket;
2431         } else {
2432             $query .= " AND aqbasket.basketname LIKE ? ";
2433             push @query_params, "%$basket%";
2434         }
2435     }
2436
2437     if ($booksellerinvoicenumber) {
2438         $query .= " AND aqinvoices.invoicenumber LIKE ? ";
2439         push @query_params, "%$booksellerinvoicenumber%";
2440     }
2441
2442     if ($basketgroupname) {
2443         $query .= " AND aqbasketgroups.name LIKE ? ";
2444         push @query_params, "%$basketgroupname%";
2445     }
2446
2447     if ($ordernumber) {
2448         $query .= " AND (aqorders.ordernumber = ? ";
2449         push @query_params, $ordernumber;
2450         if ($search_children_too) {
2451             $query .= " OR aqorders.parent_ordernumber = ? ";
2452             push @query_params, $ordernumber;
2453         }
2454         $query .= ") ";
2455     }
2456
2457     if ( @$created_by ) {
2458         $query .= ' AND aqbasket.authorisedby IN ( ' . join( ',', ('?') x @$created_by ) . ')';
2459         push @query_params, @$created_by;
2460     }
2461
2462
2463     if ( C4::Context->preference("IndependentBranches") ) {
2464         unless ( C4::Context->IsSuperLibrarian() ) {
2465             $query .= " AND (borrowers.branchcode = ? OR borrowers.branchcode ='' ) ";
2466             push @query_params, C4::Context->userenv->{branch};
2467         }
2468     }
2469     $query .= " ORDER BY id";
2470
2471     return $dbh->selectall_arrayref( $query, { Slice => {} }, @query_params );
2472 }
2473
2474 =head2 GetRecentAcqui
2475
2476   $results = GetRecentAcqui($days);
2477
2478 C<$results> is a ref to a table which contains hashref
2479
2480 =cut
2481
2482 sub GetRecentAcqui {
2483     my $limit  = shift;
2484     my $dbh    = C4::Context->dbh;
2485     my $query = "
2486         SELECT *
2487         FROM   biblio
2488         ORDER BY timestamp DESC
2489         LIMIT  0,".$limit;
2490
2491     my $sth = $dbh->prepare($query);
2492     $sth->execute;
2493     my $results = $sth->fetchall_arrayref({});
2494     return $results;
2495 }
2496
2497 #------------------------------------------------------------#
2498
2499 =head3 AddClaim
2500
2501   &AddClaim($ordernumber);
2502
2503 Add a claim for an order
2504
2505 =cut
2506
2507 sub AddClaim {
2508     my ($ordernumber) = @_;
2509     my $dbh          = C4::Context->dbh;
2510     my $query        = "
2511         UPDATE aqorders SET
2512             claims_count = claims_count + 1,
2513             claimed_date = CURDATE()
2514         WHERE ordernumber = ?
2515         ";
2516     my $sth = $dbh->prepare($query);
2517     $sth->execute($ordernumber);
2518 }
2519
2520 =head3 GetInvoices
2521
2522     my @invoices = GetInvoices(
2523         invoicenumber => $invoicenumber,
2524         supplierid => $supplierid,
2525         suppliername => $suppliername,
2526         shipmentdatefrom => $shipmentdatefrom, # ISO format
2527         shipmentdateto => $shipmentdateto, # ISO format
2528         billingdatefrom => $billingdatefrom, # ISO format
2529         billingdateto => $billingdateto, # ISO format
2530         isbneanissn => $isbn_or_ean_or_issn,
2531         title => $title,
2532         author => $author,
2533         publisher => $publisher,
2534         publicationyear => $publicationyear,
2535         branchcode => $branchcode,
2536         order_by => $order_by
2537     );
2538
2539 Return a list of invoices that match all given criteria.
2540
2541 $order_by is "column_name (asc|desc)", where column_name is any of
2542 'invoicenumber', 'booksellerid', 'shipmentdate', 'billingdate', 'closedate',
2543 'shipmentcost', 'shipmentcost_budgetid'.
2544
2545 asc is the default if omitted
2546
2547 =cut
2548
2549 sub GetInvoices {
2550     my %args = @_;
2551
2552     my @columns = qw(invoicenumber booksellerid shipmentdate billingdate
2553         closedate shipmentcost shipmentcost_budgetid);
2554
2555     my $dbh = C4::Context->dbh;
2556     my $query = qq{
2557         SELECT aqinvoices.invoiceid, aqinvoices.invoicenumber, aqinvoices.booksellerid, aqinvoices.shipmentdate, aqinvoices.billingdate, aqinvoices.closedate, aqinvoices.shipmentcost, aqinvoices.shipmentcost_budgetid, aqinvoices.message_id,
2558             aqbooksellers.name AS suppliername,
2559           COUNT(
2560             DISTINCT IF(
2561               aqorders.datereceived IS NOT NULL,
2562               aqorders.biblionumber,
2563               NULL
2564             )
2565           ) AS receivedbiblios,
2566           COUNT(
2567              DISTINCT IF(
2568               aqorders.subscriptionid IS NOT NULL,
2569               aqorders.subscriptionid,
2570               NULL
2571             )
2572           ) AS is_linked_to_subscriptions,
2573           SUM(aqorders.quantityreceived) AS receiveditems
2574         FROM aqinvoices
2575           LEFT JOIN aqbooksellers ON aqbooksellers.id = aqinvoices.booksellerid
2576           LEFT JOIN aqorders ON aqorders.invoiceid = aqinvoices.invoiceid
2577           LEFT JOIN aqbasket ON aqbasket.basketno=aqorders.basketno
2578           LEFT JOIN borrowers ON aqbasket.authorisedby=borrowers.borrowernumber
2579           LEFT JOIN biblio ON aqorders.biblionumber = biblio.biblionumber
2580           LEFT JOIN biblioitems ON biblio.biblionumber = biblioitems.biblionumber
2581           LEFT JOIN subscription ON biblio.biblionumber = subscription.biblionumber
2582     };
2583
2584     my @bind_args;
2585     my @bind_strs;
2586     if($args{supplierid}) {
2587         push @bind_strs, " aqinvoices.booksellerid = ? ";
2588         push @bind_args, $args{supplierid};
2589     }
2590     if($args{invoicenumber}) {
2591         push @bind_strs, " aqinvoices.invoicenumber LIKE ? ";
2592         push @bind_args, "%$args{invoicenumber}%";
2593     }
2594     if($args{suppliername}) {
2595         push @bind_strs, " aqbooksellers.name LIKE ? ";
2596         push @bind_args, "%$args{suppliername}%";
2597     }
2598     if($args{shipmentdatefrom}) {
2599         push @bind_strs, " aqinvoices.shipmentdate >= ? ";
2600         push @bind_args, $args{shipmentdatefrom};
2601     }
2602     if($args{shipmentdateto}) {
2603         push @bind_strs, " aqinvoices.shipmentdate <= ? ";
2604         push @bind_args, $args{shipmentdateto};
2605     }
2606     if($args{billingdatefrom}) {
2607         push @bind_strs, " aqinvoices.billingdate >= ? ";
2608         push @bind_args, $args{billingdatefrom};
2609     }
2610     if($args{billingdateto}) {
2611         push @bind_strs, " aqinvoices.billingdate <= ? ";
2612         push @bind_args, $args{billingdateto};
2613     }
2614     if($args{isbneanissn}) {
2615         push @bind_strs, " (biblioitems.isbn LIKE CONCAT('%', ?, '%') OR biblioitems.ean LIKE CONCAT('%', ?, '%') OR biblioitems.issn LIKE CONCAT('%', ?, '%') ) ";
2616         push @bind_args, $args{isbneanissn}, $args{isbneanissn}, $args{isbneanissn};
2617     }
2618     if($args{title}) {
2619         push @bind_strs, " biblio.title LIKE CONCAT('%', ?, '%') ";
2620         push @bind_args, $args{title};
2621     }
2622     if($args{author}) {
2623         push @bind_strs, " biblio.author LIKE CONCAT('%', ?, '%') ";
2624         push @bind_args, $args{author};
2625     }
2626     if($args{publisher}) {
2627         push @bind_strs, " biblioitems.publishercode LIKE CONCAT('%', ?, '%') ";
2628         push @bind_args, $args{publisher};
2629     }
2630     if($args{publicationyear}) {
2631         push @bind_strs, " ((biblioitems.publicationyear LIKE CONCAT('%', ?, '%')) OR (biblio.copyrightdate LIKE CONCAT('%', ?, '%'))) ";
2632         push @bind_args, $args{publicationyear}, $args{publicationyear};
2633     }
2634     if($args{branchcode}) {
2635         push @bind_strs, " borrowers.branchcode = ? ";
2636         push @bind_args, $args{branchcode};
2637     }
2638     if($args{message_id}) {
2639         push @bind_strs, " aqinvoices.message_id = ? ";
2640         push @bind_args, $args{message_id};
2641     }
2642
2643     $query .= " WHERE " . join(" AND ", @bind_strs) if @bind_strs;
2644     $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";
2645
2646     if($args{order_by}) {
2647         my ($column, $direction) = split / /, $args{order_by};
2648         if(grep /^$column$/, @columns) {
2649             $direction ||= 'ASC';
2650             $query .= " ORDER BY $column $direction";
2651         }
2652     }
2653
2654     my $sth = $dbh->prepare($query);
2655     $sth->execute(@bind_args);
2656
2657     my $results = $sth->fetchall_arrayref({});
2658     return @$results;
2659 }
2660
2661 =head3 GetInvoice
2662
2663     my $invoice = GetInvoice($invoiceid);
2664
2665 Get informations about invoice with given $invoiceid
2666
2667 Return a hash filled with aqinvoices.* fields
2668
2669 =cut
2670
2671 sub GetInvoice {
2672     my ($invoiceid) = @_;
2673     my $invoice;
2674
2675     return unless $invoiceid;
2676
2677     my $dbh = C4::Context->dbh;
2678     my $query = qq{
2679         SELECT *
2680         FROM aqinvoices
2681         WHERE invoiceid = ?
2682     };
2683     my $sth = $dbh->prepare($query);
2684     $sth->execute($invoiceid);
2685
2686     $invoice = $sth->fetchrow_hashref;
2687     return $invoice;
2688 }
2689
2690 =head3 GetInvoiceDetails
2691
2692     my $invoice = GetInvoiceDetails($invoiceid)
2693
2694 Return informations about an invoice + the list of related order lines
2695
2696 Orders informations are in $invoice->{orders} (array ref)
2697
2698 =cut
2699
2700 sub GetInvoiceDetails {
2701     my ($invoiceid) = @_;
2702
2703     if ( !defined $invoiceid ) {
2704         carp 'GetInvoiceDetails called without an invoiceid';
2705         return;
2706     }
2707
2708     my $dbh = C4::Context->dbh;
2709     my $query = q{
2710         SELECT aqinvoices.*, aqbooksellers.name AS suppliername
2711         FROM aqinvoices
2712           LEFT JOIN aqbooksellers ON aqinvoices.booksellerid = aqbooksellers.id
2713         WHERE invoiceid = ?
2714     };
2715     my $sth = $dbh->prepare($query);
2716     $sth->execute($invoiceid);
2717
2718     my $invoice = $sth->fetchrow_hashref;
2719
2720     $query = q{
2721         SELECT aqorders.*,
2722                 biblio.*,
2723                 biblio.copyrightdate,
2724                 biblioitems.isbn,
2725                 biblioitems.publishercode,
2726                 biblioitems.publicationyear,
2727                 aqbasket.basketname,
2728                 aqbasketgroups.id AS basketgroupid,
2729                 aqbasketgroups.name AS basketgroupname
2730         FROM aqorders
2731           LEFT JOIN aqbasket ON aqorders.basketno = aqbasket.basketno
2732           LEFT JOIN aqbasketgroups ON aqbasket.basketgroupid = aqbasketgroups.id
2733           LEFT JOIN biblio ON aqorders.biblionumber = biblio.biblionumber
2734           LEFT JOIN biblioitems ON aqorders.biblionumber = biblioitems.biblionumber
2735         WHERE invoiceid = ?
2736     };
2737     $sth = $dbh->prepare($query);
2738     $sth->execute($invoiceid);
2739     $invoice->{orders} = $sth->fetchall_arrayref({});
2740     $invoice->{orders} ||= []; # force an empty arrayref if fetchall_arrayref fails
2741
2742     return $invoice;
2743 }
2744
2745 =head3 AddInvoice
2746
2747     my $invoiceid = AddInvoice(
2748         invoicenumber => $invoicenumber,
2749         booksellerid => $booksellerid,
2750         shipmentdate => $shipmentdate,
2751         billingdate => $billingdate,
2752         closedate => $closedate,
2753         shipmentcost => $shipmentcost,
2754         shipmentcost_budgetid => $shipmentcost_budgetid
2755     );
2756
2757 Create a new invoice and return its id or undef if it fails.
2758
2759 =cut
2760
2761 sub AddInvoice {
2762     my %invoice = @_;
2763
2764     return unless(%invoice and $invoice{invoicenumber});
2765
2766     my @columns = qw(invoicenumber booksellerid shipmentdate billingdate
2767         closedate shipmentcost shipmentcost_budgetid message_id);
2768
2769     my @set_strs;
2770     my @set_args;
2771     foreach my $key (keys %invoice) {
2772         if(0 < grep(/^$key$/, @columns)) {
2773             push @set_strs, "$key = ?";
2774             push @set_args, ($invoice{$key} || undef);
2775         }
2776     }
2777
2778     my $rv;
2779     if(@set_args > 0) {
2780         my $dbh = C4::Context->dbh;
2781         my $query = "INSERT INTO aqinvoices SET ";
2782         $query .= join (",", @set_strs);
2783         my $sth = $dbh->prepare($query);
2784         $rv = $sth->execute(@set_args);
2785         if($rv) {
2786             $rv = $dbh->last_insert_id(undef, undef, 'aqinvoices', undef);
2787         }
2788     }
2789     return $rv;
2790 }
2791
2792 =head3 ModInvoice
2793
2794     ModInvoice(
2795         invoiceid => $invoiceid,    # Mandatory
2796         invoicenumber => $invoicenumber,
2797         booksellerid => $booksellerid,
2798         shipmentdate => $shipmentdate,
2799         billingdate => $billingdate,
2800         closedate => $closedate,
2801         shipmentcost => $shipmentcost,
2802         shipmentcost_budgetid => $shipmentcost_budgetid
2803     );
2804
2805 Modify an invoice, invoiceid is mandatory.
2806
2807 Return undef if it fails.
2808
2809 =cut
2810
2811 sub ModInvoice {
2812     my %invoice = @_;
2813
2814     return unless(%invoice and $invoice{invoiceid});
2815
2816     my @columns = qw(invoicenumber booksellerid shipmentdate billingdate
2817         closedate shipmentcost shipmentcost_budgetid);
2818
2819     my @set_strs;
2820     my @set_args;
2821     foreach my $key (keys %invoice) {
2822         if(0 < grep(/^$key$/, @columns)) {
2823             push @set_strs, "$key = ?";
2824             push @set_args, ($invoice{$key} || undef);
2825         }
2826     }
2827
2828     my $dbh = C4::Context->dbh;
2829     my $query = "UPDATE aqinvoices SET ";
2830     $query .= join(",", @set_strs);
2831     $query .= " WHERE invoiceid = ?";
2832
2833     my $sth = $dbh->prepare($query);
2834     $sth->execute(@set_args, $invoice{invoiceid});
2835 }
2836
2837 =head3 CloseInvoice
2838
2839     CloseInvoice($invoiceid);
2840
2841 Close an invoice.
2842
2843 Equivalent to ModInvoice(invoiceid => $invoiceid, closedate => undef);
2844
2845 =cut
2846
2847 sub CloseInvoice {
2848     my ($invoiceid) = @_;
2849
2850     return unless $invoiceid;
2851
2852     my $dbh = C4::Context->dbh;
2853     my $query = qq{
2854         UPDATE aqinvoices
2855         SET closedate = CAST(NOW() AS DATE)
2856         WHERE invoiceid = ?
2857     };
2858     my $sth = $dbh->prepare($query);
2859     $sth->execute($invoiceid);
2860 }
2861
2862 =head3 ReopenInvoice
2863
2864     ReopenInvoice($invoiceid);
2865
2866 Reopen an invoice
2867
2868 Equivalent to ModInvoice(invoiceid => $invoiceid, closedate => output_pref({ dt=>dt_from_string, dateonly=>1, otputpref=>'iso' }))
2869
2870 =cut
2871
2872 sub ReopenInvoice {
2873     my ($invoiceid) = @_;
2874
2875     return unless $invoiceid;
2876
2877     my $dbh = C4::Context->dbh;
2878     my $query = qq{
2879         UPDATE aqinvoices
2880         SET closedate = NULL
2881         WHERE invoiceid = ?
2882     };
2883     my $sth = $dbh->prepare($query);
2884     $sth->execute($invoiceid);
2885 }
2886
2887 =head3 DelInvoice
2888
2889     DelInvoice($invoiceid);
2890
2891 Delete an invoice if there are no items attached to it.
2892
2893 =cut
2894
2895 sub DelInvoice {
2896     my ($invoiceid) = @_;
2897
2898     return unless $invoiceid;
2899
2900     my $dbh   = C4::Context->dbh;
2901     my $query = qq{
2902         SELECT COUNT(*)
2903         FROM aqorders
2904         WHERE invoiceid = ?
2905     };
2906     my $sth = $dbh->prepare($query);
2907     $sth->execute($invoiceid);
2908     my $res = $sth->fetchrow_arrayref;
2909     if ( $res && $res->[0] == 0 ) {
2910         $query = qq{
2911             DELETE FROM aqinvoices
2912             WHERE invoiceid = ?
2913         };
2914         my $sth = $dbh->prepare($query);
2915         return ( $sth->execute($invoiceid) > 0 );
2916     }
2917     return;
2918 }
2919
2920 =head3 MergeInvoices
2921
2922     MergeInvoices($invoiceid, \@sourceids);
2923
2924 Merge the invoices identified by the IDs in \@sourceids into
2925 the invoice identified by $invoiceid.
2926
2927 =cut
2928
2929 sub MergeInvoices {
2930     my ($invoiceid, $sourceids) = @_;
2931
2932     return unless $invoiceid;
2933     foreach my $sourceid (@$sourceids) {
2934         next if $sourceid == $invoiceid;
2935         my $source = GetInvoiceDetails($sourceid);
2936         foreach my $order (@{$source->{'orders'}}) {
2937             $order->{'invoiceid'} = $invoiceid;
2938             ModOrder($order);
2939         }
2940         DelInvoice($source->{'invoiceid'});
2941     }
2942     return;
2943 }
2944
2945 =head3 GetBiblioCountByBasketno
2946
2947 $biblio_count = &GetBiblioCountByBasketno($basketno);
2948
2949 Looks up the biblio's count that has basketno value $basketno
2950
2951 Returns a quantity
2952
2953 =cut
2954
2955 sub GetBiblioCountByBasketno {
2956     my ($basketno) = @_;
2957     my $dbh          = C4::Context->dbh;
2958     my $query        = "
2959         SELECT COUNT( DISTINCT( biblionumber ) )
2960         FROM   aqorders
2961         WHERE  basketno = ?
2962             AND (datecancellationprinted IS NULL OR datecancellationprinted='0000-00-00')
2963         ";
2964
2965     my $sth = $dbh->prepare($query);
2966     $sth->execute($basketno);
2967     return $sth->fetchrow;
2968 }
2969
2970 # Note this subroutine should be moved to Koha::Acquisition::Order
2971 # Will do when a DBIC decision will be taken.
2972 sub populate_order_with_prices {
2973     my ($params) = @_;
2974
2975     my $order        = $params->{order};
2976     my $booksellerid = $params->{booksellerid};
2977     return unless $booksellerid;
2978
2979     my $bookseller = Koha::Acquisition::Booksellers->find( $booksellerid );
2980
2981     my $receiving = $params->{receiving};
2982     my $ordering  = $params->{ordering};
2983     my $discount  = $order->{discount};
2984     $discount /= 100 if $discount > 1;
2985
2986     if ($ordering) {
2987         $order->{tax_rate_on_ordering} //= $order->{tax_rate};
2988         if ( $bookseller->listincgst ) {
2989             # The user entered the rrp tax included
2990             $order->{rrp_tax_included} = $order->{rrp};
2991
2992             # rrp tax excluded = rrp tax included / ( 1 + tax rate )
2993             $order->{rrp_tax_excluded} = $order->{rrp_tax_included} / ( 1 + $order->{tax_rate_on_ordering} );
2994
2995             # ecost tax excluded = rrp tax excluded * ( 1 - discount )
2996             $order->{ecost_tax_excluded} = $order->{rrp_tax_excluded} * ( 1 - $discount );
2997
2998             # ecost tax included = rrp tax included  ( 1 - discount )
2999             $order->{ecost_tax_included} = $order->{rrp_tax_included} * ( 1 - $discount );
3000         }
3001         else {
3002             # The user entered the rrp tax excluded
3003             $order->{rrp_tax_excluded} = $order->{rrp};
3004
3005             # rrp tax included = rrp tax excluded * ( 1 - tax rate )
3006             $order->{rrp_tax_included} = $order->{rrp_tax_excluded} * ( 1 + $order->{tax_rate_on_ordering} );
3007
3008             # ecost tax excluded = rrp tax excluded * ( 1 - discount )
3009             $order->{ecost_tax_excluded} = $order->{rrp_tax_excluded} * ( 1 - $discount );
3010
3011             # ecost tax included = rrp tax excluded * ( 1 + tax rate ) * ( 1 - discount )
3012             $order->{ecost_tax_included} =
3013                 $order->{rrp_tax_excluded} *
3014                 ( 1 + $order->{tax_rate_on_ordering} ) *
3015                 ( 1 - $discount );
3016         }
3017
3018         # tax value = quantity * ecost tax excluded * tax rate
3019         $order->{tax_value_on_ordering} =
3020             $order->{quantity} * $order->{ecost_tax_excluded} * $order->{tax_rate_on_ordering};
3021     }
3022
3023     if ($receiving) {
3024         $order->{tax_rate_on_receiving} //= $order->{tax_rate};
3025         if ( $bookseller->invoiceincgst ) {
3026             # Trick for unitprice. If the unit price rounded value is the same as the ecost rounded value
3027             # we need to keep the exact ecost value
3028             if ( Koha::Number::Price->new( $order->{unitprice} )->round == Koha::Number::Price->new( $order->{ecost_tax_included} )->round ) {
3029                 $order->{unitprice} = $order->{ecost_tax_included};
3030             }
3031
3032             # The user entered the unit price tax included
3033             $order->{unitprice_tax_included} = $order->{unitprice};
3034
3035             # unit price tax excluded = unit price tax included / ( 1 + tax rate )
3036             $order->{unitprice_tax_excluded} = $order->{unitprice_tax_included} / ( 1 + $order->{tax_rate_on_receiving} );
3037         }
3038         else {
3039             # Trick for unitprice. If the unit price rounded value is the same as the ecost rounded value
3040             # we need to keep the exact ecost value
3041             if ( Koha::Number::Price->new( $order->{unitprice} )->round == Koha::Number::Price->new( $order->{ecost_tax_excluded} )->round ) {
3042                 $order->{unitprice} = $order->{ecost_tax_excluded};
3043             }
3044
3045             # The user entered the unit price tax excluded
3046             $order->{unitprice_tax_excluded} = $order->{unitprice};
3047
3048
3049             # unit price tax included = unit price tax included * ( 1 + tax rate )
3050             $order->{unitprice_tax_included} = $order->{unitprice_tax_excluded} * ( 1 + $order->{tax_rate_on_receiving} );
3051         }
3052
3053         # tax value = quantity * unit price tax excluded * tax rate
3054         $order->{tax_value_on_receiving} = $order->{quantity} * $order->{unitprice_tax_excluded} * $order->{tax_rate_on_receiving};
3055     }
3056
3057     return $order;
3058 }
3059
3060 =head3 GetOrderUsers
3061
3062     $order_users_ids = &GetOrderUsers($ordernumber);
3063
3064 Returns a list of all borrowernumbers that are in order users list
3065
3066 =cut
3067
3068 sub GetOrderUsers {
3069     my ($ordernumber) = @_;
3070
3071     return unless $ordernumber;
3072
3073     my $query = q|
3074         SELECT borrowernumber
3075         FROM aqorder_users
3076         WHERE ordernumber = ?
3077     |;
3078     my $dbh = C4::Context->dbh;
3079     my $sth = $dbh->prepare($query);
3080     $sth->execute($ordernumber);
3081     my $results = $sth->fetchall_arrayref( {} );
3082
3083     my @borrowernumbers;
3084     foreach (@$results) {
3085         push @borrowernumbers, $_->{'borrowernumber'};
3086     }
3087
3088     return @borrowernumbers;
3089 }
3090
3091 =head3 ModOrderUsers
3092
3093     my @order_users_ids = (1, 2, 3);
3094     &ModOrderUsers($ordernumber, @basketusers_ids);
3095
3096 Delete all users from order users list, and add users in C<@order_users_ids>
3097 to this users list.
3098
3099 =cut
3100
3101 sub ModOrderUsers {
3102     my ( $ordernumber, @order_users_ids ) = @_;
3103
3104     return unless $ordernumber;
3105
3106     my $dbh   = C4::Context->dbh;
3107     my $query = q|
3108         DELETE FROM aqorder_users
3109         WHERE ordernumber = ?
3110     |;
3111     my $sth = $dbh->prepare($query);
3112     $sth->execute($ordernumber);
3113
3114     $query = q|
3115         INSERT INTO aqorder_users (ordernumber, borrowernumber)
3116         VALUES (?, ?)
3117     |;
3118     $sth = $dbh->prepare($query);
3119     foreach my $order_user_id (@order_users_ids) {
3120         $sth->execute( $ordernumber, $order_user_id );
3121     }
3122 }
3123
3124 sub NotifyOrderUsers {
3125     my ($ordernumber) = @_;
3126
3127     my @borrowernumbers = GetOrderUsers($ordernumber);
3128     return unless @borrowernumbers;
3129
3130     my $order = GetOrder( $ordernumber );
3131     for my $borrowernumber (@borrowernumbers) {
3132         my $patron = Koha::Patrons->find( $borrowernumber );
3133         my $library = $patron->library->unblessed;
3134         my $biblio = Koha::Biblios->find( $order->{biblionumber} )->unblessed;
3135         my $letter = C4::Letters::GetPreparedLetter(
3136             module      => 'acquisition',
3137             letter_code => 'ACQ_NOTIF_ON_RECEIV',
3138             branchcode  => $library->{branchcode},
3139             lang        => $patron->lang,
3140             tables      => {
3141                 'branches'    => $library,
3142                 'borrowers'   => $patron->unblessed,
3143                 'biblio'      => $biblio,
3144                 'aqorders'    => $order,
3145             },
3146         );
3147         if ( $letter ) {
3148             C4::Letters::EnqueueLetter(
3149                 {
3150                     letter         => $letter,
3151                     borrowernumber => $borrowernumber,
3152                     LibraryName    => C4::Context->preference("LibraryName"),
3153                     message_transport_type => 'email',
3154                 }
3155             ) or warn "can't enqueue letter $letter";
3156         }
3157     }
3158 }
3159
3160 =head3 FillWithDefaultValues
3161
3162 FillWithDefaultValues( $marc_record );
3163
3164 This will update the record with default value defined in the ACQ framework.
3165 For all existing fields, if a default value exists and there are no subfield, it will be created.
3166 If the field does not exist, it will be created too.
3167
3168 =cut
3169
3170 sub FillWithDefaultValues {
3171     my ($record) = @_;
3172     my $tagslib = C4::Biblio::GetMarcStructure( 1, 'ACQ', { unsafe => 1 } );
3173     if ($tagslib) {
3174         my ($itemfield) =
3175           C4::Biblio::GetMarcFromKohaField( 'items.itemnumber', '' );
3176         for my $tag ( sort keys %$tagslib ) {
3177             next unless $tag;
3178             next if $tag == $itemfield;
3179             for my $subfield ( sort keys %{ $tagslib->{$tag} } ) {
3180                 next if IsMarcStructureInternal($tagslib->{$tag}{$subfield});
3181                 my $defaultvalue = $tagslib->{$tag}{$subfield}{defaultvalue};
3182                 if ( defined $defaultvalue and $defaultvalue ne '' ) {
3183                     my @fields = $record->field($tag);
3184                     if (@fields) {
3185                         for my $field (@fields) {
3186                             unless ( defined $field->subfield($subfield) ) {
3187                                 $field->add_subfields(
3188                                     $subfield => $defaultvalue );
3189                             }
3190                         }
3191                     }
3192                     else {
3193                         $record->insert_fields_ordered(
3194                             MARC::Field->new(
3195                                 $tag, '', '', $subfield => $defaultvalue
3196                             )
3197                         );
3198                     }
3199                 }
3200             }
3201         }
3202     }
3203 }
3204
3205 1;
3206 __END__
3207
3208 =head1 AUTHOR
3209
3210 Koha Development Team <http://koha-community.org/>
3211
3212 =cut