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