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