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     my $dbh   = C4::Context->dbh;
2292     my $query ="
2293         SELECT
2294             COALESCE(biblio.title,     deletedbiblio.title)     AS title,
2295             COALESCE(biblio.author,    deletedbiblio.author)    AS author,
2296             COALESCE(biblioitems.isbn, deletedbiblioitems.isbn) AS isbn,
2297             COALESCE(biblioitems.ean,  deletedbiblioitems.ean)  AS ean,
2298             aqorders.basketno,
2299             aqbasket.basketname,
2300             aqbasket.basketgroupid,
2301             aqbasket.authorisedby,
2302             concat( borrowers.firstname,' ',borrowers.surname) AS authorisedbyname,
2303             aqbasketgroups.name as groupname,
2304             aqbooksellers.name,
2305             aqbasket.creationdate,
2306             aqorders.datereceived,
2307             aqorders.quantity,
2308             aqorders.quantityreceived,
2309             aqorders.ecost,
2310             aqorders.ordernumber,
2311             aqorders.invoiceid,
2312             aqinvoices.invoicenumber,
2313             aqbooksellers.id as id,
2314             aqorders.biblionumber,
2315             aqorders.orderstatus,
2316             aqorders.parent_ordernumber,
2317             aqbudgets.budget_name
2318             ";
2319     $query .= ", aqbudgets.budget_id AS budget" if defined $budget;
2320     $query .= "
2321         FROM aqorders
2322         LEFT JOIN aqbasket ON aqorders.basketno=aqbasket.basketno
2323         LEFT JOIN aqbasketgroups ON aqbasket.basketgroupid=aqbasketgroups.id
2324         LEFT JOIN aqbooksellers ON aqbasket.booksellerid=aqbooksellers.id
2325         LEFT JOIN biblioitems ON biblioitems.biblionumber=aqorders.biblionumber
2326         LEFT JOIN biblio ON biblio.biblionumber=aqorders.biblionumber
2327         LEFT JOIN aqbudgets ON aqorders.budget_id=aqbudgets.budget_id
2328         LEFT JOIN aqinvoices ON aqorders.invoiceid = aqinvoices.invoiceid
2329         LEFT JOIN deletedbiblio ON deletedbiblio.biblionumber=aqorders.biblionumber
2330         LEFT JOIN deletedbiblioitems ON deletedbiblioitems.biblionumber=aqorders.biblionumber
2331         LEFT JOIN borrowers ON aqbasket.authorisedby=borrowers.borrowernumber
2332         ";
2333
2334     $query .= " WHERE 1 ";
2335
2336     unless ($get_canceled_order or (defined $orderstatus and $orderstatus eq 'cancelled')) {
2337         $query .= " AND (datecancellationprinted is NULL or datecancellationprinted='0000-00-00') ";
2338     }
2339
2340     my @query_params  = ();
2341
2342     if ( $biblionumber ) {
2343         $query .= " AND biblio.biblionumber = ?";
2344         push @query_params, $biblionumber;
2345     }
2346
2347     if ( $title ) {
2348         $query .= " AND biblio.title LIKE ? ";
2349         $title =~ s/\s+/%/g;
2350         push @query_params, "%$title%";
2351     }
2352
2353     if ( $author ) {
2354         $query .= " AND biblio.author LIKE ? ";
2355         push @query_params, "%$author%";
2356     }
2357
2358     if ( $isbn ) {
2359         $query .= " AND biblioitems.isbn LIKE ? ";
2360         push @query_params, "%$isbn%";
2361     }
2362     if ( $ean ) {
2363         $query .= " AND biblioitems.ean = ? ";
2364         push @query_params, "$ean";
2365     }
2366     if ( $name ) {
2367         $query .= " AND aqbooksellers.name LIKE ? ";
2368         push @query_params, "%$name%";
2369     }
2370
2371     if ( $budget ) {
2372         $query .= " AND aqbudgets.budget_id = ? ";
2373         push @query_params, "$budget";
2374     }
2375
2376     if ( $from_placed_on ) {
2377         $query .= " AND creationdate >= ? ";
2378         push @query_params, $from_placed_on;
2379     }
2380
2381     if ( $to_placed_on ) {
2382         $query .= " AND creationdate <= ? ";
2383         push @query_params, $to_placed_on;
2384     }
2385
2386     if ( defined $orderstatus and $orderstatus ne '') {
2387         $query .= " AND aqorders.orderstatus = ? ";
2388         push @query_params, "$orderstatus";
2389     }
2390
2391     if ($basket) {
2392         if ($basket =~ m/^\d+$/) {
2393             $query .= " AND aqorders.basketno = ? ";
2394             push @query_params, $basket;
2395         } else {
2396             $query .= " AND aqbasket.basketname LIKE ? ";
2397             push @query_params, "%$basket%";
2398         }
2399     }
2400
2401     if ($booksellerinvoicenumber) {
2402         $query .= " AND aqinvoices.invoicenumber LIKE ? ";
2403         push @query_params, "%$booksellerinvoicenumber%";
2404     }
2405
2406     if ($basketgroupname) {
2407         $query .= " AND aqbasketgroups.name LIKE ? ";
2408         push @query_params, "%$basketgroupname%";
2409     }
2410
2411     if ($ordernumber) {
2412         $query .= " AND (aqorders.ordernumber = ? ";
2413         push @query_params, $ordernumber;
2414         if ($search_children_too) {
2415             $query .= " OR aqorders.parent_ordernumber = ? ";
2416             push @query_params, $ordernumber;
2417         }
2418         $query .= ") ";
2419     }
2420
2421     if ( @$created_by ) {
2422         $query .= ' AND aqbasket.authorisedby IN ( ' . join( ',', ('?') x @$created_by ) . ')';
2423         push @query_params, @$created_by;
2424     }
2425
2426
2427     if ( C4::Context->preference("IndependentBranches") ) {
2428         unless ( C4::Context->IsSuperLibrarian() ) {
2429             $query .= " AND (borrowers.branchcode = ? OR borrowers.branchcode ='' ) ";
2430             push @query_params, C4::Context->userenv->{branch};
2431         }
2432     }
2433     $query .= " ORDER BY id";
2434
2435     return $dbh->selectall_arrayref( $query, { Slice => {} }, @query_params );
2436 }
2437
2438 =head2 GetRecentAcqui
2439
2440   $results = GetRecentAcqui($days);
2441
2442 C<$results> is a ref to a table which contains hashref
2443
2444 =cut
2445
2446 sub GetRecentAcqui {
2447     my $limit  = shift;
2448     my $dbh    = C4::Context->dbh;
2449     my $query = "
2450         SELECT *
2451         FROM   biblio
2452         ORDER BY timestamp DESC
2453         LIMIT  0,".$limit;
2454
2455     my $sth = $dbh->prepare($query);
2456     $sth->execute;
2457     my $results = $sth->fetchall_arrayref({});
2458     return $results;
2459 }
2460
2461 #------------------------------------------------------------#
2462
2463 =head3 AddClaim
2464
2465   &AddClaim($ordernumber);
2466
2467 Add a claim for an order
2468
2469 =cut
2470
2471 sub AddClaim {
2472     my ($ordernumber) = @_;
2473     my $dbh          = C4::Context->dbh;
2474     my $query        = "
2475         UPDATE aqorders SET
2476             claims_count = claims_count + 1,
2477             claimed_date = CURDATE()
2478         WHERE ordernumber = ?
2479         ";
2480     my $sth = $dbh->prepare($query);
2481     $sth->execute($ordernumber);
2482 }
2483
2484 =head3 GetInvoices
2485
2486     my @invoices = GetInvoices(
2487         invoicenumber => $invoicenumber,
2488         supplierid => $supplierid,
2489         suppliername => $suppliername,
2490         shipmentdatefrom => $shipmentdatefrom, # ISO format
2491         shipmentdateto => $shipmentdateto, # ISO format
2492         billingdatefrom => $billingdatefrom, # ISO format
2493         billingdateto => $billingdateto, # ISO format
2494         isbneanissn => $isbn_or_ean_or_issn,
2495         title => $title,
2496         author => $author,
2497         publisher => $publisher,
2498         publicationyear => $publicationyear,
2499         branchcode => $branchcode,
2500         order_by => $order_by
2501     );
2502
2503 Return a list of invoices that match all given criteria.
2504
2505 $order_by is "column_name (asc|desc)", where column_name is any of
2506 'invoicenumber', 'booksellerid', 'shipmentdate', 'billingdate', 'closedate',
2507 'shipmentcost', 'shipmentcost_budgetid'.
2508
2509 asc is the default if omitted
2510
2511 =cut
2512
2513 sub GetInvoices {
2514     my %args = @_;
2515
2516     my @columns = qw(invoicenumber booksellerid shipmentdate billingdate
2517         closedate shipmentcost shipmentcost_budgetid);
2518
2519     my $dbh = C4::Context->dbh;
2520     my $query = qq{
2521         SELECT aqinvoices.invoiceid, aqinvoices.invoicenumber, aqinvoices.booksellerid, aqinvoices.shipmentdate, aqinvoices.billingdate, aqinvoices.closedate, aqinvoices.shipmentcost, aqinvoices.shipmentcost_budgetid, aqinvoices.message_id,
2522             aqbooksellers.name AS suppliername,
2523           COUNT(
2524             DISTINCT IF(
2525               aqorders.datereceived IS NOT NULL,
2526               aqorders.biblionumber,
2527               NULL
2528             )
2529           ) AS receivedbiblios,
2530           COUNT(
2531              DISTINCT IF(
2532               aqorders.subscriptionid IS NOT NULL,
2533               aqorders.subscriptionid,
2534               NULL
2535             )
2536           ) AS is_linked_to_subscriptions,
2537           SUM(aqorders.quantityreceived) AS receiveditems
2538         FROM aqinvoices
2539           LEFT JOIN aqbooksellers ON aqbooksellers.id = aqinvoices.booksellerid
2540           LEFT JOIN aqorders ON aqorders.invoiceid = aqinvoices.invoiceid
2541           LEFT JOIN aqbasket ON aqbasket.basketno=aqorders.basketno
2542           LEFT JOIN borrowers ON aqbasket.authorisedby=borrowers.borrowernumber
2543           LEFT JOIN biblio ON aqorders.biblionumber = biblio.biblionumber
2544           LEFT JOIN biblioitems ON biblio.biblionumber = biblioitems.biblionumber
2545           LEFT JOIN subscription ON biblio.biblionumber = subscription.biblionumber
2546     };
2547
2548     my @bind_args;
2549     my @bind_strs;
2550     if($args{supplierid}) {
2551         push @bind_strs, " aqinvoices.booksellerid = ? ";
2552         push @bind_args, $args{supplierid};
2553     }
2554     if($args{invoicenumber}) {
2555         push @bind_strs, " aqinvoices.invoicenumber LIKE ? ";
2556         push @bind_args, "%$args{invoicenumber}%";
2557     }
2558     if($args{suppliername}) {
2559         push @bind_strs, " aqbooksellers.name LIKE ? ";
2560         push @bind_args, "%$args{suppliername}%";
2561     }
2562     if($args{shipmentdatefrom}) {
2563         push @bind_strs, " aqinvoices.shipmentdate >= ? ";
2564         push @bind_args, $args{shipmentdatefrom};
2565     }
2566     if($args{shipmentdateto}) {
2567         push @bind_strs, " aqinvoices.shipmentdate <= ? ";
2568         push @bind_args, $args{shipmentdateto};
2569     }
2570     if($args{billingdatefrom}) {
2571         push @bind_strs, " aqinvoices.billingdate >= ? ";
2572         push @bind_args, $args{billingdatefrom};
2573     }
2574     if($args{billingdateto}) {
2575         push @bind_strs, " aqinvoices.billingdate <= ? ";
2576         push @bind_args, $args{billingdateto};
2577     }
2578     if($args{isbneanissn}) {
2579         push @bind_strs, " (biblioitems.isbn LIKE CONCAT('%', ?, '%') OR biblioitems.ean LIKE CONCAT('%', ?, '%') OR biblioitems.issn LIKE CONCAT('%', ?, '%') ) ";
2580         push @bind_args, $args{isbneanissn}, $args{isbneanissn}, $args{isbneanissn};
2581     }
2582     if($args{title}) {
2583         push @bind_strs, " biblio.title LIKE CONCAT('%', ?, '%') ";
2584         push @bind_args, $args{title};
2585     }
2586     if($args{author}) {
2587         push @bind_strs, " biblio.author LIKE CONCAT('%', ?, '%') ";
2588         push @bind_args, $args{author};
2589     }
2590     if($args{publisher}) {
2591         push @bind_strs, " biblioitems.publishercode LIKE CONCAT('%', ?, '%') ";
2592         push @bind_args, $args{publisher};
2593     }
2594     if($args{publicationyear}) {
2595         push @bind_strs, " ((biblioitems.publicationyear LIKE CONCAT('%', ?, '%')) OR (biblio.copyrightdate LIKE CONCAT('%', ?, '%'))) ";
2596         push @bind_args, $args{publicationyear}, $args{publicationyear};
2597     }
2598     if($args{branchcode}) {
2599         push @bind_strs, " borrowers.branchcode = ? ";
2600         push @bind_args, $args{branchcode};
2601     }
2602     if($args{message_id}) {
2603         push @bind_strs, " aqinvoices.message_id = ? ";
2604         push @bind_args, $args{message_id};
2605     }
2606
2607     $query .= " WHERE " . join(" AND ", @bind_strs) if @bind_strs;
2608     $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";
2609
2610     if($args{order_by}) {
2611         my ($column, $direction) = split / /, $args{order_by};
2612         if(grep /^$column$/, @columns) {
2613             $direction ||= 'ASC';
2614             $query .= " ORDER BY $column $direction";
2615         }
2616     }
2617
2618     my $sth = $dbh->prepare($query);
2619     $sth->execute(@bind_args);
2620
2621     my $results = $sth->fetchall_arrayref({});
2622     return @$results;
2623 }
2624
2625 =head3 GetInvoice
2626
2627     my $invoice = GetInvoice($invoiceid);
2628
2629 Get informations about invoice with given $invoiceid
2630
2631 Return a hash filled with aqinvoices.* fields
2632
2633 =cut
2634
2635 sub GetInvoice {
2636     my ($invoiceid) = @_;
2637     my $invoice;
2638
2639     return unless $invoiceid;
2640
2641     my $dbh = C4::Context->dbh;
2642     my $query = qq{
2643         SELECT *
2644         FROM aqinvoices
2645         WHERE invoiceid = ?
2646     };
2647     my $sth = $dbh->prepare($query);
2648     $sth->execute($invoiceid);
2649
2650     $invoice = $sth->fetchrow_hashref;
2651     return $invoice;
2652 }
2653
2654 =head3 GetInvoiceDetails
2655
2656     my $invoice = GetInvoiceDetails($invoiceid)
2657
2658 Return informations about an invoice + the list of related order lines
2659
2660 Orders informations are in $invoice->{orders} (array ref)
2661
2662 =cut
2663
2664 sub GetInvoiceDetails {
2665     my ($invoiceid) = @_;
2666
2667     if ( !defined $invoiceid ) {
2668         carp 'GetInvoiceDetails called without an invoiceid';
2669         return;
2670     }
2671
2672     my $dbh = C4::Context->dbh;
2673     my $query = q{
2674         SELECT aqinvoices.*, aqbooksellers.name AS suppliername
2675         FROM aqinvoices
2676           LEFT JOIN aqbooksellers ON aqinvoices.booksellerid = aqbooksellers.id
2677         WHERE invoiceid = ?
2678     };
2679     my $sth = $dbh->prepare($query);
2680     $sth->execute($invoiceid);
2681
2682     my $invoice = $sth->fetchrow_hashref;
2683
2684     $query = q{
2685         SELECT aqorders.*,
2686                 biblio.*,
2687                 biblio.copyrightdate,
2688                 biblioitems.isbn,
2689                 biblioitems.publishercode,
2690                 biblioitems.publicationyear,
2691                 aqbasket.basketname,
2692                 aqbasketgroups.id AS basketgroupid,
2693                 aqbasketgroups.name AS basketgroupname
2694         FROM aqorders
2695           LEFT JOIN aqbasket ON aqorders.basketno = aqbasket.basketno
2696           LEFT JOIN aqbasketgroups ON aqbasket.basketgroupid = aqbasketgroups.id
2697           LEFT JOIN biblio ON aqorders.biblionumber = biblio.biblionumber
2698           LEFT JOIN biblioitems ON aqorders.biblionumber = biblioitems.biblionumber
2699         WHERE invoiceid = ?
2700     };
2701     $sth = $dbh->prepare($query);
2702     $sth->execute($invoiceid);
2703     $invoice->{orders} = $sth->fetchall_arrayref({});
2704     $invoice->{orders} ||= []; # force an empty arrayref if fetchall_arrayref fails
2705
2706     return $invoice;
2707 }
2708
2709 =head3 AddInvoice
2710
2711     my $invoiceid = AddInvoice(
2712         invoicenumber => $invoicenumber,
2713         booksellerid => $booksellerid,
2714         shipmentdate => $shipmentdate,
2715         billingdate => $billingdate,
2716         closedate => $closedate,
2717         shipmentcost => $shipmentcost,
2718         shipmentcost_budgetid => $shipmentcost_budgetid
2719     );
2720
2721 Create a new invoice and return its id or undef if it fails.
2722
2723 =cut
2724
2725 sub AddInvoice {
2726     my %invoice = @_;
2727
2728     return unless(%invoice and $invoice{invoicenumber});
2729
2730     my @columns = qw(invoicenumber booksellerid shipmentdate billingdate
2731         closedate shipmentcost shipmentcost_budgetid message_id);
2732
2733     my @set_strs;
2734     my @set_args;
2735     foreach my $key (keys %invoice) {
2736         if(0 < grep(/^$key$/, @columns)) {
2737             push @set_strs, "$key = ?";
2738             push @set_args, ($invoice{$key} || undef);
2739         }
2740     }
2741
2742     my $rv;
2743     if(@set_args > 0) {
2744         my $dbh = C4::Context->dbh;
2745         my $query = "INSERT INTO aqinvoices SET ";
2746         $query .= join (",", @set_strs);
2747         my $sth = $dbh->prepare($query);
2748         $rv = $sth->execute(@set_args);
2749         if($rv) {
2750             $rv = $dbh->last_insert_id(undef, undef, 'aqinvoices', undef);
2751         }
2752     }
2753     return $rv;
2754 }
2755
2756 =head3 ModInvoice
2757
2758     ModInvoice(
2759         invoiceid => $invoiceid,    # Mandatory
2760         invoicenumber => $invoicenumber,
2761         booksellerid => $booksellerid,
2762         shipmentdate => $shipmentdate,
2763         billingdate => $billingdate,
2764         closedate => $closedate,
2765         shipmentcost => $shipmentcost,
2766         shipmentcost_budgetid => $shipmentcost_budgetid
2767     );
2768
2769 Modify an invoice, invoiceid is mandatory.
2770
2771 Return undef if it fails.
2772
2773 =cut
2774
2775 sub ModInvoice {
2776     my %invoice = @_;
2777
2778     return unless(%invoice and $invoice{invoiceid});
2779
2780     my @columns = qw(invoicenumber booksellerid shipmentdate billingdate
2781         closedate shipmentcost shipmentcost_budgetid);
2782
2783     my @set_strs;
2784     my @set_args;
2785     foreach my $key (keys %invoice) {
2786         if(0 < grep(/^$key$/, @columns)) {
2787             push @set_strs, "$key = ?";
2788             push @set_args, ($invoice{$key} || undef);
2789         }
2790     }
2791
2792     my $dbh = C4::Context->dbh;
2793     my $query = "UPDATE aqinvoices SET ";
2794     $query .= join(",", @set_strs);
2795     $query .= " WHERE invoiceid = ?";
2796
2797     my $sth = $dbh->prepare($query);
2798     $sth->execute(@set_args, $invoice{invoiceid});
2799 }
2800
2801 =head3 CloseInvoice
2802
2803     CloseInvoice($invoiceid);
2804
2805 Close an invoice.
2806
2807 Equivalent to ModInvoice(invoiceid => $invoiceid, closedate => undef);
2808
2809 =cut
2810
2811 sub CloseInvoice {
2812     my ($invoiceid) = @_;
2813
2814     return unless $invoiceid;
2815
2816     my $dbh = C4::Context->dbh;
2817     my $query = qq{
2818         UPDATE aqinvoices
2819         SET closedate = CAST(NOW() AS DATE)
2820         WHERE invoiceid = ?
2821     };
2822     my $sth = $dbh->prepare($query);
2823     $sth->execute($invoiceid);
2824 }
2825
2826 =head3 ReopenInvoice
2827
2828     ReopenInvoice($invoiceid);
2829
2830 Reopen an invoice
2831
2832 Equivalent to ModInvoice(invoiceid => $invoiceid, closedate => output_pref({ dt=>dt_from_string, dateonly=>1, otputpref=>'iso' }))
2833
2834 =cut
2835
2836 sub ReopenInvoice {
2837     my ($invoiceid) = @_;
2838
2839     return unless $invoiceid;
2840
2841     my $dbh = C4::Context->dbh;
2842     my $query = qq{
2843         UPDATE aqinvoices
2844         SET closedate = NULL
2845         WHERE invoiceid = ?
2846     };
2847     my $sth = $dbh->prepare($query);
2848     $sth->execute($invoiceid);
2849 }
2850
2851 =head3 DelInvoice
2852
2853     DelInvoice($invoiceid);
2854
2855 Delete an invoice if there are no items attached to it.
2856
2857 =cut
2858
2859 sub DelInvoice {
2860     my ($invoiceid) = @_;
2861
2862     return unless $invoiceid;
2863
2864     my $dbh   = C4::Context->dbh;
2865     my $query = qq{
2866         SELECT COUNT(*)
2867         FROM aqorders
2868         WHERE invoiceid = ?
2869     };
2870     my $sth = $dbh->prepare($query);
2871     $sth->execute($invoiceid);
2872     my $res = $sth->fetchrow_arrayref;
2873     if ( $res && $res->[0] == 0 ) {
2874         $query = qq{
2875             DELETE FROM aqinvoices
2876             WHERE invoiceid = ?
2877         };
2878         my $sth = $dbh->prepare($query);
2879         return ( $sth->execute($invoiceid) > 0 );
2880     }
2881     return;
2882 }
2883
2884 =head3 MergeInvoices
2885
2886     MergeInvoices($invoiceid, \@sourceids);
2887
2888 Merge the invoices identified by the IDs in \@sourceids into
2889 the invoice identified by $invoiceid.
2890
2891 =cut
2892
2893 sub MergeInvoices {
2894     my ($invoiceid, $sourceids) = @_;
2895
2896     return unless $invoiceid;
2897     foreach my $sourceid (@$sourceids) {
2898         next if $sourceid == $invoiceid;
2899         my $source = GetInvoiceDetails($sourceid);
2900         foreach my $order (@{$source->{'orders'}}) {
2901             $order->{'invoiceid'} = $invoiceid;
2902             ModOrder($order);
2903         }
2904         DelInvoice($source->{'invoiceid'});
2905     }
2906     return;
2907 }
2908
2909 =head3 GetBiblioCountByBasketno
2910
2911 $biblio_count = &GetBiblioCountByBasketno($basketno);
2912
2913 Looks up the biblio's count that has basketno value $basketno
2914
2915 Returns a quantity
2916
2917 =cut
2918
2919 sub GetBiblioCountByBasketno {
2920     my ($basketno) = @_;
2921     my $dbh          = C4::Context->dbh;
2922     my $query        = "
2923         SELECT COUNT( DISTINCT( biblionumber ) )
2924         FROM   aqorders
2925         WHERE  basketno = ?
2926             AND (datecancellationprinted IS NULL OR datecancellationprinted='0000-00-00')
2927         ";
2928
2929     my $sth = $dbh->prepare($query);
2930     $sth->execute($basketno);
2931     return $sth->fetchrow;
2932 }
2933
2934 # Note this subroutine should be moved to Koha::Acquisition::Order
2935 # Will do when a DBIC decision will be taken.
2936 sub populate_order_with_prices {
2937     my ($params) = @_;
2938
2939     my $order        = $params->{order};
2940     my $booksellerid = $params->{booksellerid};
2941     return unless $booksellerid;
2942
2943     my $bookseller = Koha::Acquisition::Booksellers->find( $booksellerid );
2944
2945     my $receiving = $params->{receiving};
2946     my $ordering  = $params->{ordering};
2947     my $discount  = $order->{discount};
2948     $discount /= 100 if $discount > 1;
2949
2950     if ($ordering) {
2951         $order->{tax_rate_on_ordering} //= $order->{tax_rate};
2952         if ( $bookseller->listincgst ) {
2953             # The user entered the rrp tax included
2954             $order->{rrp_tax_included} = $order->{rrp};
2955
2956             # rrp tax excluded = rrp tax included / ( 1 + tax rate )
2957             $order->{rrp_tax_excluded} = $order->{rrp_tax_included} / ( 1 + $order->{tax_rate_on_ordering} );
2958
2959             # ecost tax excluded = rrp tax excluded * ( 1 - discount )
2960             $order->{ecost_tax_excluded} = $order->{rrp_tax_excluded} * ( 1 - $discount );
2961
2962             # ecost tax included = rrp tax included  ( 1 - discount )
2963             $order->{ecost_tax_included} = $order->{rrp_tax_included} * ( 1 - $discount );
2964         }
2965         else {
2966             # The user entered the rrp tax excluded
2967             $order->{rrp_tax_excluded} = $order->{rrp};
2968
2969             # rrp tax included = rrp tax excluded * ( 1 - tax rate )
2970             $order->{rrp_tax_included} = $order->{rrp_tax_excluded} * ( 1 + $order->{tax_rate_on_ordering} );
2971
2972             # ecost tax excluded = rrp tax excluded * ( 1 - discount )
2973             $order->{ecost_tax_excluded} = $order->{rrp_tax_excluded} * ( 1 - $discount );
2974
2975             # ecost tax included = rrp tax excluded * ( 1 + tax rate ) * ( 1 - discount )
2976             $order->{ecost_tax_included} =
2977                 $order->{rrp_tax_excluded} *
2978                 ( 1 + $order->{tax_rate_on_ordering} ) *
2979                 ( 1 - $discount );
2980         }
2981
2982         # tax value = quantity * ecost tax excluded * tax rate
2983         $order->{tax_value_on_ordering} =
2984             $order->{quantity} * $order->{ecost_tax_excluded} * $order->{tax_rate_on_ordering};
2985     }
2986
2987     if ($receiving) {
2988         $order->{tax_rate_on_receiving} //= $order->{tax_rate};
2989         if ( $bookseller->invoiceincgst ) {
2990             # Trick for unitprice. If the unit price rounded value is the same as the ecost rounded value
2991             # we need to keep the exact ecost value
2992             if ( Koha::Number::Price->new( $order->{unitprice} )->round == Koha::Number::Price->new( $order->{ecost_tax_included} )->round ) {
2993                 $order->{unitprice} = $order->{ecost_tax_included};
2994             }
2995
2996             # The user entered the unit price tax included
2997             $order->{unitprice_tax_included} = $order->{unitprice};
2998
2999             # unit price tax excluded = unit price tax included / ( 1 + tax rate )
3000             $order->{unitprice_tax_excluded} = $order->{unitprice_tax_included} / ( 1 + $order->{tax_rate_on_receiving} );
3001         }
3002         else {
3003             # Trick for unitprice. If the unit price rounded value is the same as the ecost rounded value
3004             # we need to keep the exact ecost value
3005             if ( Koha::Number::Price->new( $order->{unitprice} )->round == Koha::Number::Price->new( $order->{ecost_tax_excluded} )->round ) {
3006                 $order->{unitprice} = $order->{ecost_tax_excluded};
3007             }
3008
3009             # The user entered the unit price tax excluded
3010             $order->{unitprice_tax_excluded} = $order->{unitprice};
3011
3012
3013             # unit price tax included = unit price tax included * ( 1 + tax rate )
3014             $order->{unitprice_tax_included} = $order->{unitprice_tax_excluded} * ( 1 + $order->{tax_rate_on_receiving} );
3015         }
3016
3017         # tax value = quantity * unit price tax excluded * tax rate
3018         $order->{tax_value_on_receiving} = $order->{quantity} * $order->{unitprice_tax_excluded} * $order->{tax_rate_on_receiving};
3019     }
3020
3021     return $order;
3022 }
3023
3024 =head3 GetOrderUsers
3025
3026     $order_users_ids = &GetOrderUsers($ordernumber);
3027
3028 Returns a list of all borrowernumbers that are in order users list
3029
3030 =cut
3031
3032 sub GetOrderUsers {
3033     my ($ordernumber) = @_;
3034
3035     return unless $ordernumber;
3036
3037     my $query = q|
3038         SELECT borrowernumber
3039         FROM aqorder_users
3040         WHERE ordernumber = ?
3041     |;
3042     my $dbh = C4::Context->dbh;
3043     my $sth = $dbh->prepare($query);
3044     $sth->execute($ordernumber);
3045     my $results = $sth->fetchall_arrayref( {} );
3046
3047     my @borrowernumbers;
3048     foreach (@$results) {
3049         push @borrowernumbers, $_->{'borrowernumber'};
3050     }
3051
3052     return @borrowernumbers;
3053 }
3054
3055 =head3 ModOrderUsers
3056
3057     my @order_users_ids = (1, 2, 3);
3058     &ModOrderUsers($ordernumber, @basketusers_ids);
3059
3060 Delete all users from order users list, and add users in C<@order_users_ids>
3061 to this users list.
3062
3063 =cut
3064
3065 sub ModOrderUsers {
3066     my ( $ordernumber, @order_users_ids ) = @_;
3067
3068     return unless $ordernumber;
3069
3070     my $dbh   = C4::Context->dbh;
3071     my $query = q|
3072         DELETE FROM aqorder_users
3073         WHERE ordernumber = ?
3074     |;
3075     my $sth = $dbh->prepare($query);
3076     $sth->execute($ordernumber);
3077
3078     $query = q|
3079         INSERT INTO aqorder_users (ordernumber, borrowernumber)
3080         VALUES (?, ?)
3081     |;
3082     $sth = $dbh->prepare($query);
3083     foreach my $order_user_id (@order_users_ids) {
3084         $sth->execute( $ordernumber, $order_user_id );
3085     }
3086 }
3087
3088 sub NotifyOrderUsers {
3089     my ($ordernumber) = @_;
3090
3091     my @borrowernumbers = GetOrderUsers($ordernumber);
3092     return unless @borrowernumbers;
3093
3094     my $order = GetOrder( $ordernumber );
3095     for my $borrowernumber (@borrowernumbers) {
3096         my $patron = Koha::Patrons->find( $borrowernumber );
3097         my $library = $patron->library->unblessed;
3098         my $biblio = Koha::Biblios->find( $order->{biblionumber} )->unblessed;
3099         my $letter = C4::Letters::GetPreparedLetter(
3100             module      => 'acquisition',
3101             letter_code => 'ACQ_NOTIF_ON_RECEIV',
3102             branchcode  => $library->{branchcode},
3103             lang        => $patron->lang,
3104             tables      => {
3105                 'branches'    => $library,
3106                 'borrowers'   => $patron->unblessed,
3107                 'biblio'      => $biblio,
3108                 'aqorders'    => $order,
3109             },
3110         );
3111         if ( $letter ) {
3112             C4::Letters::EnqueueLetter(
3113                 {
3114                     letter         => $letter,
3115                     borrowernumber => $borrowernumber,
3116                     LibraryName    => C4::Context->preference("LibraryName"),
3117                     message_transport_type => 'email',
3118                 }
3119             ) or warn "can't enqueue letter $letter";
3120         }
3121     }
3122 }
3123
3124 =head3 FillWithDefaultValues
3125
3126 FillWithDefaultValues( $marc_record );
3127
3128 This will update the record with default value defined in the ACQ framework.
3129 For all existing fields, if a default value exists and there are no subfield, it will be created.
3130 If the field does not exist, it will be created too.
3131
3132 =cut
3133
3134 sub FillWithDefaultValues {
3135     my ($record) = @_;
3136     my $tagslib = C4::Biblio::GetMarcStructure( 1, 'ACQ', { unsafe => 1 } );
3137     if ($tagslib) {
3138         my ($itemfield) =
3139           C4::Biblio::GetMarcFromKohaField( 'items.itemnumber', '' );
3140         for my $tag ( sort keys %$tagslib ) {
3141             next unless $tag;
3142             next if $tag == $itemfield;
3143             for my $subfield ( sort keys %{ $tagslib->{$tag} } ) {
3144                 next if IsMarcStructureInternal($tagslib->{$tag}{$subfield});
3145                 my $defaultvalue = $tagslib->{$tag}{$subfield}{defaultvalue};
3146                 if ( defined $defaultvalue and $defaultvalue ne '' ) {
3147                     my @fields = $record->field($tag);
3148                     if (@fields) {
3149                         for my $field (@fields) {
3150                             unless ( defined $field->subfield($subfield) ) {
3151                                 $field->add_subfields(
3152                                     $subfield => $defaultvalue );
3153                             }
3154                         }
3155                     }
3156                     else {
3157                         $record->insert_fields_ordered(
3158                             MARC::Field->new(
3159                                 $tag, '', '', $subfield => $defaultvalue
3160                             )
3161                         );
3162                     }
3163                 }
3164             }
3165         }
3166     }
3167 }
3168
3169 1;
3170 __END__
3171
3172 =head1 AUTHOR
3173
3174 Koha Development Team <http://koha-community.org/>
3175
3176 =cut