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