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             , unitprice = ?, unitprice_tax_included = ?, unitprice_tax_excluded = ?
1514         | if defined $order->{unitprice};
1515
1516         $query .= q|
1517             ,tax_value_on_receiving = ?
1518         | if defined $order->{tax_value_on_receiving};
1519
1520         $query .= q|
1521             ,tax_rate_on_receiving = ?
1522         | if defined $order->{tax_rate_on_receiving};
1523
1524         $query .= q|
1525             , order_internalnote = ?
1526         | if defined $order->{order_internalnote};
1527
1528         $query .= q| where biblionumber=? and ordernumber=?|;
1529
1530         my $sth = $dbh->prepare( $query );
1531         my @params = ( $quantrec, $datereceived, $invoice->{invoiceid}, ( $budget_id ? $budget_id : $order->{budget_id} ) );
1532
1533         if ( defined $order->{unitprice} ) {
1534             push @params, $order->{unitprice}, $order->{unitprice_tax_included}, $order->{unitprice_tax_excluded};
1535         }
1536
1537         if ( defined $order->{tax_value_on_receiving} ) {
1538             push @params, $order->{tax_value_on_receiving};
1539         }
1540
1541         if ( defined $order->{tax_rate_on_receiving} ) {
1542             push @params, $order->{tax_rate_on_receiving};
1543         }
1544
1545         if ( defined $order->{order_internalnote} ) {
1546             push @params, $order->{order_internalnote};
1547         }
1548
1549         push @params, ( $biblionumber, $order->{ordernumber} );
1550
1551         $sth->execute( @params );
1552
1553         # All items have been received, sent a notification to users
1554         NotifyOrderUsers( $order->{ordernumber} );
1555
1556     }
1557     return ($datereceived, $new_ordernumber);
1558 }
1559
1560 =head3 CancelReceipt
1561
1562     my $parent_ordernumber = CancelReceipt($ordernumber);
1563
1564     Cancel an order line receipt and update the parent order line, as if no
1565     receipt was made.
1566     If items are created at receipt (AcqCreateItem = receiving) then delete
1567     these items.
1568
1569 =cut
1570
1571 sub CancelReceipt {
1572     my $ordernumber = shift;
1573
1574     return unless $ordernumber;
1575
1576     my $dbh = C4::Context->dbh;
1577     my $query = qq{
1578         SELECT datereceived, parent_ordernumber, quantity
1579         FROM aqorders
1580         WHERE ordernumber = ?
1581     };
1582     my $sth = $dbh->prepare($query);
1583     $sth->execute($ordernumber);
1584     my $order = $sth->fetchrow_hashref;
1585     unless($order) {
1586         warn "CancelReceipt: order $ordernumber does not exist";
1587         return;
1588     }
1589     unless($order->{'datereceived'}) {
1590         warn "CancelReceipt: order $ordernumber is not received";
1591         return;
1592     }
1593
1594     my $parent_ordernumber = $order->{'parent_ordernumber'};
1595
1596     my @itemnumbers = GetItemnumbersFromOrder( $ordernumber );
1597     my $order_obj = Koha::Acquisition::Orders->find( $ordernumber ); # FIXME rewrite all this subroutine using this object
1598
1599     if($parent_ordernumber == $ordernumber || not $parent_ordernumber) {
1600         # The order line has no parent, just mark it as not received
1601         $query = qq{
1602             UPDATE aqorders
1603             SET quantityreceived = ?,
1604                 datereceived = ?,
1605                 invoiceid = ?,
1606                 orderstatus = 'ordered'
1607             WHERE ordernumber = ?
1608         };
1609         $sth = $dbh->prepare($query);
1610         $sth->execute(0, undef, undef, $ordernumber);
1611         _cancel_items_receipt( $order_obj );
1612     } else {
1613         # The order line has a parent, increase parent quantity and delete
1614         # the order line.
1615         $query = qq{
1616             SELECT quantity, datereceived
1617             FROM aqorders
1618             WHERE ordernumber = ?
1619         };
1620         $sth = $dbh->prepare($query);
1621         $sth->execute($parent_ordernumber);
1622         my $parent_order = $sth->fetchrow_hashref;
1623         unless($parent_order) {
1624             warn "Parent order $parent_ordernumber does not exist.";
1625             return;
1626         }
1627         if($parent_order->{'datereceived'}) {
1628             warn "CancelReceipt: parent order is received.".
1629                 " Can't cancel receipt.";
1630             return;
1631         }
1632         $query = qq{
1633             UPDATE aqorders
1634             SET quantity = ?,
1635                 orderstatus = 'ordered'
1636             WHERE ordernumber = ?
1637         };
1638         $sth = $dbh->prepare($query);
1639         my $rv = $sth->execute(
1640             $order->{'quantity'} + $parent_order->{'quantity'},
1641             $parent_ordernumber
1642         );
1643         unless($rv) {
1644             warn "Cannot update parent order line, so do not cancel".
1645                 " receipt";
1646             return;
1647         }
1648
1649         # Recalculate tax_value
1650         $dbh->do(q|
1651             UPDATE aqorders
1652             SET
1653                 tax_value_on_ordering = quantity * ecost_tax_excluded * tax_rate_on_ordering,
1654                 tax_value_on_receiving = quantity * unitprice_tax_excluded * tax_rate_on_receiving
1655             WHERE ordernumber = ?
1656         |, undef, $parent_ordernumber);
1657
1658         _cancel_items_receipt( $order_obj, $parent_ordernumber );
1659         # Delete order line
1660         $query = qq{
1661             DELETE FROM aqorders
1662             WHERE ordernumber = ?
1663         };
1664         $sth = $dbh->prepare($query);
1665         $sth->execute($ordernumber);
1666
1667     }
1668
1669     if( $order_obj->basket->effective_create_items eq 'ordering' ) {
1670         my @affects = split q{\|}, C4::Context->preference("AcqItemSetSubfieldsWhenReceiptIsCancelled");
1671         if ( @affects ) {
1672             for my $in ( @itemnumbers ) {
1673                 my $item = Koha::Items->find( $in );
1674                 my $biblio = $item->biblio;
1675                 my ( $itemfield ) = GetMarcFromKohaField( 'items.itemnumber', $biblio->frameworkcode );
1676                 my $item_marc = C4::Items::GetMarcItem( $biblio->biblionumber, $in );
1677                 for my $affect ( @affects ) {
1678                     my ( $sf, $v ) = split q{=}, $affect, 2;
1679                     foreach ( $item_marc->field($itemfield) ) {
1680                         $_->update( $sf => $v );
1681                     }
1682                 }
1683                 C4::Items::ModItemFromMarc( $item_marc, $biblio->biblionumber, $in );
1684             }
1685         }
1686     }
1687
1688     return $parent_ordernumber;
1689 }
1690
1691 sub _cancel_items_receipt {
1692     my ( $order, $parent_ordernumber ) = @_;
1693     $parent_ordernumber ||= $order->ordernumber;
1694
1695     my @itemnumbers = GetItemnumbersFromOrder($order->ordernumber); # FIXME Must be $order->items
1696     if ( $order->basket->effective_create_items eq 'receiving' ) {
1697         # Remove items that were created at receipt
1698         my $query = qq{
1699             DELETE FROM items, aqorders_items
1700             USING items, aqorders_items
1701             WHERE items.itemnumber = ? AND aqorders_items.itemnumber = ?
1702         };
1703         my $dbh = C4::Context->dbh;
1704         my $sth = $dbh->prepare($query);
1705         foreach my $itemnumber (@itemnumbers) {
1706             $sth->execute($itemnumber, $itemnumber);
1707         }
1708     } else {
1709         # Update items
1710         foreach my $itemnumber (@itemnumbers) {
1711             ModItemOrder($itemnumber, $parent_ordernumber);
1712         }
1713     }
1714 }
1715
1716 #------------------------------------------------------------#
1717
1718 =head3 SearchOrders
1719
1720 @results = &SearchOrders({
1721     ordernumber => $ordernumber,
1722     search => $search,
1723     ean => $ean,
1724     booksellerid => $booksellerid,
1725     basketno => $basketno,
1726     basketname => $basketname,
1727     basketgroupname => $basketgroupname,
1728     owner => $owner,
1729     pending => $pending
1730     ordered => $ordered
1731     biblionumber => $biblionumber,
1732     budget_id => $budget_id
1733 });
1734
1735 Searches for orders filtered by criteria.
1736
1737 C<$ordernumber> Finds matching orders or transferred orders by ordernumber.
1738 C<$search> Finds orders matching %$search% in title, author, or isbn.
1739 C<$owner> Finds order for the logged in user.
1740 C<$pending> Finds pending orders. Ignores completed and cancelled orders.
1741 C<$ordered> Finds orders to receive only (status 'ordered' or 'partial').
1742
1743
1744 C<@results> is an array of references-to-hash with the keys are fields
1745 from aqorders, biblio, biblioitems and aqbasket tables.
1746
1747 =cut
1748
1749 sub SearchOrders {
1750     my ( $params ) = @_;
1751     my $ordernumber = $params->{ordernumber};
1752     my $search = $params->{search};
1753     my $ean = $params->{ean};
1754     my $booksellerid = $params->{booksellerid};
1755     my $basketno = $params->{basketno};
1756     my $basketname = $params->{basketname};
1757     my $basketgroupname = $params->{basketgroupname};
1758     my $owner = $params->{owner};
1759     my $pending = $params->{pending};
1760     my $ordered = $params->{ordered};
1761     my $biblionumber = $params->{biblionumber};
1762     my $budget_id = $params->{budget_id};
1763
1764     my $dbh = C4::Context->dbh;
1765     my @args = ();
1766     my $query = q{
1767         SELECT aqbasket.basketno,
1768                borrowers.surname,
1769                borrowers.firstname,
1770                biblio.*,
1771                biblioitems.isbn,
1772                biblioitems.biblioitemnumber,
1773                biblioitems.publishercode,
1774                biblioitems.publicationyear,
1775                aqbasket.authorisedby,
1776                aqbasket.booksellerid,
1777                aqbasket.closedate,
1778                aqbasket.creationdate,
1779                aqbasket.basketname,
1780                aqbasketgroups.id as basketgroupid,
1781                aqbasketgroups.name as basketgroupname,
1782                aqorders.*
1783         FROM aqorders
1784             LEFT JOIN aqbasket ON aqorders.basketno = aqbasket.basketno
1785             LEFT JOIN aqbasketgroups ON aqbasket.basketgroupid = aqbasketgroups.id
1786             LEFT JOIN borrowers ON aqbasket.authorisedby=borrowers.borrowernumber
1787             LEFT JOIN biblio ON aqorders.biblionumber=biblio.biblionumber
1788             LEFT JOIN biblioitems ON biblioitems.biblionumber=biblio.biblionumber
1789     };
1790
1791     # If we search on ordernumber, we retrieve the transferred order if a transfer has been done.
1792     $query .= q{
1793             LEFT JOIN aqorders_transfers ON aqorders_transfers.ordernumber_to = aqorders.ordernumber
1794     } if $ordernumber;
1795
1796     $query .= q{
1797         WHERE (datecancellationprinted is NULL)
1798     };
1799
1800     if ( $pending or $ordered ) {
1801         $query .= q{
1802             AND (
1803                 ( aqbasket.is_standing AND aqorders.orderstatus IN ( "new", "ordered", "partial" ) )
1804                 OR (
1805                     ( quantity > quantityreceived OR quantityreceived is NULL )
1806         };
1807
1808         if ( $ordered ) {
1809             $query .= q{ AND aqorders.orderstatus IN ( "ordered", "partial" )};
1810         }
1811         $query .= q{
1812                 )
1813             )
1814         };
1815     }
1816
1817     my $userenv = C4::Context->userenv;
1818     if ( C4::Context->preference("IndependentBranches") ) {
1819         unless ( C4::Context->IsSuperLibrarian() ) {
1820             $query .= q{
1821                 AND (
1822                     borrowers.branchcode = ?
1823                     OR borrowers.branchcode  = ''
1824                 )
1825             };
1826             push @args, $userenv->{branch};
1827         }
1828     }
1829
1830     if ( $ordernumber ) {
1831         $query .= ' AND ( aqorders.ordernumber = ? OR aqorders_transfers.ordernumber_from = ? ) ';
1832         push @args, ( $ordernumber, $ordernumber );
1833     }
1834     if ( $biblionumber ) {
1835         $query .= 'AND aqorders.biblionumber = ?';
1836         push @args, $biblionumber;
1837     }
1838     if( $search ) {
1839         $query .= ' AND (biblio.title LIKE ? OR biblio.author LIKE ? OR biblioitems.isbn LIKE ?)';
1840         push @args, ("%$search%","%$search%","%$search%");
1841     }
1842     if ( $ean ) {
1843         $query .= ' AND biblioitems.ean = ?';
1844         push @args, $ean;
1845     }
1846     if ( $booksellerid ) {
1847         $query .= 'AND aqbasket.booksellerid = ?';
1848         push @args, $booksellerid;
1849     }
1850     if( $basketno ) {
1851         $query .= 'AND aqbasket.basketno = ?';
1852         push @args, $basketno;
1853     }
1854     if( $basketname ) {
1855         $query .= 'AND aqbasket.basketname LIKE ?';
1856         push @args, "%$basketname%";
1857     }
1858     if( $basketgroupname ) {
1859         $query .= ' AND aqbasketgroups.name LIKE ?';
1860         push @args, "%$basketgroupname%";
1861     }
1862
1863     if ( $owner ) {
1864         $query .= ' AND aqbasket.authorisedby=? ';
1865         push @args, $userenv->{'number'};
1866     }
1867
1868     if ( $budget_id ) {
1869         $query .= ' AND aqorders.budget_id = ?';
1870         push @args, $budget_id;
1871     }
1872
1873     $query .= ' ORDER BY aqbasket.basketno';
1874
1875     my $sth = $dbh->prepare($query);
1876     $sth->execute(@args);
1877     return $sth->fetchall_arrayref({});
1878 }
1879
1880 #------------------------------------------------------------#
1881
1882 =head3 DelOrder
1883
1884   &DelOrder($biblionumber, $ordernumber);
1885
1886 Cancel the order with the given order and biblio numbers. It does not
1887 delete any entries in the aqorders table, it merely marks them as
1888 cancelled.
1889
1890 =cut
1891
1892 sub DelOrder {
1893     my ( $bibnum, $ordernumber, $delete_biblio, $reason ) = @_;
1894
1895     my $error;
1896     my $dbh = C4::Context->dbh;
1897     my $query = "
1898         UPDATE aqorders
1899         SET    datecancellationprinted=now(), orderstatus='cancelled'
1900     ";
1901     if($reason) {
1902         $query .= ", cancellationreason = ? ";
1903     }
1904     $query .= "
1905         WHERE biblionumber=? AND ordernumber=?
1906     ";
1907     my $sth = $dbh->prepare($query);
1908     if($reason) {
1909         $sth->execute($reason, $bibnum, $ordernumber);
1910     } else {
1911         $sth->execute( $bibnum, $ordernumber );
1912     }
1913     $sth->finish;
1914
1915     my @itemnumbers = GetItemnumbersFromOrder( $ordernumber );
1916     foreach my $itemnumber (@itemnumbers){
1917         my $delcheck = C4::Items::DelItemCheck( $bibnum, $itemnumber );
1918
1919         if($delcheck != 1) {
1920             $error->{'delitem'} = 1;
1921         }
1922     }
1923
1924     if($delete_biblio) {
1925         # We get the number of remaining items
1926         my $biblio = Koha::Biblios->find( $bibnum );
1927         my $itemcount = $biblio->items->count;
1928
1929         # If there are no items left,
1930         if ( $itemcount == 0 ) {
1931             # We delete the record
1932             my $delcheck = DelBiblio($bibnum);
1933
1934             if($delcheck) {
1935                 $error->{'delbiblio'} = 1;
1936             }
1937         }
1938     }
1939
1940     return $error;
1941 }
1942
1943 =head3 TransferOrder
1944
1945     my $newordernumber = TransferOrder($ordernumber, $basketno);
1946
1947 Transfer an order line to a basket.
1948 Mark $ordernumber as cancelled with an internal note 'Cancelled and transferred
1949 to BOOKSELLER on DATE' and create new order with internal note
1950 'Transferred from BOOKSELLER on DATE'.
1951 Move all attached items to the new order.
1952 Received orders cannot be transferred.
1953 Return the ordernumber of created order.
1954
1955 =cut
1956
1957 sub TransferOrder {
1958     my ($ordernumber, $basketno) = @_;
1959
1960     return unless ($ordernumber and $basketno);
1961
1962     my $order = Koha::Acquisition::Orders->find( $ordernumber ) or return;
1963     return if $order->datereceived;
1964
1965     $order = $order->unblessed;
1966
1967     my $basket = GetBasket($basketno);
1968     return unless $basket;
1969
1970     my $dbh = C4::Context->dbh;
1971     my ($query, $sth, $rv);
1972
1973     $query = q{
1974         UPDATE aqorders
1975         SET datecancellationprinted = CAST(NOW() AS date), orderstatus = ?
1976         WHERE ordernumber = ?
1977     };
1978     $sth = $dbh->prepare($query);
1979     $rv = $sth->execute('cancelled', $ordernumber);
1980
1981     delete $order->{'ordernumber'};
1982     delete $order->{parent_ordernumber};
1983     $order->{'basketno'} = $basketno;
1984
1985     my $newordernumber = Koha::Acquisition::Order->new($order)->store->ordernumber;
1986
1987     $query = q{
1988         UPDATE aqorders_items
1989         SET ordernumber = ?
1990         WHERE ordernumber = ?
1991     };
1992     $sth = $dbh->prepare($query);
1993     $sth->execute($newordernumber, $ordernumber);
1994
1995     $query = q{
1996         INSERT INTO aqorders_transfers (ordernumber_from, ordernumber_to)
1997         VALUES (?, ?)
1998     };
1999     $sth = $dbh->prepare($query);
2000     $sth->execute($ordernumber, $newordernumber);
2001
2002     return $newordernumber;
2003 }
2004
2005 =head2 FUNCTIONS ABOUT PARCELS
2006
2007 =head3 GetParcels
2008
2009   $results = &GetParcels($bookseller, $order, $code, $datefrom, $dateto);
2010
2011 get a lists of parcels.
2012
2013 * Input arg :
2014
2015 =over
2016
2017 =item $bookseller
2018 is the bookseller this function has to get parcels.
2019
2020 =item $order
2021 To know on what criteria the results list has to be ordered.
2022
2023 =item $code
2024 is the booksellerinvoicenumber.
2025
2026 =item $datefrom & $dateto
2027 to know on what date this function has to filter its search.
2028
2029 =back
2030
2031 * return:
2032 a pointer on a hash list containing parcel informations as such :
2033
2034 =over
2035
2036 =item Creation date
2037
2038 =item Last operation
2039
2040 =item Number of biblio
2041
2042 =item Number of items
2043
2044 =back
2045
2046 =cut
2047
2048 sub GetParcels {
2049     my ($bookseller,$order, $code, $datefrom, $dateto) = @_;
2050     my $dbh    = C4::Context->dbh;
2051     my @query_params = ();
2052     my $strsth ="
2053         SELECT  aqinvoices.invoicenumber,
2054                 datereceived,purchaseordernumber,
2055                 count(DISTINCT biblionumber) AS biblio,
2056                 sum(quantity) AS itemsexpected,
2057                 sum(quantityreceived) AS itemsreceived
2058         FROM   aqorders LEFT JOIN aqbasket ON aqbasket.basketno = aqorders.basketno
2059         LEFT JOIN aqinvoices ON aqorders.invoiceid = aqinvoices.invoiceid
2060         WHERE aqbasket.booksellerid = ? and datereceived IS NOT NULL
2061     ";
2062     push @query_params, $bookseller;
2063
2064     if ( defined $code ) {
2065         $strsth .= ' and aqinvoices.invoicenumber like ? ';
2066         # add a % to the end of the code to allow stemming.
2067         push @query_params, "$code%";
2068     }
2069
2070     if ( defined $datefrom ) {
2071         $strsth .= ' and datereceived >= ? ';
2072         push @query_params, $datefrom;
2073     }
2074
2075     if ( defined $dateto ) {
2076         $strsth .=  'and datereceived <= ? ';
2077         push @query_params, $dateto;
2078     }
2079
2080     $strsth .= "group by aqinvoices.invoicenumber,datereceived ";
2081
2082     # can't use a placeholder to place this column name.
2083     # but, we could probably be checking to make sure it is a column that will be fetched.
2084     $strsth .= "order by $order " if ($order);
2085
2086     my $sth = $dbh->prepare($strsth);
2087
2088     $sth->execute( @query_params );
2089     my $results = $sth->fetchall_arrayref({});
2090     return @{$results};
2091 }
2092
2093 #------------------------------------------------------------#
2094
2095 =head3 GetLateOrders
2096
2097   @results = &GetLateOrders;
2098
2099 Searches for bookseller with late orders.
2100
2101 return:
2102 the table of supplier with late issues. This table is full of hashref.
2103
2104 =cut
2105
2106 sub GetLateOrders {
2107     my $delay      = shift;
2108     my $supplierid = shift;
2109     my $branch     = shift;
2110     my $estimateddeliverydatefrom = shift;
2111     my $estimateddeliverydateto = shift;
2112
2113     my $dbh = C4::Context->dbh;
2114
2115     #BEWARE, order of parenthesis and LEFT JOIN is important for speed
2116     my $dbdriver = C4::Context->config("db_scheme") || "mysql";
2117
2118     my @query_params = ();
2119     my $select = "
2120     SELECT aqbasket.basketno,
2121         aqorders.ordernumber,
2122         DATE(aqbasket.closedate)  AS orderdate,
2123         aqbasket.basketname       AS basketname,
2124         aqbasket.basketgroupid    AS basketgroupid,
2125         aqbasketgroups.name       AS basketgroupname,
2126         aqorders.rrp              AS unitpricesupplier,
2127         aqorders.ecost            AS unitpricelib,
2128         aqorders.claims_count     AS claims_count,
2129         aqorders.claimed_date     AS claimed_date,
2130         aqbudgets.budget_name     AS budget,
2131         borrowers.branchcode      AS branch,
2132         aqbooksellers.name        AS supplier,
2133         aqbooksellers.id          AS supplierid,
2134         biblio.author, biblio.title,
2135         biblioitems.publishercode AS publisher,
2136         biblioitems.publicationyear,
2137         ADDDATE(aqbasket.closedate, INTERVAL aqbooksellers.deliverytime DAY) AS estimateddeliverydate,
2138     ";
2139     my $from = "
2140     FROM
2141         aqorders LEFT JOIN biblio     ON biblio.biblionumber         = aqorders.biblionumber
2142         LEFT JOIN biblioitems         ON biblioitems.biblionumber    = biblio.biblionumber
2143         LEFT JOIN aqbudgets           ON aqorders.budget_id          = aqbudgets.budget_id,
2144         aqbasket LEFT JOIN borrowers  ON aqbasket.authorisedby       = borrowers.borrowernumber
2145         LEFT JOIN aqbooksellers       ON aqbasket.booksellerid       = aqbooksellers.id
2146         LEFT JOIN aqbasketgroups      ON aqbasket.basketgroupid      = aqbasketgroups.id
2147         WHERE aqorders.basketno = aqbasket.basketno
2148         AND ( datereceived = ''
2149             OR datereceived IS NULL
2150             OR aqorders.quantityreceived < aqorders.quantity
2151         )
2152         AND aqbasket.closedate IS NOT NULL
2153         AND (aqorders.datecancellationprinted IS NULL OR aqorders.datecancellationprinted='0000-00-00')
2154     ";
2155     if ($dbdriver eq "mysql") {
2156         $select .= "
2157         aqorders.quantity - COALESCE(aqorders.quantityreceived,0)                 AS quantity,
2158         (aqorders.quantity - COALESCE(aqorders.quantityreceived,0)) * aqorders.rrp AS subtotal,
2159         DATEDIFF(CAST(now() AS date),closedate) AS latesince
2160         ";
2161         if ( defined $delay ) {
2162             $from .= " AND (closedate <= DATE_SUB(CAST(now() AS date),INTERVAL ? DAY)) " ;
2163             push @query_params, $delay;
2164         }
2165         $from .= " AND aqorders.quantity - COALESCE(aqorders.quantityreceived,0) <> 0";
2166     } else {
2167         # FIXME: account for IFNULL as above
2168         $select .= "
2169                 aqorders.quantity                AS quantity,
2170                 aqorders.quantity * aqorders.rrp AS subtotal,
2171                 (CAST(now() AS date) - closedate)            AS latesince
2172         ";
2173         if ( defined $delay ) {
2174             $from .= " AND (closedate <= (CAST(now() AS date) -(INTERVAL ? DAY)) ";
2175             push @query_params, $delay;
2176         }
2177         $from .= " AND aqorders.quantity <> 0";
2178     }
2179     if (defined $supplierid) {
2180         $from .= ' AND aqbasket.booksellerid = ? ';
2181         push @query_params, $supplierid;
2182     }
2183     if (defined $branch) {
2184         $from .= ' AND borrowers.branchcode LIKE ? ';
2185         push @query_params, $branch;
2186     }
2187
2188     if ( defined $estimateddeliverydatefrom or defined $estimateddeliverydateto ) {
2189         $from .= ' AND aqbooksellers.deliverytime IS NOT NULL ';
2190     }
2191     if ( defined $estimateddeliverydatefrom ) {
2192         $from .= ' AND ADDDATE(aqbasket.closedate, INTERVAL aqbooksellers.deliverytime DAY) >= ?';
2193         push @query_params, $estimateddeliverydatefrom;
2194     }
2195     if ( defined $estimateddeliverydateto ) {
2196         $from .= ' AND ADDDATE(aqbasket.closedate, INTERVAL aqbooksellers.deliverytime DAY) <= ?';
2197         push @query_params, $estimateddeliverydateto;
2198     }
2199     if ( defined $estimateddeliverydatefrom and not defined $estimateddeliverydateto ) {
2200         $from .= ' AND ADDDATE(aqbasket.closedate, INTERVAL aqbooksellers.deliverytime DAY) <= CAST(now() AS date)';
2201     }
2202     if (C4::Context->preference("IndependentBranches")
2203             && !C4::Context->IsSuperLibrarian() ) {
2204         $from .= ' AND borrowers.branchcode LIKE ? ';
2205         push @query_params, C4::Context->userenv->{branch};
2206     }
2207     $from .= " AND orderstatus <> 'cancelled' ";
2208     my $query = "$select $from \nORDER BY latesince, basketno, borrowers.branchcode, supplier";
2209     $debug and print STDERR "GetLateOrders query: $query\nGetLateOrders args: " . join(" ",@query_params);
2210     my $sth = $dbh->prepare($query);
2211     $sth->execute(@query_params);
2212     my @results;
2213     while (my $data = $sth->fetchrow_hashref) {
2214         push @results, $data;
2215     }
2216     return @results;
2217 }
2218
2219 #------------------------------------------------------------#
2220
2221 =head3 GetHistory
2222
2223   \@order_loop = GetHistory( %params );
2224
2225 Retreives some acquisition history information
2226
2227 params:
2228   title
2229   author
2230   name
2231   isbn
2232   ean
2233   from_placed_on
2234   to_placed_on
2235   basket                  - search both basket name and number
2236   booksellerinvoicenumber
2237   basketgroupname
2238   budget
2239   orderstatus (note that orderstatus '' will retrieve orders
2240                of any status except cancelled)
2241   biblionumber
2242   get_canceled_order (if set to a true value, cancelled orders will
2243                       be included)
2244
2245 returns:
2246     $order_loop is a list of hashrefs that each look like this:
2247             {
2248                 'author'           => 'Twain, Mark',
2249                 'basketno'         => '1',
2250                 'biblionumber'     => '215',
2251                 'count'            => 1,
2252                 'creationdate'     => 'MM/DD/YYYY',
2253                 'datereceived'     => undef,
2254                 'ecost'            => '1.00',
2255                 'id'               => '1',
2256                 'invoicenumber'    => undef,
2257                 'name'             => '',
2258                 'ordernumber'      => '1',
2259                 'quantity'         => 1,
2260                 'quantityreceived' => undef,
2261                 'title'            => 'The Adventures of Huckleberry Finn'
2262             }
2263
2264 =cut
2265
2266 sub GetHistory {
2267 # don't run the query if there are no parameters (list would be too long for sure !)
2268     croak "No search params" unless @_;
2269     my %params = @_;
2270     my $title = $params{title};
2271     my $author = $params{author};
2272     my $isbn   = $params{isbn};
2273     my $ean    = $params{ean};
2274     my $name = $params{name};
2275     my $from_placed_on = $params{from_placed_on};
2276     my $to_placed_on = $params{to_placed_on};
2277     my $basket = $params{basket};
2278     my $booksellerinvoicenumber = $params{booksellerinvoicenumber};
2279     my $basketgroupname = $params{basketgroupname};
2280     my $budget = $params{budget};
2281     my $orderstatus = $params{orderstatus};
2282     my $biblionumber = $params{biblionumber};
2283     my $get_canceled_order = $params{get_canceled_order} || 0;
2284     my $ordernumber = $params{ordernumber};
2285     my $search_children_too = $params{search_children_too} || 0;
2286     my $created_by = $params{created_by} || [];
2287
2288     my @order_loop;
2289     my $total_qty         = 0;
2290     my $total_qtyreceived = 0;
2291     my $total_price       = 0;
2292
2293     #get variation of isbn
2294     my @isbn_params;
2295     my @isbns;
2296     if ($isbn){
2297         if ( C4::Context->preference("SearchWithISBNVariations") ){
2298             @isbns = C4::Koha::GetVariationsOfISBN( $isbn );
2299             foreach my $isb (@isbns){
2300                 push @isbn_params, '?';
2301             }
2302         }
2303         unless (@isbns){
2304             push @isbns, $isbn;
2305             push @isbn_params, '?';
2306         }
2307     }
2308
2309     my $dbh   = C4::Context->dbh;
2310     my $query ="
2311         SELECT
2312             COALESCE(biblio.title,     deletedbiblio.title)     AS title,
2313             COALESCE(biblio.author,    deletedbiblio.author)    AS author,
2314             COALESCE(biblioitems.isbn, deletedbiblioitems.isbn) AS isbn,
2315             COALESCE(biblioitems.ean,  deletedbiblioitems.ean)  AS ean,
2316             aqorders.basketno,
2317             aqbasket.basketname,
2318             aqbasket.basketgroupid,
2319             aqbasket.authorisedby,
2320             concat( borrowers.firstname,' ',borrowers.surname) AS authorisedbyname,
2321             aqbasketgroups.name as groupname,
2322             aqbooksellers.name,
2323             aqbasket.creationdate,
2324             aqorders.datereceived,
2325             aqorders.quantity,
2326             aqorders.quantityreceived,
2327             aqorders.ecost,
2328             aqorders.ordernumber,
2329             aqorders.invoiceid,
2330             aqinvoices.invoicenumber,
2331             aqbooksellers.id as id,
2332             aqorders.biblionumber,
2333             aqorders.orderstatus,
2334             aqorders.parent_ordernumber,
2335             aqbudgets.budget_name
2336             ";
2337     $query .= ", aqbudgets.budget_id AS budget" if defined $budget;
2338     $query .= "
2339         FROM aqorders
2340         LEFT JOIN aqbasket ON aqorders.basketno=aqbasket.basketno
2341         LEFT JOIN aqbasketgroups ON aqbasket.basketgroupid=aqbasketgroups.id
2342         LEFT JOIN aqbooksellers ON aqbasket.booksellerid=aqbooksellers.id
2343         LEFT JOIN biblioitems ON biblioitems.biblionumber=aqorders.biblionumber
2344         LEFT JOIN biblio ON biblio.biblionumber=aqorders.biblionumber
2345         LEFT JOIN aqbudgets ON aqorders.budget_id=aqbudgets.budget_id
2346         LEFT JOIN aqinvoices ON aqorders.invoiceid = aqinvoices.invoiceid
2347         LEFT JOIN deletedbiblio ON deletedbiblio.biblionumber=aqorders.biblionumber
2348         LEFT JOIN deletedbiblioitems ON deletedbiblioitems.biblionumber=aqorders.biblionumber
2349         LEFT JOIN borrowers ON aqbasket.authorisedby=borrowers.borrowernumber
2350         ";
2351
2352     $query .= " WHERE 1 ";
2353
2354     unless ($get_canceled_order or (defined $orderstatus and $orderstatus eq 'cancelled')) {
2355         $query .= " AND (datecancellationprinted is NULL or datecancellationprinted='0000-00-00') ";
2356     }
2357
2358     my @query_params  = ();
2359
2360     if ( $biblionumber ) {
2361         $query .= " AND biblio.biblionumber = ?";
2362         push @query_params, $biblionumber;
2363     }
2364
2365     if ( $title ) {
2366         $query .= " AND biblio.title LIKE ? ";
2367         $title =~ s/\s+/%/g;
2368         push @query_params, "%$title%";
2369     }
2370
2371     if ( $author ) {
2372         $query .= " AND biblio.author LIKE ? ";
2373         push @query_params, "%$author%";
2374     }
2375
2376     if ( @isbns ) {
2377         $query .= " AND ( biblioitems.isbn LIKE " . join (" OR biblioitems.isbn LIKE ", @isbn_params ) . ")";
2378         foreach my $isb (@isbns){
2379             push @query_params, "%$isb%";
2380         }
2381     }
2382
2383     if ( $ean ) {
2384         $query .= " AND biblioitems.ean = ? ";
2385         push @query_params, "$ean";
2386     }
2387     if ( $name ) {
2388         $query .= " AND aqbooksellers.name LIKE ? ";
2389         push @query_params, "%$name%";
2390     }
2391
2392     if ( $budget ) {
2393         $query .= " AND aqbudgets.budget_id = ? ";
2394         push @query_params, "$budget";
2395     }
2396
2397     if ( $from_placed_on ) {
2398         $query .= " AND creationdate >= ? ";
2399         push @query_params, $from_placed_on;
2400     }
2401
2402     if ( $to_placed_on ) {
2403         $query .= " AND creationdate <= ? ";
2404         push @query_params, $to_placed_on;
2405     }
2406
2407     if ( defined $orderstatus and $orderstatus ne '') {
2408         $query .= " AND aqorders.orderstatus = ? ";
2409         push @query_params, "$orderstatus";
2410     }
2411
2412     if ($basket) {
2413         if ($basket =~ m/^\d+$/) {
2414             $query .= " AND aqorders.basketno = ? ";
2415             push @query_params, $basket;
2416         } else {
2417             $query .= " AND aqbasket.basketname LIKE ? ";
2418             push @query_params, "%$basket%";
2419         }
2420     }
2421
2422     if ($booksellerinvoicenumber) {
2423         $query .= " AND aqinvoices.invoicenumber LIKE ? ";
2424         push @query_params, "%$booksellerinvoicenumber%";
2425     }
2426
2427     if ($basketgroupname) {
2428         $query .= " AND aqbasketgroups.name LIKE ? ";
2429         push @query_params, "%$basketgroupname%";
2430     }
2431
2432     if ($ordernumber) {
2433         $query .= " AND (aqorders.ordernumber = ? ";
2434         push @query_params, $ordernumber;
2435         if ($search_children_too) {
2436             $query .= " OR aqorders.parent_ordernumber = ? ";
2437             push @query_params, $ordernumber;
2438         }
2439         $query .= ") ";
2440     }
2441
2442     if ( @$created_by ) {
2443         $query .= ' AND aqbasket.authorisedby IN ( ' . join( ',', ('?') x @$created_by ) . ')';
2444         push @query_params, @$created_by;
2445     }
2446
2447
2448     if ( C4::Context->preference("IndependentBranches") ) {
2449         unless ( C4::Context->IsSuperLibrarian() ) {
2450             $query .= " AND (borrowers.branchcode = ? OR borrowers.branchcode ='' ) ";
2451             push @query_params, C4::Context->userenv->{branch};
2452         }
2453     }
2454     $query .= " ORDER BY id";
2455
2456     return $dbh->selectall_arrayref( $query, { Slice => {} }, @query_params );
2457 }
2458
2459 =head2 GetRecentAcqui
2460
2461   $results = GetRecentAcqui($days);
2462
2463 C<$results> is a ref to a table which contains hashref
2464
2465 =cut
2466
2467 sub GetRecentAcqui {
2468     my $limit  = shift;
2469     my $dbh    = C4::Context->dbh;
2470     my $query = "
2471         SELECT *
2472         FROM   biblio
2473         ORDER BY timestamp DESC
2474         LIMIT  0,".$limit;
2475
2476     my $sth = $dbh->prepare($query);
2477     $sth->execute;
2478     my $results = $sth->fetchall_arrayref({});
2479     return $results;
2480 }
2481
2482 #------------------------------------------------------------#
2483
2484 =head3 AddClaim
2485
2486   &AddClaim($ordernumber);
2487
2488 Add a claim for an order
2489
2490 =cut
2491
2492 sub AddClaim {
2493     my ($ordernumber) = @_;
2494     my $dbh          = C4::Context->dbh;
2495     my $query        = "
2496         UPDATE aqorders SET
2497             claims_count = claims_count + 1,
2498             claimed_date = CURDATE()
2499         WHERE ordernumber = ?
2500         ";
2501     my $sth = $dbh->prepare($query);
2502     $sth->execute($ordernumber);
2503 }
2504
2505 =head3 GetInvoices
2506
2507     my @invoices = GetInvoices(
2508         invoicenumber => $invoicenumber,
2509         supplierid => $supplierid,
2510         suppliername => $suppliername,
2511         shipmentdatefrom => $shipmentdatefrom, # ISO format
2512         shipmentdateto => $shipmentdateto, # ISO format
2513         billingdatefrom => $billingdatefrom, # ISO format
2514         billingdateto => $billingdateto, # ISO format
2515         isbneanissn => $isbn_or_ean_or_issn,
2516         title => $title,
2517         author => $author,
2518         publisher => $publisher,
2519         publicationyear => $publicationyear,
2520         branchcode => $branchcode,
2521         order_by => $order_by
2522     );
2523
2524 Return a list of invoices that match all given criteria.
2525
2526 $order_by is "column_name (asc|desc)", where column_name is any of
2527 'invoicenumber', 'booksellerid', 'shipmentdate', 'billingdate', 'closedate',
2528 'shipmentcost', 'shipmentcost_budgetid'.
2529
2530 asc is the default if omitted
2531
2532 =cut
2533
2534 sub GetInvoices {
2535     my %args = @_;
2536
2537     my @columns = qw(invoicenumber booksellerid shipmentdate billingdate
2538         closedate shipmentcost shipmentcost_budgetid);
2539
2540     my $dbh = C4::Context->dbh;
2541     my $query = qq{
2542         SELECT aqinvoices.invoiceid, aqinvoices.invoicenumber, aqinvoices.booksellerid, aqinvoices.shipmentdate, aqinvoices.billingdate, aqinvoices.closedate, aqinvoices.shipmentcost, aqinvoices.shipmentcost_budgetid, aqinvoices.message_id,
2543             aqbooksellers.name AS suppliername,
2544           COUNT(
2545             DISTINCT IF(
2546               aqorders.datereceived IS NOT NULL,
2547               aqorders.biblionumber,
2548               NULL
2549             )
2550           ) AS receivedbiblios,
2551           COUNT(
2552              DISTINCT IF(
2553               aqorders.subscriptionid IS NOT NULL,
2554               aqorders.subscriptionid,
2555               NULL
2556             )
2557           ) AS is_linked_to_subscriptions,
2558           SUM(aqorders.quantityreceived) AS receiveditems
2559         FROM aqinvoices
2560           LEFT JOIN aqbooksellers ON aqbooksellers.id = aqinvoices.booksellerid
2561           LEFT JOIN aqorders ON aqorders.invoiceid = aqinvoices.invoiceid
2562           LEFT JOIN aqbasket ON aqbasket.basketno=aqorders.basketno
2563           LEFT JOIN borrowers ON aqbasket.authorisedby=borrowers.borrowernumber
2564           LEFT JOIN biblio ON aqorders.biblionumber = biblio.biblionumber
2565           LEFT JOIN biblioitems ON biblio.biblionumber = biblioitems.biblionumber
2566           LEFT JOIN subscription ON biblio.biblionumber = subscription.biblionumber
2567     };
2568
2569     my @bind_args;
2570     my @bind_strs;
2571     if($args{supplierid}) {
2572         push @bind_strs, " aqinvoices.booksellerid = ? ";
2573         push @bind_args, $args{supplierid};
2574     }
2575     if($args{invoicenumber}) {
2576         push @bind_strs, " aqinvoices.invoicenumber LIKE ? ";
2577         push @bind_args, "%$args{invoicenumber}%";
2578     }
2579     if($args{suppliername}) {
2580         push @bind_strs, " aqbooksellers.name LIKE ? ";
2581         push @bind_args, "%$args{suppliername}%";
2582     }
2583     if($args{shipmentdatefrom}) {
2584         push @bind_strs, " aqinvoices.shipmentdate >= ? ";
2585         push @bind_args, $args{shipmentdatefrom};
2586     }
2587     if($args{shipmentdateto}) {
2588         push @bind_strs, " aqinvoices.shipmentdate <= ? ";
2589         push @bind_args, $args{shipmentdateto};
2590     }
2591     if($args{billingdatefrom}) {
2592         push @bind_strs, " aqinvoices.billingdate >= ? ";
2593         push @bind_args, $args{billingdatefrom};
2594     }
2595     if($args{billingdateto}) {
2596         push @bind_strs, " aqinvoices.billingdate <= ? ";
2597         push @bind_args, $args{billingdateto};
2598     }
2599     if($args{isbneanissn}) {
2600         push @bind_strs, " (biblioitems.isbn LIKE CONCAT('%', ?, '%') OR biblioitems.ean LIKE CONCAT('%', ?, '%') OR biblioitems.issn LIKE CONCAT('%', ?, '%') ) ";
2601         push @bind_args, $args{isbneanissn}, $args{isbneanissn}, $args{isbneanissn};
2602     }
2603     if($args{title}) {
2604         push @bind_strs, " biblio.title LIKE CONCAT('%', ?, '%') ";
2605         push @bind_args, $args{title};
2606     }
2607     if($args{author}) {
2608         push @bind_strs, " biblio.author LIKE CONCAT('%', ?, '%') ";
2609         push @bind_args, $args{author};
2610     }
2611     if($args{publisher}) {
2612         push @bind_strs, " biblioitems.publishercode LIKE CONCAT('%', ?, '%') ";
2613         push @bind_args, $args{publisher};
2614     }
2615     if($args{publicationyear}) {
2616         push @bind_strs, " ((biblioitems.publicationyear LIKE CONCAT('%', ?, '%')) OR (biblio.copyrightdate LIKE CONCAT('%', ?, '%'))) ";
2617         push @bind_args, $args{publicationyear}, $args{publicationyear};
2618     }
2619     if($args{branchcode}) {
2620         push @bind_strs, " borrowers.branchcode = ? ";
2621         push @bind_args, $args{branchcode};
2622     }
2623     if($args{message_id}) {
2624         push @bind_strs, " aqinvoices.message_id = ? ";
2625         push @bind_args, $args{message_id};
2626     }
2627
2628     $query .= " WHERE " . join(" AND ", @bind_strs) if @bind_strs;
2629     $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";
2630
2631     if($args{order_by}) {
2632         my ($column, $direction) = split / /, $args{order_by};
2633         if(grep /^$column$/, @columns) {
2634             $direction ||= 'ASC';
2635             $query .= " ORDER BY $column $direction";
2636         }
2637     }
2638
2639     my $sth = $dbh->prepare($query);
2640     $sth->execute(@bind_args);
2641
2642     my $results = $sth->fetchall_arrayref({});
2643     return @$results;
2644 }
2645
2646 =head3 GetInvoice
2647
2648     my $invoice = GetInvoice($invoiceid);
2649
2650 Get informations about invoice with given $invoiceid
2651
2652 Return a hash filled with aqinvoices.* fields
2653
2654 =cut
2655
2656 sub GetInvoice {
2657     my ($invoiceid) = @_;
2658     my $invoice;
2659
2660     return unless $invoiceid;
2661
2662     my $dbh = C4::Context->dbh;
2663     my $query = qq{
2664         SELECT *
2665         FROM aqinvoices
2666         WHERE invoiceid = ?
2667     };
2668     my $sth = $dbh->prepare($query);
2669     $sth->execute($invoiceid);
2670
2671     $invoice = $sth->fetchrow_hashref;
2672     return $invoice;
2673 }
2674
2675 =head3 GetInvoiceDetails
2676
2677     my $invoice = GetInvoiceDetails($invoiceid)
2678
2679 Return informations about an invoice + the list of related order lines
2680
2681 Orders informations are in $invoice->{orders} (array ref)
2682
2683 =cut
2684
2685 sub GetInvoiceDetails {
2686     my ($invoiceid) = @_;
2687
2688     if ( !defined $invoiceid ) {
2689         carp 'GetInvoiceDetails called without an invoiceid';
2690         return;
2691     }
2692
2693     my $dbh = C4::Context->dbh;
2694     my $query = q{
2695         SELECT aqinvoices.*, aqbooksellers.name AS suppliername
2696         FROM aqinvoices
2697           LEFT JOIN aqbooksellers ON aqinvoices.booksellerid = aqbooksellers.id
2698         WHERE invoiceid = ?
2699     };
2700     my $sth = $dbh->prepare($query);
2701     $sth->execute($invoiceid);
2702
2703     my $invoice = $sth->fetchrow_hashref;
2704
2705     $query = q{
2706         SELECT aqorders.*,
2707                 biblio.*,
2708                 biblio.copyrightdate,
2709                 biblioitems.isbn,
2710                 biblioitems.publishercode,
2711                 biblioitems.publicationyear,
2712                 aqbasket.basketname,
2713                 aqbasketgroups.id AS basketgroupid,
2714                 aqbasketgroups.name AS basketgroupname
2715         FROM aqorders
2716           LEFT JOIN aqbasket ON aqorders.basketno = aqbasket.basketno
2717           LEFT JOIN aqbasketgroups ON aqbasket.basketgroupid = aqbasketgroups.id
2718           LEFT JOIN biblio ON aqorders.biblionumber = biblio.biblionumber
2719           LEFT JOIN biblioitems ON aqorders.biblionumber = biblioitems.biblionumber
2720         WHERE invoiceid = ?
2721     };
2722     $sth = $dbh->prepare($query);
2723     $sth->execute($invoiceid);
2724     $invoice->{orders} = $sth->fetchall_arrayref({});
2725     $invoice->{orders} ||= []; # force an empty arrayref if fetchall_arrayref fails
2726
2727     return $invoice;
2728 }
2729
2730 =head3 AddInvoice
2731
2732     my $invoiceid = AddInvoice(
2733         invoicenumber => $invoicenumber,
2734         booksellerid => $booksellerid,
2735         shipmentdate => $shipmentdate,
2736         billingdate => $billingdate,
2737         closedate => $closedate,
2738         shipmentcost => $shipmentcost,
2739         shipmentcost_budgetid => $shipmentcost_budgetid
2740     );
2741
2742 Create a new invoice and return its id or undef if it fails.
2743
2744 =cut
2745
2746 sub AddInvoice {
2747     my %invoice = @_;
2748
2749     return unless(%invoice and $invoice{invoicenumber});
2750
2751     my @columns = qw(invoicenumber booksellerid shipmentdate billingdate
2752         closedate shipmentcost shipmentcost_budgetid message_id);
2753
2754     my @set_strs;
2755     my @set_args;
2756     foreach my $key (keys %invoice) {
2757         if(0 < grep(/^$key$/, @columns)) {
2758             push @set_strs, "$key = ?";
2759             push @set_args, ($invoice{$key} || undef);
2760         }
2761     }
2762
2763     my $rv;
2764     if(@set_args > 0) {
2765         my $dbh = C4::Context->dbh;
2766         my $query = "INSERT INTO aqinvoices SET ";
2767         $query .= join (",", @set_strs);
2768         my $sth = $dbh->prepare($query);
2769         $rv = $sth->execute(@set_args);
2770         if($rv) {
2771             $rv = $dbh->last_insert_id(undef, undef, 'aqinvoices', undef);
2772         }
2773     }
2774     return $rv;
2775 }
2776
2777 =head3 ModInvoice
2778
2779     ModInvoice(
2780         invoiceid => $invoiceid,    # Mandatory
2781         invoicenumber => $invoicenumber,
2782         booksellerid => $booksellerid,
2783         shipmentdate => $shipmentdate,
2784         billingdate => $billingdate,
2785         closedate => $closedate,
2786         shipmentcost => $shipmentcost,
2787         shipmentcost_budgetid => $shipmentcost_budgetid
2788     );
2789
2790 Modify an invoice, invoiceid is mandatory.
2791
2792 Return undef if it fails.
2793
2794 =cut
2795
2796 sub ModInvoice {
2797     my %invoice = @_;
2798
2799     return unless(%invoice and $invoice{invoiceid});
2800
2801     my @columns = qw(invoicenumber booksellerid shipmentdate billingdate
2802         closedate shipmentcost shipmentcost_budgetid);
2803
2804     my @set_strs;
2805     my @set_args;
2806     foreach my $key (keys %invoice) {
2807         if(0 < grep(/^$key$/, @columns)) {
2808             push @set_strs, "$key = ?";
2809             push @set_args, ($invoice{$key} || undef);
2810         }
2811     }
2812
2813     my $dbh = C4::Context->dbh;
2814     my $query = "UPDATE aqinvoices SET ";
2815     $query .= join(",", @set_strs);
2816     $query .= " WHERE invoiceid = ?";
2817
2818     my $sth = $dbh->prepare($query);
2819     $sth->execute(@set_args, $invoice{invoiceid});
2820 }
2821
2822 =head3 CloseInvoice
2823
2824     CloseInvoice($invoiceid);
2825
2826 Close an invoice.
2827
2828 Equivalent to ModInvoice(invoiceid => $invoiceid, closedate => undef);
2829
2830 =cut
2831
2832 sub CloseInvoice {
2833     my ($invoiceid) = @_;
2834
2835     return unless $invoiceid;
2836
2837     my $dbh = C4::Context->dbh;
2838     my $query = qq{
2839         UPDATE aqinvoices
2840         SET closedate = CAST(NOW() AS DATE)
2841         WHERE invoiceid = ?
2842     };
2843     my $sth = $dbh->prepare($query);
2844     $sth->execute($invoiceid);
2845 }
2846
2847 =head3 ReopenInvoice
2848
2849     ReopenInvoice($invoiceid);
2850
2851 Reopen an invoice
2852
2853 Equivalent to ModInvoice(invoiceid => $invoiceid, closedate => output_pref({ dt=>dt_from_string, dateonly=>1, otputpref=>'iso' }))
2854
2855 =cut
2856
2857 sub ReopenInvoice {
2858     my ($invoiceid) = @_;
2859
2860     return unless $invoiceid;
2861
2862     my $dbh = C4::Context->dbh;
2863     my $query = qq{
2864         UPDATE aqinvoices
2865         SET closedate = NULL
2866         WHERE invoiceid = ?
2867     };
2868     my $sth = $dbh->prepare($query);
2869     $sth->execute($invoiceid);
2870 }
2871
2872 =head3 DelInvoice
2873
2874     DelInvoice($invoiceid);
2875
2876 Delete an invoice if there are no items attached to it.
2877
2878 =cut
2879
2880 sub DelInvoice {
2881     my ($invoiceid) = @_;
2882
2883     return unless $invoiceid;
2884
2885     my $dbh   = C4::Context->dbh;
2886     my $query = qq{
2887         SELECT COUNT(*)
2888         FROM aqorders
2889         WHERE invoiceid = ?
2890     };
2891     my $sth = $dbh->prepare($query);
2892     $sth->execute($invoiceid);
2893     my $res = $sth->fetchrow_arrayref;
2894     if ( $res && $res->[0] == 0 ) {
2895         $query = qq{
2896             DELETE FROM aqinvoices
2897             WHERE invoiceid = ?
2898         };
2899         my $sth = $dbh->prepare($query);
2900         return ( $sth->execute($invoiceid) > 0 );
2901     }
2902     return;
2903 }
2904
2905 =head3 MergeInvoices
2906
2907     MergeInvoices($invoiceid, \@sourceids);
2908
2909 Merge the invoices identified by the IDs in \@sourceids into
2910 the invoice identified by $invoiceid.
2911
2912 =cut
2913
2914 sub MergeInvoices {
2915     my ($invoiceid, $sourceids) = @_;
2916
2917     return unless $invoiceid;
2918     foreach my $sourceid (@$sourceids) {
2919         next if $sourceid == $invoiceid;
2920         my $source = GetInvoiceDetails($sourceid);
2921         foreach my $order (@{$source->{'orders'}}) {
2922             $order->{'invoiceid'} = $invoiceid;
2923             ModOrder($order);
2924         }
2925         DelInvoice($source->{'invoiceid'});
2926     }
2927     return;
2928 }
2929
2930 =head3 GetBiblioCountByBasketno
2931
2932 $biblio_count = &GetBiblioCountByBasketno($basketno);
2933
2934 Looks up the biblio's count that has basketno value $basketno
2935
2936 Returns a quantity
2937
2938 =cut
2939
2940 sub GetBiblioCountByBasketno {
2941     my ($basketno) = @_;
2942     my $dbh          = C4::Context->dbh;
2943     my $query        = "
2944         SELECT COUNT( DISTINCT( biblionumber ) )
2945         FROM   aqorders
2946         WHERE  basketno = ?
2947             AND (datecancellationprinted IS NULL OR datecancellationprinted='0000-00-00')
2948         ";
2949
2950     my $sth = $dbh->prepare($query);
2951     $sth->execute($basketno);
2952     return $sth->fetchrow;
2953 }
2954
2955 # Note this subroutine should be moved to Koha::Acquisition::Order
2956 # Will do when a DBIC decision will be taken.
2957 sub populate_order_with_prices {
2958     my ($params) = @_;
2959
2960     my $order        = $params->{order};
2961     my $booksellerid = $params->{booksellerid};
2962     return unless $booksellerid;
2963
2964     my $bookseller = Koha::Acquisition::Booksellers->find( $booksellerid );
2965
2966     my $receiving = $params->{receiving};
2967     my $ordering  = $params->{ordering};
2968     my $discount  = $order->{discount};
2969     $discount /= 100 if $discount > 1;
2970
2971     if ($ordering) {
2972         $order->{tax_rate_on_ordering} //= $order->{tax_rate};
2973         if ( $bookseller->listincgst ) {
2974             # The user entered the rrp tax included
2975             $order->{rrp_tax_included} = $order->{rrp};
2976
2977             # rrp tax excluded = rrp tax included / ( 1 + tax rate )
2978             $order->{rrp_tax_excluded} = $order->{rrp_tax_included} / ( 1 + $order->{tax_rate_on_ordering} );
2979
2980             # ecost tax excluded = rrp tax excluded * ( 1 - discount )
2981             $order->{ecost_tax_excluded} = $order->{rrp_tax_excluded} * ( 1 - $discount );
2982
2983             # ecost tax included = rrp tax included  ( 1 - discount )
2984             $order->{ecost_tax_included} = $order->{rrp_tax_included} * ( 1 - $discount );
2985         }
2986         else {
2987             # The user entered the rrp tax excluded
2988             $order->{rrp_tax_excluded} = $order->{rrp};
2989
2990             # rrp tax included = rrp tax excluded * ( 1 - tax rate )
2991             $order->{rrp_tax_included} = $order->{rrp_tax_excluded} * ( 1 + $order->{tax_rate_on_ordering} );
2992
2993             # ecost tax excluded = rrp tax excluded * ( 1 - discount )
2994             $order->{ecost_tax_excluded} = $order->{rrp_tax_excluded} * ( 1 - $discount );
2995
2996             # ecost tax included = rrp tax excluded * ( 1 + tax rate ) * ( 1 - discount )
2997             $order->{ecost_tax_included} =
2998                 $order->{rrp_tax_excluded} *
2999                 ( 1 + $order->{tax_rate_on_ordering} ) *
3000                 ( 1 - $discount );
3001         }
3002
3003         # tax value = quantity * ecost tax excluded * tax rate
3004         $order->{tax_value_on_ordering} =
3005             $order->{quantity} * $order->{ecost_tax_excluded} * $order->{tax_rate_on_ordering};
3006     }
3007
3008     if ($receiving) {
3009         $order->{tax_rate_on_receiving} //= $order->{tax_rate};
3010         if ( $bookseller->invoiceincgst ) {
3011             # Trick for unitprice. If the unit price rounded value is the same as the ecost rounded value
3012             # we need to keep the exact ecost value
3013             if ( Koha::Number::Price->new( $order->{unitprice} )->round == Koha::Number::Price->new( $order->{ecost_tax_included} )->round ) {
3014                 $order->{unitprice} = $order->{ecost_tax_included};
3015             }
3016
3017             # The user entered the unit price tax included
3018             $order->{unitprice_tax_included} = $order->{unitprice};
3019
3020             # unit price tax excluded = unit price tax included / ( 1 + tax rate )
3021             $order->{unitprice_tax_excluded} = $order->{unitprice_tax_included} / ( 1 + $order->{tax_rate_on_receiving} );
3022         }
3023         else {
3024             # Trick for unitprice. If the unit price rounded value is the same as the ecost rounded value
3025             # we need to keep the exact ecost value
3026             if ( Koha::Number::Price->new( $order->{unitprice} )->round == Koha::Number::Price->new( $order->{ecost_tax_excluded} )->round ) {
3027                 $order->{unitprice} = $order->{ecost_tax_excluded};
3028             }
3029
3030             # The user entered the unit price tax excluded
3031             $order->{unitprice_tax_excluded} = $order->{unitprice};
3032
3033
3034             # unit price tax included = unit price tax included * ( 1 + tax rate )
3035             $order->{unitprice_tax_included} = $order->{unitprice_tax_excluded} * ( 1 + $order->{tax_rate_on_receiving} );
3036         }
3037
3038         # tax value = quantity * unit price tax excluded * tax rate
3039         $order->{tax_value_on_receiving} = $order->{quantity} * $order->{unitprice_tax_excluded} * $order->{tax_rate_on_receiving};
3040     }
3041
3042     return $order;
3043 }
3044
3045 =head3 GetOrderUsers
3046
3047     $order_users_ids = &GetOrderUsers($ordernumber);
3048
3049 Returns a list of all borrowernumbers that are in order users list
3050
3051 =cut
3052
3053 sub GetOrderUsers {
3054     my ($ordernumber) = @_;
3055
3056     return unless $ordernumber;
3057
3058     my $query = q|
3059         SELECT borrowernumber
3060         FROM aqorder_users
3061         WHERE ordernumber = ?
3062     |;
3063     my $dbh = C4::Context->dbh;
3064     my $sth = $dbh->prepare($query);
3065     $sth->execute($ordernumber);
3066     my $results = $sth->fetchall_arrayref( {} );
3067
3068     my @borrowernumbers;
3069     foreach (@$results) {
3070         push @borrowernumbers, $_->{'borrowernumber'};
3071     }
3072
3073     return @borrowernumbers;
3074 }
3075
3076 =head3 ModOrderUsers
3077
3078     my @order_users_ids = (1, 2, 3);
3079     &ModOrderUsers($ordernumber, @basketusers_ids);
3080
3081 Delete all users from order users list, and add users in C<@order_users_ids>
3082 to this users list.
3083
3084 =cut
3085
3086 sub ModOrderUsers {
3087     my ( $ordernumber, @order_users_ids ) = @_;
3088
3089     return unless $ordernumber;
3090
3091     my $dbh   = C4::Context->dbh;
3092     my $query = q|
3093         DELETE FROM aqorder_users
3094         WHERE ordernumber = ?
3095     |;
3096     my $sth = $dbh->prepare($query);
3097     $sth->execute($ordernumber);
3098
3099     $query = q|
3100         INSERT INTO aqorder_users (ordernumber, borrowernumber)
3101         VALUES (?, ?)
3102     |;
3103     $sth = $dbh->prepare($query);
3104     foreach my $order_user_id (@order_users_ids) {
3105         $sth->execute( $ordernumber, $order_user_id );
3106     }
3107 }
3108
3109 sub NotifyOrderUsers {
3110     my ($ordernumber) = @_;
3111
3112     my @borrowernumbers = GetOrderUsers($ordernumber);
3113     return unless @borrowernumbers;
3114
3115     my $order = GetOrder( $ordernumber );
3116     for my $borrowernumber (@borrowernumbers) {
3117         my $patron = Koha::Patrons->find( $borrowernumber );
3118         my $library = $patron->library->unblessed;
3119         my $biblio = Koha::Biblios->find( $order->{biblionumber} )->unblessed;
3120         my $letter = C4::Letters::GetPreparedLetter(
3121             module      => 'acquisition',
3122             letter_code => 'ACQ_NOTIF_ON_RECEIV',
3123             branchcode  => $library->{branchcode},
3124             lang        => $patron->lang,
3125             tables      => {
3126                 'branches'    => $library,
3127                 'borrowers'   => $patron->unblessed,
3128                 'biblio'      => $biblio,
3129                 'aqorders'    => $order,
3130             },
3131         );
3132         if ( $letter ) {
3133             C4::Letters::EnqueueLetter(
3134                 {
3135                     letter         => $letter,
3136                     borrowernumber => $borrowernumber,
3137                     LibraryName    => C4::Context->preference("LibraryName"),
3138                     message_transport_type => 'email',
3139                 }
3140             ) or warn "can't enqueue letter $letter";
3141         }
3142     }
3143 }
3144
3145 =head3 FillWithDefaultValues
3146
3147 FillWithDefaultValues( $marc_record );
3148
3149 This will update the record with default value defined in the ACQ framework.
3150 For all existing fields, if a default value exists and there are no subfield, it will be created.
3151 If the field does not exist, it will be created too.
3152
3153 =cut
3154
3155 sub FillWithDefaultValues {
3156     my ($record) = @_;
3157     my $tagslib = C4::Biblio::GetMarcStructure( 1, 'ACQ', { unsafe => 1 } );
3158     if ($tagslib) {
3159         my ($itemfield) =
3160           C4::Biblio::GetMarcFromKohaField( 'items.itemnumber', '' );
3161         for my $tag ( sort keys %$tagslib ) {
3162             next unless $tag;
3163             next if $tag == $itemfield;
3164             for my $subfield ( sort keys %{ $tagslib->{$tag} } ) {
3165                 next if IsMarcStructureInternal($tagslib->{$tag}{$subfield});
3166                 my $defaultvalue = $tagslib->{$tag}{$subfield}{defaultvalue};
3167                 if ( defined $defaultvalue and $defaultvalue ne '' ) {
3168                     my @fields = $record->field($tag);
3169                     if (@fields) {
3170                         for my $field (@fields) {
3171                             unless ( defined $field->subfield($subfield) ) {
3172                                 $field->add_subfields(
3173                                     $subfield => $defaultvalue );
3174                             }
3175                         }
3176                     }
3177                     else {
3178                         $record->insert_fields_ordered(
3179                             MARC::Field->new(
3180                                 $tag, '', '', $subfield => $defaultvalue
3181                             )
3182                         );
3183                     }
3184                 }
3185             }
3186         }
3187     }
3188 }
3189
3190 1;
3191 __END__
3192
3193 =head1 AUTHOR
3194
3195 Koha Development Team <http://koha-community.org/>
3196
3197 =cut