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