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