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