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