C4/Acquisition.pm

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