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                biblioitems.publishercode,
1710                biblioitems.publicationyear,
1711                aqbasket.authorisedby,
1712                aqbasket.booksellerid,
1713                aqbasket.closedate,
1714                aqbasket.creationdate,
1715                aqbasket.basketname,
1716                aqbasketgroups.id as basketgroupid,
1717                aqbasketgroups.name as basketgroupname,
1718                aqorders.*
1719         FROM aqorders
1720             LEFT JOIN aqbasket ON aqorders.basketno = aqbasket.basketno
1721             LEFT JOIN aqbasketgroups ON aqbasket.basketgroupid = aqbasketgroups.id
1722             LEFT JOIN borrowers ON aqbasket.authorisedby=borrowers.borrowernumber
1723             LEFT JOIN biblio ON aqorders.biblionumber=biblio.biblionumber
1724             LEFT JOIN biblioitems ON biblioitems.biblionumber=biblio.biblionumber
1725     };
1726
1727     # If we search on ordernumber, we retrieve the transferred order if a transfer has been done.
1728     $query .= q{
1729             LEFT JOIN aqorders_transfers ON aqorders_transfers.ordernumber_to = aqorders.ordernumber
1730     } if $ordernumber;
1731
1732     $query .= q{
1733         WHERE (datecancellationprinted is NULL)
1734     };
1735
1736     if ( $pending or $ordered ) {
1737         $query .= q{
1738             AND (
1739                 ( aqbasket.is_standing AND aqorders.orderstatus IN ( "new", "ordered", "partial" ) )
1740                 OR (
1741                     ( quantity > quantityreceived OR quantityreceived is NULL )
1742         };
1743
1744         if ( $ordered ) {
1745             $query .= q{ AND aqorders.orderstatus IN ( "ordered", "partial" )};
1746         }
1747         $query .= q{
1748                 )
1749             )
1750         };
1751     }
1752
1753     my $userenv = C4::Context->userenv;
1754     if ( C4::Context->preference("IndependentBranches") ) {
1755         unless ( C4::Context->IsSuperLibrarian() ) {
1756             $query .= q{
1757                 AND (
1758                     borrowers.branchcode = ?
1759                     OR borrowers.branchcode  = ''
1760                 )
1761             };
1762             push @args, $userenv->{branch};
1763         }
1764     }
1765
1766     if ( $ordernumber ) {
1767         $query .= ' AND ( aqorders.ordernumber = ? OR aqorders_transfers.ordernumber_from = ? ) ';
1768         push @args, ( $ordernumber, $ordernumber );
1769     }
1770     if ( $biblionumber ) {
1771         $query .= 'AND aqorders.biblionumber = ?';
1772         push @args, $biblionumber;
1773     }
1774     if( $search ) {
1775         $query .= ' AND (biblio.title LIKE ? OR biblio.author LIKE ? OR biblioitems.isbn LIKE ?)';
1776         push @args, ("%$search%","%$search%","%$search%");
1777     }
1778     if ( $ean ) {
1779         $query .= ' AND biblioitems.ean = ?';
1780         push @args, $ean;
1781     }
1782     if ( $booksellerid ) {
1783         $query .= 'AND aqbasket.booksellerid = ?';
1784         push @args, $booksellerid;
1785     }
1786     if( $basketno ) {
1787         $query .= 'AND aqbasket.basketno = ?';
1788         push @args, $basketno;
1789     }
1790     if( $basketname ) {
1791         $query .= 'AND aqbasket.basketname LIKE ?';
1792         push @args, "%$basketname%";
1793     }
1794     if( $basketgroupname ) {
1795         $query .= ' AND aqbasketgroups.name LIKE ?';
1796         push @args, "%$basketgroupname%";
1797     }
1798
1799     if ( $owner ) {
1800         $query .= ' AND aqbasket.authorisedby=? ';
1801         push @args, $userenv->{'number'};
1802     }
1803
1804     if ( $budget_id ) {
1805         $query .= ' AND aqorders.budget_id = ?';
1806         push @args, $budget_id;
1807     }
1808
1809     $query .= ' ORDER BY aqbasket.basketno';
1810
1811     my $sth = $dbh->prepare($query);
1812     $sth->execute(@args);
1813     return $sth->fetchall_arrayref({});
1814 }
1815
1816 #------------------------------------------------------------#
1817
1818 =head3 DelOrder
1819
1820   &DelOrder($biblionumber, $ordernumber);
1821
1822 Cancel the order with the given order and biblio numbers. It does not
1823 delete any entries in the aqorders table, it merely marks them as
1824 cancelled.
1825
1826 =cut
1827
1828 sub DelOrder {
1829     my ( $bibnum, $ordernumber, $delete_biblio, $reason ) = @_;
1830
1831     my $error;
1832     my $dbh = C4::Context->dbh;
1833     my $query = "
1834         UPDATE aqorders
1835         SET    datecancellationprinted=now(), orderstatus='cancelled'
1836     ";
1837     if($reason) {
1838         $query .= ", cancellationreason = ? ";
1839     }
1840     $query .= "
1841         WHERE biblionumber=? AND ordernumber=?
1842     ";
1843     my $sth = $dbh->prepare($query);
1844     if($reason) {
1845         $sth->execute($reason, $bibnum, $ordernumber);
1846     } else {
1847         $sth->execute( $bibnum, $ordernumber );
1848     }
1849     $sth->finish;
1850
1851     my @itemnumbers = GetItemnumbersFromOrder( $ordernumber );
1852     foreach my $itemnumber (@itemnumbers){
1853         my $delcheck = C4::Items::DelItemCheck( $bibnum, $itemnumber );
1854
1855         if($delcheck != 1) {
1856             $error->{'delitem'} = 1;
1857         }
1858     }
1859
1860     if($delete_biblio) {
1861         # We get the number of remaining items
1862         my $biblio = Koha::Biblios->find( $bibnum );
1863         my $itemcount = $biblio->items->count;
1864
1865         # If there are no items left,
1866         if ( $itemcount == 0 ) {
1867             # We delete the record
1868             my $delcheck = DelBiblio($bibnum);
1869
1870             if($delcheck) {
1871                 $error->{'delbiblio'} = 1;
1872             }
1873         }
1874     }
1875
1876     return $error;
1877 }
1878
1879 =head3 TransferOrder
1880
1881     my $newordernumber = TransferOrder($ordernumber, $basketno);
1882
1883 Transfer an order line to a basket.
1884 Mark $ordernumber as cancelled with an internal note 'Cancelled and transferred
1885 to BOOKSELLER on DATE' and create new order with internal note
1886 'Transferred from BOOKSELLER on DATE'.
1887 Move all attached items to the new order.
1888 Received orders cannot be transferred.
1889 Return the ordernumber of created order.
1890
1891 =cut
1892
1893 sub TransferOrder {
1894     my ($ordernumber, $basketno) = @_;
1895
1896     return unless ($ordernumber and $basketno);
1897
1898     my $order = GetOrder( $ordernumber );
1899     return if $order->{datereceived};
1900     my $basket = GetBasket($basketno);
1901     return unless $basket;
1902
1903     my $dbh = C4::Context->dbh;
1904     my ($query, $sth, $rv);
1905
1906     $query = q{
1907         UPDATE aqorders
1908         SET datecancellationprinted = CAST(NOW() AS date), orderstatus = ?
1909         WHERE ordernumber = ?
1910     };
1911     $sth = $dbh->prepare($query);
1912     $rv = $sth->execute('cancelled', $ordernumber);
1913
1914     delete $order->{'ordernumber'};
1915     delete $order->{parent_ordernumber};
1916     $order->{'basketno'} = $basketno;
1917
1918     my $newordernumber = Koha::Acquisition::Order->new($order)->insert->{ordernumber};
1919
1920     $query = q{
1921         UPDATE aqorders_items
1922         SET ordernumber = ?
1923         WHERE ordernumber = ?
1924     };
1925     $sth = $dbh->prepare($query);
1926     $sth->execute($newordernumber, $ordernumber);
1927
1928     $query = q{
1929         INSERT INTO aqorders_transfers (ordernumber_from, ordernumber_to)
1930         VALUES (?, ?)
1931     };
1932     $sth = $dbh->prepare($query);
1933     $sth->execute($ordernumber, $newordernumber);
1934
1935     return $newordernumber;
1936 }
1937
1938 =head2 FUNCTIONS ABOUT PARCELS
1939
1940 =head3 GetParcels
1941
1942   $results = &GetParcels($bookseller, $order, $code, $datefrom, $dateto);
1943
1944 get a lists of parcels.
1945
1946 * Input arg :
1947
1948 =over
1949
1950 =item $bookseller
1951 is the bookseller this function has to get parcels.
1952
1953 =item $order
1954 To know on what criteria the results list has to be ordered.
1955
1956 =item $code
1957 is the booksellerinvoicenumber.
1958
1959 =item $datefrom & $dateto
1960 to know on what date this function has to filter its search.
1961
1962 =back
1963
1964 * return:
1965 a pointer on a hash list containing parcel informations as such :
1966
1967 =over
1968
1969 =item Creation date
1970
1971 =item Last operation
1972
1973 =item Number of biblio
1974
1975 =item Number of items
1976
1977 =back
1978
1979 =cut
1980
1981 sub GetParcels {
1982     my ($bookseller,$order, $code, $datefrom, $dateto) = @_;
1983     my $dbh    = C4::Context->dbh;
1984     my @query_params = ();
1985     my $strsth ="
1986         SELECT  aqinvoices.invoicenumber,
1987                 datereceived,purchaseordernumber,
1988                 count(DISTINCT biblionumber) AS biblio,
1989                 sum(quantity) AS itemsexpected,
1990                 sum(quantityreceived) AS itemsreceived
1991         FROM   aqorders LEFT JOIN aqbasket ON aqbasket.basketno = aqorders.basketno
1992         LEFT JOIN aqinvoices ON aqorders.invoiceid = aqinvoices.invoiceid
1993         WHERE aqbasket.booksellerid = ? and datereceived IS NOT NULL
1994     ";
1995     push @query_params, $bookseller;
1996
1997     if ( defined $code ) {
1998         $strsth .= ' and aqinvoices.invoicenumber like ? ';
1999         # add a % to the end of the code to allow stemming.
2000         push @query_params, "$code%";
2001     }
2002
2003     if ( defined $datefrom ) {
2004         $strsth .= ' and datereceived >= ? ';
2005         push @query_params, $datefrom;
2006     }
2007
2008     if ( defined $dateto ) {
2009         $strsth .=  'and datereceived <= ? ';
2010         push @query_params, $dateto;
2011     }
2012
2013     $strsth .= "group by aqinvoices.invoicenumber,datereceived ";
2014
2015     # can't use a placeholder to place this column name.
2016     # but, we could probably be checking to make sure it is a column that will be fetched.
2017     $strsth .= "order by $order " if ($order);
2018
2019     my $sth = $dbh->prepare($strsth);
2020
2021     $sth->execute( @query_params );
2022     my $results = $sth->fetchall_arrayref({});
2023     return @{$results};
2024 }
2025
2026 #------------------------------------------------------------#
2027
2028 =head3 GetLateOrders
2029
2030   @results = &GetLateOrders;
2031
2032 Searches for bookseller with late orders.
2033
2034 return:
2035 the table of supplier with late issues. This table is full of hashref.
2036
2037 =cut
2038
2039 sub GetLateOrders {
2040     my $delay      = shift;
2041     my $supplierid = shift;
2042     my $branch     = shift;
2043     my $estimateddeliverydatefrom = shift;
2044     my $estimateddeliverydateto = shift;
2045
2046     my $dbh = C4::Context->dbh;
2047
2048     #BEWARE, order of parenthesis and LEFT JOIN is important for speed
2049     my $dbdriver = C4::Context->config("db_scheme") || "mysql";
2050
2051     my @query_params = ();
2052     my $select = "
2053     SELECT aqbasket.basketno,
2054         aqorders.ordernumber,
2055         DATE(aqbasket.closedate)  AS orderdate,
2056         aqbasket.basketname       AS basketname,
2057         aqbasket.basketgroupid    AS basketgroupid,
2058         aqbasketgroups.name       AS basketgroupname,
2059         aqorders.rrp              AS unitpricesupplier,
2060         aqorders.ecost            AS unitpricelib,
2061         aqorders.claims_count     AS claims_count,
2062         aqorders.claimed_date     AS claimed_date,
2063         aqbudgets.budget_name     AS budget,
2064         borrowers.branchcode      AS branch,
2065         aqbooksellers.name        AS supplier,
2066         aqbooksellers.id          AS supplierid,
2067         biblio.author, biblio.title,
2068         biblioitems.publishercode AS publisher,
2069         biblioitems.publicationyear,
2070         ADDDATE(aqbasket.closedate, INTERVAL aqbooksellers.deliverytime DAY) AS estimateddeliverydate,
2071     ";
2072     my $from = "
2073     FROM
2074         aqorders LEFT JOIN biblio     ON biblio.biblionumber         = aqorders.biblionumber
2075         LEFT JOIN biblioitems         ON biblioitems.biblionumber    = biblio.biblionumber
2076         LEFT JOIN aqbudgets           ON aqorders.budget_id          = aqbudgets.budget_id,
2077         aqbasket LEFT JOIN borrowers  ON aqbasket.authorisedby       = borrowers.borrowernumber
2078         LEFT JOIN aqbooksellers       ON aqbasket.booksellerid       = aqbooksellers.id
2079         LEFT JOIN aqbasketgroups      ON aqbasket.basketgroupid      = aqbasketgroups.id
2080         WHERE aqorders.basketno = aqbasket.basketno
2081         AND ( datereceived = ''
2082             OR datereceived IS NULL
2083             OR aqorders.quantityreceived < aqorders.quantity
2084         )
2085         AND aqbasket.closedate IS NOT NULL
2086         AND (aqorders.datecancellationprinted IS NULL OR aqorders.datecancellationprinted='0000-00-00')
2087     ";
2088     my $having = "";
2089     if ($dbdriver eq "mysql") {
2090         $select .= "
2091         aqorders.quantity - COALESCE(aqorders.quantityreceived,0)                 AS quantity,
2092         (aqorders.quantity - COALESCE(aqorders.quantityreceived,0)) * aqorders.rrp AS subtotal,
2093         DATEDIFF(CAST(now() AS date),closedate) AS latesince
2094         ";
2095         if ( defined $delay ) {
2096             $from .= " AND (closedate <= DATE_SUB(CAST(now() AS date),INTERVAL ? DAY)) " ;
2097             push @query_params, $delay;
2098         }
2099         $having = "HAVING quantity <> 0";
2100     } else {
2101         # FIXME: account for IFNULL as above
2102         $select .= "
2103                 aqorders.quantity                AS quantity,
2104                 aqorders.quantity * aqorders.rrp AS subtotal,
2105                 (CAST(now() AS date) - closedate)            AS latesince
2106         ";
2107         if ( defined $delay ) {
2108             $from .= " AND (closedate <= (CAST(now() AS date) -(INTERVAL ? DAY)) ";
2109             push @query_params, $delay;
2110         }
2111     }
2112     if (defined $supplierid) {
2113         $from .= ' AND aqbasket.booksellerid = ? ';
2114         push @query_params, $supplierid;
2115     }
2116     if (defined $branch) {
2117         $from .= ' AND borrowers.branchcode LIKE ? ';
2118         push @query_params, $branch;
2119     }
2120
2121     if ( defined $estimateddeliverydatefrom or defined $estimateddeliverydateto ) {
2122         $from .= ' AND aqbooksellers.deliverytime IS NOT NULL ';
2123     }
2124     if ( defined $estimateddeliverydatefrom ) {
2125         $from .= ' AND ADDDATE(aqbasket.closedate, INTERVAL aqbooksellers.deliverytime DAY) >= ?';
2126         push @query_params, $estimateddeliverydatefrom;
2127     }
2128     if ( defined $estimateddeliverydateto ) {
2129         $from .= ' AND ADDDATE(aqbasket.closedate, INTERVAL aqbooksellers.deliverytime DAY) <= ?';
2130         push @query_params, $estimateddeliverydateto;
2131     }
2132     if ( defined $estimateddeliverydatefrom and not defined $estimateddeliverydateto ) {
2133         $from .= ' AND ADDDATE(aqbasket.closedate, INTERVAL aqbooksellers.deliverytime DAY) <= CAST(now() AS date)';
2134     }
2135     if (C4::Context->preference("IndependentBranches")
2136             && !C4::Context->IsSuperLibrarian() ) {
2137         $from .= ' AND borrowers.branchcode LIKE ? ';
2138         push @query_params, C4::Context->userenv->{branch};
2139     }
2140     $from .= " AND orderstatus <> 'cancelled' ";
2141     my $query = "$select $from $having\nORDER BY latesince, basketno, borrowers.branchcode, supplier";
2142     $debug and print STDERR "GetLateOrders query: $query\nGetLateOrders args: " . join(" ",@query_params);
2143     my $sth = $dbh->prepare($query);
2144     $sth->execute(@query_params);
2145     my @results;
2146     while (my $data = $sth->fetchrow_hashref) {
2147         push @results, $data;
2148     }
2149     return @results;
2150 }
2151
2152 #------------------------------------------------------------#
2153
2154 =head3 GetHistory
2155
2156   \@order_loop = GetHistory( %params );
2157
2158 Retreives some acquisition history information
2159
2160 params:
2161   title
2162   author
2163   name
2164   isbn
2165   ean
2166   from_placed_on
2167   to_placed_on
2168   basket                  - search both basket name and number
2169   booksellerinvoicenumber
2170   basketgroupname
2171   budget
2172   orderstatus (note that orderstatus '' will retrieve orders
2173                of any status except cancelled)
2174   biblionumber
2175   get_canceled_order (if set to a true value, cancelled orders will
2176                       be included)
2177
2178 returns:
2179     $order_loop is a list of hashrefs that each look like this:
2180             {
2181                 'author'           => 'Twain, Mark',
2182                 'basketno'         => '1',
2183                 'biblionumber'     => '215',
2184                 'count'            => 1,
2185                 'creationdate'     => 'MM/DD/YYYY',
2186                 'datereceived'     => undef,
2187                 'ecost'            => '1.00',
2188                 'id'               => '1',
2189                 'invoicenumber'    => undef,
2190                 'name'             => '',
2191                 'ordernumber'      => '1',
2192                 'quantity'         => 1,
2193                 'quantityreceived' => undef,
2194                 'title'            => 'The Adventures of Huckleberry Finn'
2195             }
2196
2197 =cut
2198
2199 sub GetHistory {
2200 # don't run the query if there are no parameters (list would be too long for sure !)
2201     croak "No search params" unless @_;
2202     my %params = @_;
2203     my $title = $params{title};
2204     my $author = $params{author};
2205     my $isbn   = $params{isbn};
2206     my $ean    = $params{ean};
2207     my $name = $params{name};
2208     my $from_placed_on = $params{from_placed_on};
2209     my $to_placed_on = $params{to_placed_on};
2210     my $basket = $params{basket};
2211     my $booksellerinvoicenumber = $params{booksellerinvoicenumber};
2212     my $basketgroupname = $params{basketgroupname};
2213     my $budget = $params{budget};
2214     my $orderstatus = $params{orderstatus};
2215     my $biblionumber = $params{biblionumber};
2216     my $get_canceled_order = $params{get_canceled_order} || 0;
2217     my $ordernumber = $params{ordernumber};
2218     my $search_children_too = $params{search_children_too} || 0;
2219     my $created_by = $params{created_by} || [];
2220
2221     my @order_loop;
2222     my $total_qty         = 0;
2223     my $total_qtyreceived = 0;
2224     my $total_price       = 0;
2225
2226     my $dbh   = C4::Context->dbh;
2227     my $query ="
2228         SELECT
2229             COALESCE(biblio.title,     deletedbiblio.title)     AS title,
2230             COALESCE(biblio.author,    deletedbiblio.author)    AS author,
2231             COALESCE(biblioitems.isbn, deletedbiblioitems.isbn) AS isbn,
2232             COALESCE(biblioitems.ean,  deletedbiblioitems.ean)  AS ean,
2233             aqorders.basketno,
2234             aqbasket.basketname,
2235             aqbasket.basketgroupid,
2236             aqbasket.authorisedby,
2237             concat( borrowers.firstname,' ',borrowers.surname) AS authorisedbyname,
2238             aqbasketgroups.name as groupname,
2239             aqbooksellers.name,
2240             aqbasket.creationdate,
2241             aqorders.datereceived,
2242             aqorders.quantity,
2243             aqorders.quantityreceived,
2244             aqorders.ecost,
2245             aqorders.ordernumber,
2246             aqorders.invoiceid,
2247             aqinvoices.invoicenumber,
2248             aqbooksellers.id as id,
2249             aqorders.biblionumber,
2250             aqorders.orderstatus,
2251             aqorders.parent_ordernumber,
2252             aqbudgets.budget_name
2253             ";
2254     $query .= ", aqbudgets.budget_id AS budget" if defined $budget;
2255     $query .= "
2256         FROM aqorders
2257         LEFT JOIN aqbasket ON aqorders.basketno=aqbasket.basketno
2258         LEFT JOIN aqbasketgroups ON aqbasket.basketgroupid=aqbasketgroups.id
2259         LEFT JOIN aqbooksellers ON aqbasket.booksellerid=aqbooksellers.id
2260         LEFT JOIN biblioitems ON biblioitems.biblionumber=aqorders.biblionumber
2261         LEFT JOIN biblio ON biblio.biblionumber=aqorders.biblionumber
2262         LEFT JOIN aqbudgets ON aqorders.budget_id=aqbudgets.budget_id
2263         LEFT JOIN aqinvoices ON aqorders.invoiceid = aqinvoices.invoiceid
2264         LEFT JOIN deletedbiblio ON deletedbiblio.biblionumber=aqorders.biblionumber
2265         LEFT JOIN deletedbiblioitems ON deletedbiblioitems.biblionumber=aqorders.biblionumber
2266         LEFT JOIN borrowers ON aqbasket.authorisedby=borrowers.borrowernumber
2267         ";
2268
2269     $query .= " WHERE 1 ";
2270
2271     unless ($get_canceled_order or (defined $orderstatus and $orderstatus eq 'cancelled')) {
2272         $query .= " AND (datecancellationprinted is NULL or datecancellationprinted='0000-00-00') ";
2273     }
2274
2275     my @query_params  = ();
2276
2277     if ( $biblionumber ) {
2278         $query .= " AND biblio.biblionumber = ?";
2279         push @query_params, $biblionumber;
2280     }
2281
2282     if ( $title ) {
2283         $query .= " AND biblio.title LIKE ? ";
2284         $title =~ s/\s+/%/g;
2285         push @query_params, "%$title%";
2286     }
2287
2288     if ( $author ) {
2289         $query .= " AND biblio.author LIKE ? ";
2290         push @query_params, "%$author%";
2291     }
2292
2293     if ( $isbn ) {
2294         $query .= " AND biblioitems.isbn LIKE ? ";
2295         push @query_params, "%$isbn%";
2296     }
2297     if ( $ean ) {
2298         $query .= " AND biblioitems.ean = ? ";
2299         push @query_params, "$ean";
2300     }
2301     if ( $name ) {
2302         $query .= " AND aqbooksellers.name LIKE ? ";
2303         push @query_params, "%$name%";
2304     }
2305
2306     if ( $budget ) {
2307         $query .= " AND aqbudgets.budget_id = ? ";
2308         push @query_params, "$budget";
2309     }
2310
2311     if ( $from_placed_on ) {
2312         $query .= " AND creationdate >= ? ";
2313         push @query_params, $from_placed_on;
2314     }
2315
2316     if ( $to_placed_on ) {
2317         $query .= " AND creationdate <= ? ";
2318         push @query_params, $to_placed_on;
2319     }
2320
2321     if ( defined $orderstatus and $orderstatus ne '') {
2322         $query .= " AND aqorders.orderstatus = ? ";
2323         push @query_params, "$orderstatus";
2324     }
2325
2326     if ($basket) {
2327         if ($basket =~ m/^\d+$/) {
2328             $query .= " AND aqorders.basketno = ? ";
2329             push @query_params, $basket;
2330         } else {
2331             $query .= " AND aqbasket.basketname LIKE ? ";
2332             push @query_params, "%$basket%";
2333         }
2334     }
2335
2336     if ($booksellerinvoicenumber) {
2337         $query .= " AND aqinvoices.invoicenumber LIKE ? ";
2338         push @query_params, "%$booksellerinvoicenumber%";
2339     }
2340
2341     if ($basketgroupname) {
2342         $query .= " AND aqbasketgroups.name LIKE ? ";
2343         push @query_params, "%$basketgroupname%";
2344     }
2345
2346     if ($ordernumber) {
2347         $query .= " AND (aqorders.ordernumber = ? ";
2348         push @query_params, $ordernumber;
2349         if ($search_children_too) {
2350             $query .= " OR aqorders.parent_ordernumber = ? ";
2351             push @query_params, $ordernumber;
2352         }
2353         $query .= ") ";
2354     }
2355
2356     if ( @$created_by ) {
2357         $query .= ' AND aqbasket.authorisedby IN ( ' . join( ',', ('?') x @$created_by ) . ')';
2358         push @query_params, @$created_by;
2359     }
2360
2361
2362     if ( C4::Context->preference("IndependentBranches") ) {
2363         unless ( C4::Context->IsSuperLibrarian() ) {
2364             $query .= " AND (borrowers.branchcode = ? OR borrowers.branchcode ='' ) ";
2365             push @query_params, C4::Context->userenv->{branch};
2366         }
2367     }
2368     $query .= " ORDER BY id";
2369
2370     return $dbh->selectall_arrayref( $query, { Slice => {} }, @query_params );
2371 }
2372
2373 =head2 GetRecentAcqui
2374
2375   $results = GetRecentAcqui($days);
2376
2377 C<$results> is a ref to a table which containts hashref
2378
2379 =cut
2380
2381 sub GetRecentAcqui {
2382     my $limit  = shift;
2383     my $dbh    = C4::Context->dbh;
2384     my $query = "
2385         SELECT *
2386         FROM   biblio
2387         ORDER BY timestamp DESC
2388         LIMIT  0,".$limit;
2389
2390     my $sth = $dbh->prepare($query);
2391     $sth->execute;
2392     my $results = $sth->fetchall_arrayref({});
2393     return $results;
2394 }
2395
2396 #------------------------------------------------------------#
2397
2398 =head3 AddClaim
2399
2400   &AddClaim($ordernumber);
2401
2402 Add a claim for an order
2403
2404 =cut
2405
2406 sub AddClaim {
2407     my ($ordernumber) = @_;
2408     my $dbh          = C4::Context->dbh;
2409     my $query        = "
2410         UPDATE aqorders SET
2411             claims_count = claims_count + 1,
2412             claimed_date = CURDATE()
2413         WHERE ordernumber = ?
2414         ";
2415     my $sth = $dbh->prepare($query);
2416     $sth->execute($ordernumber);
2417 }
2418
2419 =head3 GetInvoices
2420
2421     my @invoices = GetInvoices(
2422         invoicenumber => $invoicenumber,
2423         supplierid => $supplierid,
2424         suppliername => $suppliername,
2425         shipmentdatefrom => $shipmentdatefrom, # ISO format
2426         shipmentdateto => $shipmentdateto, # ISO format
2427         billingdatefrom => $billingdatefrom, # ISO format
2428         billingdateto => $billingdateto, # ISO format
2429         isbneanissn => $isbn_or_ean_or_issn,
2430         title => $title,
2431         author => $author,
2432         publisher => $publisher,
2433         publicationyear => $publicationyear,
2434         branchcode => $branchcode,
2435         order_by => $order_by
2436     );
2437
2438 Return a list of invoices that match all given criteria.
2439
2440 $order_by is "column_name (asc|desc)", where column_name is any of
2441 'invoicenumber', 'booksellerid', 'shipmentdate', 'billingdate', 'closedate',
2442 'shipmentcost', 'shipmentcost_budgetid'.
2443
2444 asc is the default if omitted
2445
2446 =cut
2447
2448 sub GetInvoices {
2449     my %args = @_;
2450
2451     my @columns = qw(invoicenumber booksellerid shipmentdate billingdate
2452         closedate shipmentcost shipmentcost_budgetid);
2453
2454     my $dbh = C4::Context->dbh;
2455     my $query = qq{
2456         SELECT aqinvoices.*, aqbooksellers.name AS suppliername,
2457           COUNT(
2458             DISTINCT IF(
2459               aqorders.datereceived IS NOT NULL,
2460               aqorders.biblionumber,
2461               NULL
2462             )
2463           ) AS receivedbiblios,
2464           COUNT(
2465              DISTINCT IF(
2466               aqorders.subscriptionid IS NOT NULL,
2467               aqorders.subscriptionid,
2468               NULL
2469             )
2470           ) AS is_linked_to_subscriptions,
2471           SUM(aqorders.quantityreceived) AS receiveditems
2472         FROM aqinvoices
2473           LEFT JOIN aqbooksellers ON aqbooksellers.id = aqinvoices.booksellerid
2474           LEFT JOIN aqorders ON aqorders.invoiceid = aqinvoices.invoiceid
2475           LEFT JOIN aqbasket ON aqbasket.basketno=aqorders.basketno
2476           LEFT JOIN borrowers ON aqbasket.authorisedby=borrowers.borrowernumber
2477           LEFT JOIN biblio ON aqorders.biblionumber = biblio.biblionumber
2478           LEFT JOIN biblioitems ON biblio.biblionumber = biblioitems.biblionumber
2479           LEFT JOIN subscription ON biblio.biblionumber = subscription.biblionumber
2480     };
2481
2482     my @bind_args;
2483     my @bind_strs;
2484     if($args{supplierid}) {
2485         push @bind_strs, " aqinvoices.booksellerid = ? ";
2486         push @bind_args, $args{supplierid};
2487     }
2488     if($args{invoicenumber}) {
2489         push @bind_strs, " aqinvoices.invoicenumber LIKE ? ";
2490         push @bind_args, "%$args{invoicenumber}%";
2491     }
2492     if($args{suppliername}) {
2493         push @bind_strs, " aqbooksellers.name LIKE ? ";
2494         push @bind_args, "%$args{suppliername}%";
2495     }
2496     if($args{shipmentdatefrom}) {
2497         push @bind_strs, " aqinvoices.shipmentdate >= ? ";
2498         push @bind_args, $args{shipmentdatefrom};
2499     }
2500     if($args{shipmentdateto}) {
2501         push @bind_strs, " aqinvoices.shipmentdate <= ? ";
2502         push @bind_args, $args{shipmentdateto};
2503     }
2504     if($args{billingdatefrom}) {
2505         push @bind_strs, " aqinvoices.billingdate >= ? ";
2506         push @bind_args, $args{billingdatefrom};
2507     }
2508     if($args{billingdateto}) {
2509         push @bind_strs, " aqinvoices.billingdate <= ? ";
2510         push @bind_args, $args{billingdateto};
2511     }
2512     if($args{isbneanissn}) {
2513         push @bind_strs, " (biblioitems.isbn LIKE CONCAT('%', ?, '%') OR biblioitems.ean LIKE CONCAT('%', ?, '%') OR biblioitems.issn LIKE CONCAT('%', ?, '%') ) ";
2514         push @bind_args, $args{isbneanissn}, $args{isbneanissn}, $args{isbneanissn};
2515     }
2516     if($args{title}) {
2517         push @bind_strs, " biblio.title LIKE CONCAT('%', ?, '%') ";
2518         push @bind_args, $args{title};
2519     }
2520     if($args{author}) {
2521         push @bind_strs, " biblio.author LIKE CONCAT('%', ?, '%') ";
2522         push @bind_args, $args{author};
2523     }
2524     if($args{publisher}) {
2525         push @bind_strs, " biblioitems.publishercode LIKE CONCAT('%', ?, '%') ";
2526         push @bind_args, $args{publisher};
2527     }
2528     if($args{publicationyear}) {
2529         push @bind_strs, " ((biblioitems.publicationyear LIKE CONCAT('%', ?, '%')) OR (biblio.copyrightdate LIKE CONCAT('%', ?, '%'))) ";
2530         push @bind_args, $args{publicationyear}, $args{publicationyear};
2531     }
2532     if($args{branchcode}) {
2533         push @bind_strs, " borrowers.branchcode = ? ";
2534         push @bind_args, $args{branchcode};
2535     }
2536     if($args{message_id}) {
2537         push @bind_strs, " aqinvoices.message_id = ? ";
2538         push @bind_args, $args{message_id};
2539     }
2540
2541     $query .= " WHERE " . join(" AND ", @bind_strs) if @bind_strs;
2542     $query .= " GROUP BY aqinvoices.invoiceid ";
2543
2544     if($args{order_by}) {
2545         my ($column, $direction) = split / /, $args{order_by};
2546         if(grep /^$column$/, @columns) {
2547             $direction ||= 'ASC';
2548             $query .= " ORDER BY $column $direction";
2549         }
2550     }
2551
2552     my $sth = $dbh->prepare($query);
2553     $sth->execute(@bind_args);
2554
2555     my $results = $sth->fetchall_arrayref({});
2556     return @$results;
2557 }
2558
2559 =head3 GetInvoice
2560
2561     my $invoice = GetInvoice($invoiceid);
2562
2563 Get informations about invoice with given $invoiceid
2564
2565 Return a hash filled with aqinvoices.* fields
2566
2567 =cut
2568
2569 sub GetInvoice {
2570     my ($invoiceid) = @_;
2571     my $invoice;
2572
2573     return unless $invoiceid;
2574
2575     my $dbh = C4::Context->dbh;
2576     my $query = qq{
2577         SELECT *
2578         FROM aqinvoices
2579         WHERE invoiceid = ?
2580     };
2581     my $sth = $dbh->prepare($query);
2582     $sth->execute($invoiceid);
2583
2584     $invoice = $sth->fetchrow_hashref;
2585     return $invoice;
2586 }
2587
2588 =head3 GetInvoiceDetails
2589
2590     my $invoice = GetInvoiceDetails($invoiceid)
2591
2592 Return informations about an invoice + the list of related order lines
2593
2594 Orders informations are in $invoice->{orders} (array ref)
2595
2596 =cut
2597
2598 sub GetInvoiceDetails {
2599     my ($invoiceid) = @_;
2600
2601     if ( !defined $invoiceid ) {
2602         carp 'GetInvoiceDetails called without an invoiceid';
2603         return;
2604     }
2605
2606     my $dbh = C4::Context->dbh;
2607     my $query = q{
2608         SELECT aqinvoices.*, aqbooksellers.name AS suppliername
2609         FROM aqinvoices
2610           LEFT JOIN aqbooksellers ON aqinvoices.booksellerid = aqbooksellers.id
2611         WHERE invoiceid = ?
2612     };
2613     my $sth = $dbh->prepare($query);
2614     $sth->execute($invoiceid);
2615
2616     my $invoice = $sth->fetchrow_hashref;
2617
2618     $query = q{
2619         SELECT aqorders.*,
2620                 biblio.*,
2621                 biblio.copyrightdate,
2622                 biblioitems.isbn,
2623                 biblioitems.publishercode,
2624                 biblioitems.publicationyear,
2625                 aqbasket.basketname,
2626                 aqbasketgroups.id AS basketgroupid,
2627                 aqbasketgroups.name AS basketgroupname
2628         FROM aqorders
2629           LEFT JOIN aqbasket ON aqorders.basketno = aqbasket.basketno
2630           LEFT JOIN aqbasketgroups ON aqbasket.basketgroupid = aqbasketgroups.id
2631           LEFT JOIN biblio ON aqorders.biblionumber = biblio.biblionumber
2632           LEFT JOIN biblioitems ON aqorders.biblionumber = biblioitems.biblionumber
2633         WHERE invoiceid = ?
2634     };
2635     $sth = $dbh->prepare($query);
2636     $sth->execute($invoiceid);
2637     $invoice->{orders} = $sth->fetchall_arrayref({});
2638     $invoice->{orders} ||= []; # force an empty arrayref if fetchall_arrayref fails
2639
2640     return $invoice;
2641 }
2642
2643 =head3 AddInvoice
2644
2645     my $invoiceid = AddInvoice(
2646         invoicenumber => $invoicenumber,
2647         booksellerid => $booksellerid,
2648         shipmentdate => $shipmentdate,
2649         billingdate => $billingdate,
2650         closedate => $closedate,
2651         shipmentcost => $shipmentcost,
2652         shipmentcost_budgetid => $shipmentcost_budgetid
2653     );
2654
2655 Create a new invoice and return its id or undef if it fails.
2656
2657 =cut
2658
2659 sub AddInvoice {
2660     my %invoice = @_;
2661
2662     return unless(%invoice and $invoice{invoicenumber});
2663
2664     my @columns = qw(invoicenumber booksellerid shipmentdate billingdate
2665         closedate shipmentcost shipmentcost_budgetid message_id);
2666
2667     my @set_strs;
2668     my @set_args;
2669     foreach my $key (keys %invoice) {
2670         if(0 < grep(/^$key$/, @columns)) {
2671             push @set_strs, "$key = ?";
2672             push @set_args, ($invoice{$key} || undef);
2673         }
2674     }
2675
2676     my $rv;
2677     if(@set_args > 0) {
2678         my $dbh = C4::Context->dbh;
2679         my $query = "INSERT INTO aqinvoices SET ";
2680         $query .= join (",", @set_strs);
2681         my $sth = $dbh->prepare($query);
2682         $rv = $sth->execute(@set_args);
2683         if($rv) {
2684             $rv = $dbh->last_insert_id(undef, undef, 'aqinvoices', undef);
2685         }
2686     }
2687     return $rv;
2688 }
2689
2690 =head3 ModInvoice
2691
2692     ModInvoice(
2693         invoiceid => $invoiceid,    # Mandatory
2694         invoicenumber => $invoicenumber,
2695         booksellerid => $booksellerid,
2696         shipmentdate => $shipmentdate,
2697         billingdate => $billingdate,
2698         closedate => $closedate,
2699         shipmentcost => $shipmentcost,
2700         shipmentcost_budgetid => $shipmentcost_budgetid
2701     );
2702
2703 Modify an invoice, invoiceid is mandatory.
2704
2705 Return undef if it fails.
2706
2707 =cut
2708
2709 sub ModInvoice {
2710     my %invoice = @_;
2711
2712     return unless(%invoice and $invoice{invoiceid});
2713
2714     my @columns = qw(invoicenumber booksellerid shipmentdate billingdate
2715         closedate shipmentcost shipmentcost_budgetid);
2716
2717     my @set_strs;
2718     my @set_args;
2719     foreach my $key (keys %invoice) {
2720         if(0 < grep(/^$key$/, @columns)) {
2721             push @set_strs, "$key = ?";
2722             push @set_args, ($invoice{$key} || undef);
2723         }
2724     }
2725
2726     my $dbh = C4::Context->dbh;
2727     my $query = "UPDATE aqinvoices SET ";
2728     $query .= join(",", @set_strs);
2729     $query .= " WHERE invoiceid = ?";
2730
2731     my $sth = $dbh->prepare($query);
2732     $sth->execute(@set_args, $invoice{invoiceid});
2733 }
2734
2735 =head3 CloseInvoice
2736
2737     CloseInvoice($invoiceid);
2738
2739 Close an invoice.
2740
2741 Equivalent to ModInvoice(invoiceid => $invoiceid, closedate => undef);
2742
2743 =cut
2744
2745 sub CloseInvoice {
2746     my ($invoiceid) = @_;
2747
2748     return unless $invoiceid;
2749
2750     my $dbh = C4::Context->dbh;
2751     my $query = qq{
2752         UPDATE aqinvoices
2753         SET closedate = CAST(NOW() AS DATE)
2754         WHERE invoiceid = ?
2755     };
2756     my $sth = $dbh->prepare($query);
2757     $sth->execute($invoiceid);
2758 }
2759
2760 =head3 ReopenInvoice
2761
2762     ReopenInvoice($invoiceid);
2763
2764 Reopen an invoice
2765
2766 Equivalent to ModInvoice(invoiceid => $invoiceid, closedate => output_pref({ dt=>dt_from_string, dateonly=>1, otputpref=>'iso' }))
2767
2768 =cut
2769
2770 sub ReopenInvoice {
2771     my ($invoiceid) = @_;
2772
2773     return unless $invoiceid;
2774
2775     my $dbh = C4::Context->dbh;
2776     my $query = qq{
2777         UPDATE aqinvoices
2778         SET closedate = NULL
2779         WHERE invoiceid = ?
2780     };
2781     my $sth = $dbh->prepare($query);
2782     $sth->execute($invoiceid);
2783 }
2784
2785 =head3 DelInvoice
2786
2787     DelInvoice($invoiceid);
2788
2789 Delete an invoice if there are no items attached to it.
2790
2791 =cut
2792
2793 sub DelInvoice {
2794     my ($invoiceid) = @_;
2795
2796     return unless $invoiceid;
2797
2798     my $dbh   = C4::Context->dbh;
2799     my $query = qq{
2800         SELECT COUNT(*)
2801         FROM aqorders
2802         WHERE invoiceid = ?
2803     };
2804     my $sth = $dbh->prepare($query);
2805     $sth->execute($invoiceid);
2806     my $res = $sth->fetchrow_arrayref;
2807     if ( $res && $res->[0] == 0 ) {
2808         $query = qq{
2809             DELETE FROM aqinvoices
2810             WHERE invoiceid = ?
2811         };
2812         my $sth = $dbh->prepare($query);
2813         return ( $sth->execute($invoiceid) > 0 );
2814     }
2815     return;
2816 }
2817
2818 =head3 MergeInvoices
2819
2820     MergeInvoices($invoiceid, \@sourceids);
2821
2822 Merge the invoices identified by the IDs in \@sourceids into
2823 the invoice identified by $invoiceid.
2824
2825 =cut
2826
2827 sub MergeInvoices {
2828     my ($invoiceid, $sourceids) = @_;
2829
2830     return unless $invoiceid;
2831     foreach my $sourceid (@$sourceids) {
2832         next if $sourceid == $invoiceid;
2833         my $source = GetInvoiceDetails($sourceid);
2834         foreach my $order (@{$source->{'orders'}}) {
2835             $order->{'invoiceid'} = $invoiceid;
2836             ModOrder($order);
2837         }
2838         DelInvoice($source->{'invoiceid'});
2839     }
2840     return;
2841 }
2842
2843 =head3 GetBiblioCountByBasketno
2844
2845 $biblio_count = &GetBiblioCountByBasketno($basketno);
2846
2847 Looks up the biblio's count that has basketno value $basketno
2848
2849 Returns a quantity
2850
2851 =cut
2852
2853 sub GetBiblioCountByBasketno {
2854     my ($basketno) = @_;
2855     my $dbh          = C4::Context->dbh;
2856     my $query        = "
2857         SELECT COUNT( DISTINCT( biblionumber ) )
2858         FROM   aqorders
2859         WHERE  basketno = ?
2860             AND (datecancellationprinted IS NULL OR datecancellationprinted='0000-00-00')
2861         ";
2862
2863     my $sth = $dbh->prepare($query);
2864     $sth->execute($basketno);
2865     return $sth->fetchrow;
2866 }
2867
2868 # Note this subroutine should be moved to Koha::Acquisition::Order
2869 # Will do when a DBIC decision will be taken.
2870 sub populate_order_with_prices {
2871     my ($params) = @_;
2872
2873     my $order        = $params->{order};
2874     my $booksellerid = $params->{booksellerid};
2875     return unless $booksellerid;
2876
2877     my $bookseller = Koha::Acquisition::Booksellers->find( $booksellerid );
2878
2879     my $receiving = $params->{receiving};
2880     my $ordering  = $params->{ordering};
2881     my $discount  = $order->{discount};
2882     $discount /= 100 if $discount > 1;
2883
2884     if ($ordering) {
2885         $order->{tax_rate_on_ordering} //= $order->{tax_rate};
2886         if ( $bookseller->listincgst ) {
2887             # The user entered the rrp tax included
2888             $order->{rrp_tax_included} = $order->{rrp};
2889
2890             # rrp tax excluded = rrp tax included / ( 1 + tax rate )
2891             $order->{rrp_tax_excluded} = $order->{rrp_tax_included} / ( 1 + $order->{tax_rate_on_ordering} );
2892
2893             # ecost tax excluded = rrp tax excluded * ( 1 - discount )
2894             $order->{ecost_tax_excluded} = $order->{rrp_tax_excluded} * ( 1 - $discount );
2895
2896             # ecost tax included = rrp tax included  ( 1 - discount )
2897             $order->{ecost_tax_included} = $order->{rrp_tax_included} * ( 1 - $discount );
2898         }
2899         else {
2900             # The user entered the rrp tax excluded
2901             $order->{rrp_tax_excluded} = $order->{rrp};
2902
2903             # rrp tax included = rrp tax excluded * ( 1 - tax rate )
2904             $order->{rrp_tax_included} = $order->{rrp_tax_excluded} * ( 1 + $order->{tax_rate_on_ordering} );
2905
2906             # ecost tax excluded = rrp tax excluded * ( 1 - discount )
2907             $order->{ecost_tax_excluded} = $order->{rrp_tax_excluded} * ( 1 - $discount );
2908
2909             # ecost tax included = rrp tax excluded * ( 1 - tax rate ) * ( 1 - discount )
2910             $order->{ecost_tax_included} =
2911                 $order->{rrp_tax_excluded} *
2912                 ( 1 + $order->{tax_rate_on_ordering} ) *
2913                 ( 1 - $discount );
2914         }
2915
2916         # tax value = quantity * ecost tax excluded * tax rate
2917         $order->{tax_value_on_ordering} =
2918             $order->{quantity} * $order->{ecost_tax_excluded} * $order->{tax_rate_on_ordering};
2919     }
2920
2921     if ($receiving) {
2922         $order->{tax_rate_on_receiving} //= $order->{tax_rate};
2923         if ( $bookseller->invoiceincgst ) {
2924             # Trick for unitprice. If the unit price rounded value is the same as the ecost rounded value
2925             # we need to keep the exact ecost value
2926             if ( Koha::Number::Price->new( $order->{unitprice} )->round == Koha::Number::Price->new( $order->{ecost_tax_included} )->round ) {
2927                 $order->{unitprice} = $order->{ecost_tax_included};
2928             }
2929
2930             # The user entered the unit price tax included
2931             $order->{unitprice_tax_included} = $order->{unitprice};
2932
2933             # unit price tax excluded = unit price tax included / ( 1 + tax rate )
2934             $order->{unitprice_tax_excluded} = $order->{unitprice_tax_included} / ( 1 + $order->{tax_rate_on_receiving} );
2935         }
2936         else {
2937             # Trick for unitprice. If the unit price rounded value is the same as the ecost rounded value
2938             # we need to keep the exact ecost value
2939             if ( Koha::Number::Price->new( $order->{unitprice} )->round == Koha::Number::Price->new( $order->{ecost_tax_excluded} )->round ) {
2940                 $order->{unitprice} = $order->{ecost_tax_excluded};
2941             }
2942
2943             # The user entered the unit price tax excluded
2944             $order->{unitprice_tax_excluded} = $order->{unitprice};
2945
2946
2947             # unit price tax included = unit price tax included * ( 1 + tax rate )
2948             $order->{unitprice_tax_included} = $order->{unitprice_tax_excluded} * ( 1 + $order->{tax_rate_on_receiving} );
2949         }
2950
2951         # tax value = quantity * unit price tax excluded * tax rate
2952         $order->{tax_value_on_receiving} = $order->{quantity} * $order->{unitprice_tax_excluded} * $order->{tax_rate_on_receiving};
2953     }
2954
2955     return $order;
2956 }
2957
2958 =head3 GetOrderUsers
2959
2960     $order_users_ids = &GetOrderUsers($ordernumber);
2961
2962 Returns a list of all borrowernumbers that are in order users list
2963
2964 =cut
2965
2966 sub GetOrderUsers {
2967     my ($ordernumber) = @_;
2968
2969     return unless $ordernumber;
2970
2971     my $query = q|
2972         SELECT borrowernumber
2973         FROM aqorder_users
2974         WHERE ordernumber = ?
2975     |;
2976     my $dbh = C4::Context->dbh;
2977     my $sth = $dbh->prepare($query);
2978     $sth->execute($ordernumber);
2979     my $results = $sth->fetchall_arrayref( {} );
2980
2981     my @borrowernumbers;
2982     foreach (@$results) {
2983         push @borrowernumbers, $_->{'borrowernumber'};
2984     }
2985
2986     return @borrowernumbers;
2987 }
2988
2989 =head3 ModOrderUsers
2990
2991     my @order_users_ids = (1, 2, 3);
2992     &ModOrderUsers($ordernumber, @basketusers_ids);
2993
2994 Delete all users from order users list, and add users in C<@order_users_ids>
2995 to this users list.
2996
2997 =cut
2998
2999 sub ModOrderUsers {
3000     my ( $ordernumber, @order_users_ids ) = @_;
3001
3002     return unless $ordernumber;
3003
3004     my $dbh   = C4::Context->dbh;
3005     my $query = q|
3006         DELETE FROM aqorder_users
3007         WHERE ordernumber = ?
3008     |;
3009     my $sth = $dbh->prepare($query);
3010     $sth->execute($ordernumber);
3011
3012     $query = q|
3013         INSERT INTO aqorder_users (ordernumber, borrowernumber)
3014         VALUES (?, ?)
3015     |;
3016     $sth = $dbh->prepare($query);
3017     foreach my $order_user_id (@order_users_ids) {
3018         $sth->execute( $ordernumber, $order_user_id );
3019     }
3020 }
3021
3022 sub NotifyOrderUsers {
3023     my ($ordernumber) = @_;
3024
3025     my @borrowernumbers = GetOrderUsers($ordernumber);
3026     return unless @borrowernumbers;
3027
3028     my $order = GetOrder( $ordernumber );
3029     for my $borrowernumber (@borrowernumbers) {
3030         my $borrower = C4::Members::GetMember( borrowernumber => $borrowernumber );
3031         my $library = Koha::Libraries->find( $borrower->{branchcode} )->unblessed;
3032         my $biblio = C4::Biblio::GetBiblio( $order->{biblionumber} );
3033         my $letter = C4::Letters::GetPreparedLetter(
3034             module      => 'acquisition',
3035             letter_code => 'ACQ_NOTIF_ON_RECEIV',
3036             branchcode  => $library->{branchcode},
3037             lang        => $borrower->{lang},
3038             tables      => {
3039                 'branches'    => $library,
3040                 'borrowers'   => $borrower,
3041                 'biblio'      => $biblio,
3042                 'aqorders'    => $order,
3043             },
3044         );
3045         if ( $letter ) {
3046             C4::Letters::EnqueueLetter(
3047                 {
3048                     letter         => $letter,
3049                     borrowernumber => $borrowernumber,
3050                     LibraryName    => C4::Context->preference("LibraryName"),
3051                     message_transport_type => 'email',
3052                 }
3053             ) or warn "can't enqueue letter $letter";
3054         }
3055     }
3056 }
3057
3058 =head3 FillWithDefaultValues
3059
3060 FillWithDefaultValues( $marc_record );
3061
3062 This will update the record with default value defined in the ACQ framework.
3063 For all existing fields, if a default value exists and there are no subfield, it will be created.
3064 If the field does not exist, it will be created too.
3065
3066 =cut
3067
3068 sub FillWithDefaultValues {
3069     my ($record) = @_;
3070     my $tagslib = C4::Biblio::GetMarcStructure( 1, 'ACQ', { unsafe => 1 } );
3071     if ($tagslib) {
3072         my ($itemfield) =
3073           C4::Biblio::GetMarcFromKohaField( 'items.itemnumber', '' );
3074         for my $tag ( sort keys %$tagslib ) {
3075             next unless $tag;
3076             next if $tag == $itemfield;
3077             for my $subfield ( sort keys %{ $tagslib->{$tag} } ) {
3078                 next if IsMarcStructureInternal($tagslib->{$tag}{$subfield});
3079                 my $defaultvalue = $tagslib->{$tag}{$subfield}{defaultvalue};
3080                 if ( defined $defaultvalue and $defaultvalue ne '' ) {
3081                     my @fields = $record->field($tag);
3082                     if (@fields) {
3083                         for my $field (@fields) {
3084                             unless ( defined $field->subfield($subfield) ) {
3085                                 $field->add_subfields(
3086                                     $subfield => $defaultvalue );
3087                             }
3088                         }
3089                     }
3090                     else {
3091                         $record->insert_fields_ordered(
3092                             MARC::Field->new(
3093                                 $tag, '', '', $subfield => $defaultvalue
3094                             )
3095                         );
3096                     }
3097                 }
3098             }
3099         }
3100     }
3101 }
3102
3103 1;
3104 __END__
3105
3106 =head1 AUTHOR
3107
3108 Koha Development Team <http://koha-community.org/>
3109
3110 =cut