C4/Acquisition.pm

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