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