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