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