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 = "
2093         HAVING quantity          <> 0
2094             AND unitpricesupplier <> 0
2095             AND unitpricelib      <> 0
2096         ";
2097     } else {
2098         # FIXME: account for IFNULL as above
2099         $select .= "
2100                 aqorders.quantity                AS quantity,
2101                 aqorders.quantity * aqorders.rrp AS subtotal,
2102                 (CAST(now() AS date) - closedate)            AS latesince
2103         ";
2104         if ( defined $delay ) {
2105             $from .= " AND (closedate <= (CAST(now() AS date) -(INTERVAL ? DAY)) ";
2106             push @query_params, $delay;
2107         }
2108     }
2109     if (defined $supplierid) {
2110         $from .= ' AND aqbasket.booksellerid = ? ';
2111         push @query_params, $supplierid;
2112     }
2113     if (defined $branch) {
2114         $from .= ' AND borrowers.branchcode LIKE ? ';
2115         push @query_params, $branch;
2116     }
2117
2118     if ( defined $estimateddeliverydatefrom or defined $estimateddeliverydateto ) {
2119         $from .= ' AND aqbooksellers.deliverytime IS NOT NULL ';
2120     }
2121     if ( defined $estimateddeliverydatefrom ) {
2122         $from .= ' AND ADDDATE(aqbasket.closedate, INTERVAL aqbooksellers.deliverytime DAY) >= ?';
2123         push @query_params, $estimateddeliverydatefrom;
2124     }
2125     if ( defined $estimateddeliverydateto ) {
2126         $from .= ' AND ADDDATE(aqbasket.closedate, INTERVAL aqbooksellers.deliverytime DAY) <= ?';
2127         push @query_params, $estimateddeliverydateto;
2128     }
2129     if ( defined $estimateddeliverydatefrom and not defined $estimateddeliverydateto ) {
2130         $from .= ' AND ADDDATE(aqbasket.closedate, INTERVAL aqbooksellers.deliverytime DAY) <= CAST(now() AS date)';
2131     }
2132     if (C4::Context->preference("IndependentBranches")
2133             && !C4::Context->IsSuperLibrarian() ) {
2134         $from .= ' AND borrowers.branchcode LIKE ? ';
2135         push @query_params, C4::Context->userenv->{branch};
2136     }
2137     $from .= " AND orderstatus <> 'cancelled' ";
2138     my $query = "$select $from $having\nORDER BY latesince, basketno, borrowers.branchcode, supplier";
2139     $debug and print STDERR "GetLateOrders query: $query\nGetLateOrders args: " . join(" ",@query_params);
2140     my $sth = $dbh->prepare($query);
2141     $sth->execute(@query_params);
2142     my @results;
2143     while (my $data = $sth->fetchrow_hashref) {
2144         push @results, $data;
2145     }
2146     return @results;
2147 }
2148
2149 #------------------------------------------------------------#
2150
2151 =head3 GetHistory
2152
2153   \@order_loop = GetHistory( %params );
2154
2155 Retreives some acquisition history information
2156
2157 params:
2158   title
2159   author
2160   name
2161   isbn
2162   ean
2163   from_placed_on
2164   to_placed_on
2165   basket                  - search both basket name and number
2166   booksellerinvoicenumber
2167   basketgroupname
2168   budget
2169   orderstatus (note that orderstatus '' will retrieve orders
2170                of any status except cancelled)
2171   biblionumber
2172   get_canceled_order (if set to a true value, cancelled orders will
2173                       be included)
2174
2175 returns:
2176     $order_loop is a list of hashrefs that each look like this:
2177             {
2178                 'author'           => 'Twain, Mark',
2179                 'basketno'         => '1',
2180                 'biblionumber'     => '215',
2181                 'count'            => 1,
2182                 'creationdate'     => 'MM/DD/YYYY',
2183                 'datereceived'     => undef,
2184                 'ecost'            => '1.00',
2185                 'id'               => '1',
2186                 'invoicenumber'    => undef,
2187                 'name'             => '',
2188                 'ordernumber'      => '1',
2189                 'quantity'         => 1,
2190                 'quantityreceived' => undef,
2191                 'title'            => 'The Adventures of Huckleberry Finn'
2192             }
2193
2194 =cut
2195
2196 sub GetHistory {
2197 # don't run the query if there are no parameters (list would be too long for sure !)
2198     croak "No search params" unless @_;
2199     my %params = @_;
2200     my $title = $params{title};
2201     my $author = $params{author};
2202     my $isbn   = $params{isbn};
2203     my $ean    = $params{ean};
2204     my $name = $params{name};
2205     my $from_placed_on = $params{from_placed_on};
2206     my $to_placed_on = $params{to_placed_on};
2207     my $basket = $params{basket};
2208     my $booksellerinvoicenumber = $params{booksellerinvoicenumber};
2209     my $basketgroupname = $params{basketgroupname};
2210     my $budget = $params{budget};
2211     my $orderstatus = $params{orderstatus};
2212     my $biblionumber = $params{biblionumber};
2213     my $get_canceled_order = $params{get_canceled_order} || 0;
2214     my $ordernumber = $params{ordernumber};
2215     my $search_children_too = $params{search_children_too} || 0;
2216     my $created_by = $params{created_by} || [];
2217
2218     my @order_loop;
2219     my $total_qty         = 0;
2220     my $total_qtyreceived = 0;
2221     my $total_price       = 0;
2222
2223     my $dbh   = C4::Context->dbh;
2224     my $query ="
2225         SELECT
2226             COALESCE(biblio.title,     deletedbiblio.title)     AS title,
2227             COALESCE(biblio.author,    deletedbiblio.author)    AS author,
2228             COALESCE(biblioitems.isbn, deletedbiblioitems.isbn) AS isbn,
2229             COALESCE(biblioitems.ean,  deletedbiblioitems.ean)  AS ean,
2230             aqorders.basketno,
2231             aqbasket.basketname,
2232             aqbasket.basketgroupid,
2233             aqbasket.authorisedby,
2234             concat( borrowers.firstname,' ',borrowers.surname) AS authorisedbyname,
2235             aqbasketgroups.name as groupname,
2236             aqbooksellers.name,
2237             aqbasket.creationdate,
2238             aqorders.datereceived,
2239             aqorders.quantity,
2240             aqorders.quantityreceived,
2241             aqorders.ecost,
2242             aqorders.ordernumber,
2243             aqorders.invoiceid,
2244             aqinvoices.invoicenumber,
2245             aqbooksellers.id as id,
2246             aqorders.biblionumber,
2247             aqorders.orderstatus,
2248             aqorders.parent_ordernumber,
2249             aqbudgets.budget_name
2250             ";
2251     $query .= ", aqbudgets.budget_id AS budget" if defined $budget;
2252     $query .= "
2253         FROM aqorders
2254         LEFT JOIN aqbasket ON aqorders.basketno=aqbasket.basketno
2255         LEFT JOIN aqbasketgroups ON aqbasket.basketgroupid=aqbasketgroups.id
2256         LEFT JOIN aqbooksellers ON aqbasket.booksellerid=aqbooksellers.id
2257         LEFT JOIN biblioitems ON biblioitems.biblionumber=aqorders.biblionumber
2258         LEFT JOIN biblio ON biblio.biblionumber=aqorders.biblionumber
2259         LEFT JOIN aqbudgets ON aqorders.budget_id=aqbudgets.budget_id
2260         LEFT JOIN aqinvoices ON aqorders.invoiceid = aqinvoices.invoiceid
2261         LEFT JOIN deletedbiblio ON deletedbiblio.biblionumber=aqorders.biblionumber
2262         LEFT JOIN deletedbiblioitems ON deletedbiblioitems.biblionumber=aqorders.biblionumber
2263         LEFT JOIN borrowers ON aqbasket.authorisedby=borrowers.borrowernumber
2264         ";
2265
2266     $query .= " WHERE 1 ";
2267
2268     unless ($get_canceled_order or (defined $orderstatus and $orderstatus eq 'cancelled')) {
2269         $query .= " AND (datecancellationprinted is NULL or datecancellationprinted='0000-00-00') ";
2270     }
2271
2272     my @query_params  = ();
2273
2274     if ( $biblionumber ) {
2275         $query .= " AND biblio.biblionumber = ?";
2276         push @query_params, $biblionumber;
2277     }
2278
2279     if ( $title ) {
2280         $query .= " AND biblio.title LIKE ? ";
2281         $title =~ s/\s+/%/g;
2282         push @query_params, "%$title%";
2283     }
2284
2285     if ( $author ) {
2286         $query .= " AND biblio.author LIKE ? ";
2287         push @query_params, "%$author%";
2288     }
2289
2290     if ( $isbn ) {
2291         $query .= " AND biblioitems.isbn LIKE ? ";
2292         push @query_params, "%$isbn%";
2293     }
2294     if ( $ean ) {
2295         $query .= " AND biblioitems.ean = ? ";
2296         push @query_params, "$ean";
2297     }
2298     if ( $name ) {
2299         $query .= " AND aqbooksellers.name LIKE ? ";
2300         push @query_params, "%$name%";
2301     }
2302
2303     if ( $budget ) {
2304         $query .= " AND aqbudgets.budget_id = ? ";
2305         push @query_params, "$budget";
2306     }
2307
2308     if ( $from_placed_on ) {
2309         $query .= " AND creationdate >= ? ";
2310         push @query_params, $from_placed_on;
2311     }
2312
2313     if ( $to_placed_on ) {
2314         $query .= " AND creationdate <= ? ";
2315         push @query_params, $to_placed_on;
2316     }
2317
2318     if ( defined $orderstatus and $orderstatus ne '') {
2319         $query .= " AND aqorders.orderstatus = ? ";
2320         push @query_params, "$orderstatus";
2321     }
2322
2323     if ($basket) {
2324         if ($basket =~ m/^\d+$/) {
2325             $query .= " AND aqorders.basketno = ? ";
2326             push @query_params, $basket;
2327         } else {
2328             $query .= " AND aqbasket.basketname LIKE ? ";
2329             push @query_params, "%$basket%";
2330         }
2331     }
2332
2333     if ($booksellerinvoicenumber) {
2334         $query .= " AND aqinvoices.invoicenumber LIKE ? ";
2335         push @query_params, "%$booksellerinvoicenumber%";
2336     }
2337
2338     if ($basketgroupname) {
2339         $query .= " AND aqbasketgroups.name LIKE ? ";
2340         push @query_params, "%$basketgroupname%";
2341     }
2342
2343     if ($ordernumber) {
2344         $query .= " AND (aqorders.ordernumber = ? ";
2345         push @query_params, $ordernumber;
2346         if ($search_children_too) {
2347             $query .= " OR aqorders.parent_ordernumber = ? ";
2348             push @query_params, $ordernumber;
2349         }
2350         $query .= ") ";
2351     }
2352
2353     if ( @$created_by ) {
2354         $query .= ' AND aqbasket.authorisedby IN ( ' . join( ',', ('?') x @$created_by ) . ')';
2355         push @query_params, @$created_by;
2356     }
2357
2358
2359     if ( C4::Context->preference("IndependentBranches") ) {
2360         unless ( C4::Context->IsSuperLibrarian() ) {
2361             $query .= " AND (borrowers.branchcode = ? OR borrowers.branchcode ='' ) ";
2362             push @query_params, C4::Context->userenv->{branch};
2363         }
2364     }
2365     $query .= " ORDER BY id";
2366
2367     return $dbh->selectall_arrayref( $query, { Slice => {} }, @query_params );
2368 }
2369
2370 =head2 GetRecentAcqui
2371
2372   $results = GetRecentAcqui($days);
2373
2374 C<$results> is a ref to a table which containts hashref
2375
2376 =cut
2377
2378 sub GetRecentAcqui {
2379     my $limit  = shift;
2380     my $dbh    = C4::Context->dbh;
2381     my $query = "
2382         SELECT *
2383         FROM   biblio
2384         ORDER BY timestamp DESC
2385         LIMIT  0,".$limit;
2386
2387     my $sth = $dbh->prepare($query);
2388     $sth->execute;
2389     my $results = $sth->fetchall_arrayref({});
2390     return $results;
2391 }
2392
2393 #------------------------------------------------------------#
2394
2395 =head3 AddClaim
2396
2397   &AddClaim($ordernumber);
2398
2399 Add a claim for an order
2400
2401 =cut
2402
2403 sub AddClaim {
2404     my ($ordernumber) = @_;
2405     my $dbh          = C4::Context->dbh;
2406     my $query        = "
2407         UPDATE aqorders SET
2408             claims_count = claims_count + 1,
2409             claimed_date = CURDATE()
2410         WHERE ordernumber = ?
2411         ";
2412     my $sth = $dbh->prepare($query);
2413     $sth->execute($ordernumber);
2414 }
2415
2416 =head3 GetInvoices
2417
2418     my @invoices = GetInvoices(
2419         invoicenumber => $invoicenumber,
2420         supplierid => $supplierid,
2421         suppliername => $suppliername,
2422         shipmentdatefrom => $shipmentdatefrom, # ISO format
2423         shipmentdateto => $shipmentdateto, # ISO format
2424         billingdatefrom => $billingdatefrom, # ISO format
2425         billingdateto => $billingdateto, # ISO format
2426         isbneanissn => $isbn_or_ean_or_issn,
2427         title => $title,
2428         author => $author,
2429         publisher => $publisher,
2430         publicationyear => $publicationyear,
2431         branchcode => $branchcode,
2432         order_by => $order_by
2433     );
2434
2435 Return a list of invoices that match all given criteria.
2436
2437 $order_by is "column_name (asc|desc)", where column_name is any of
2438 'invoicenumber', 'booksellerid', 'shipmentdate', 'billingdate', 'closedate',
2439 'shipmentcost', 'shipmentcost_budgetid'.
2440
2441 asc is the default if omitted
2442
2443 =cut
2444
2445 sub GetInvoices {
2446     my %args = @_;
2447
2448     my @columns = qw(invoicenumber booksellerid shipmentdate billingdate
2449         closedate shipmentcost shipmentcost_budgetid);
2450
2451     my $dbh = C4::Context->dbh;
2452     my $query = qq{
2453         SELECT aqinvoices.*, aqbooksellers.name AS suppliername,
2454           COUNT(
2455             DISTINCT IF(
2456               aqorders.datereceived IS NOT NULL,
2457               aqorders.biblionumber,
2458               NULL
2459             )
2460           ) AS receivedbiblios,
2461           COUNT(
2462              DISTINCT IF(
2463               aqorders.subscriptionid IS NOT NULL,
2464               aqorders.subscriptionid,
2465               NULL
2466             )
2467           ) AS is_linked_to_subscriptions,
2468           SUM(aqorders.quantityreceived) AS receiveditems
2469         FROM aqinvoices
2470           LEFT JOIN aqbooksellers ON aqbooksellers.id = aqinvoices.booksellerid
2471           LEFT JOIN aqorders ON aqorders.invoiceid = aqinvoices.invoiceid
2472           LEFT JOIN aqbasket ON aqbasket.basketno=aqorders.basketno
2473           LEFT JOIN borrowers ON aqbasket.authorisedby=borrowers.borrowernumber
2474           LEFT JOIN biblio ON aqorders.biblionumber = biblio.biblionumber
2475           LEFT JOIN biblioitems ON biblio.biblionumber = biblioitems.biblionumber
2476           LEFT JOIN subscription ON biblio.biblionumber = subscription.biblionumber
2477     };
2478
2479     my @bind_args;
2480     my @bind_strs;
2481     if($args{supplierid}) {
2482         push @bind_strs, " aqinvoices.booksellerid = ? ";
2483         push @bind_args, $args{supplierid};
2484     }
2485     if($args{invoicenumber}) {
2486         push @bind_strs, " aqinvoices.invoicenumber LIKE ? ";
2487         push @bind_args, "%$args{invoicenumber}%";
2488     }
2489     if($args{suppliername}) {
2490         push @bind_strs, " aqbooksellers.name LIKE ? ";
2491         push @bind_args, "%$args{suppliername}%";
2492     }
2493     if($args{shipmentdatefrom}) {
2494         push @bind_strs, " aqinvoices.shipmentdate >= ? ";
2495         push @bind_args, $args{shipmentdatefrom};
2496     }
2497     if($args{shipmentdateto}) {
2498         push @bind_strs, " aqinvoices.shipmentdate <= ? ";
2499         push @bind_args, $args{shipmentdateto};
2500     }
2501     if($args{billingdatefrom}) {
2502         push @bind_strs, " aqinvoices.billingdate >= ? ";
2503         push @bind_args, $args{billingdatefrom};
2504     }
2505     if($args{billingdateto}) {
2506         push @bind_strs, " aqinvoices.billingdate <= ? ";
2507         push @bind_args, $args{billingdateto};
2508     }
2509     if($args{isbneanissn}) {
2510         push @bind_strs, " (biblioitems.isbn LIKE CONCAT('%', ?, '%') OR biblioitems.ean LIKE CONCAT('%', ?, '%') OR biblioitems.issn LIKE CONCAT('%', ?, '%') ) ";
2511         push @bind_args, $args{isbneanissn}, $args{isbneanissn}, $args{isbneanissn};
2512     }
2513     if($args{title}) {
2514         push @bind_strs, " biblio.title LIKE CONCAT('%', ?, '%') ";
2515         push @bind_args, $args{title};
2516     }
2517     if($args{author}) {
2518         push @bind_strs, " biblio.author LIKE CONCAT('%', ?, '%') ";
2519         push @bind_args, $args{author};
2520     }
2521     if($args{publisher}) {
2522         push @bind_strs, " biblioitems.publishercode LIKE CONCAT('%', ?, '%') ";
2523         push @bind_args, $args{publisher};
2524     }
2525     if($args{publicationyear}) {
2526         push @bind_strs, " ((biblioitems.publicationyear LIKE CONCAT('%', ?, '%')) OR (biblio.copyrightdate LIKE CONCAT('%', ?, '%'))) ";
2527         push @bind_args, $args{publicationyear}, $args{publicationyear};
2528     }
2529     if($args{branchcode}) {
2530         push @bind_strs, " borrowers.branchcode = ? ";
2531         push @bind_args, $args{branchcode};
2532     }
2533     if($args{message_id}) {
2534         push @bind_strs, " aqinvoices.message_id = ? ";
2535         push @bind_args, $args{message_id};
2536     }
2537
2538     $query .= " WHERE " . join(" AND ", @bind_strs) if @bind_strs;
2539     $query .= " GROUP BY aqinvoices.invoiceid ";
2540
2541     if($args{order_by}) {
2542         my ($column, $direction) = split / /, $args{order_by};
2543         if(grep /^$column$/, @columns) {
2544             $direction ||= 'ASC';
2545             $query .= " ORDER BY $column $direction";
2546         }
2547     }
2548
2549     my $sth = $dbh->prepare($query);
2550     $sth->execute(@bind_args);
2551
2552     my $results = $sth->fetchall_arrayref({});
2553     return @$results;
2554 }
2555
2556 =head3 GetInvoice
2557
2558     my $invoice = GetInvoice($invoiceid);
2559
2560 Get informations about invoice with given $invoiceid
2561
2562 Return a hash filled with aqinvoices.* fields
2563
2564 =cut
2565
2566 sub GetInvoice {
2567     my ($invoiceid) = @_;
2568     my $invoice;
2569
2570     return unless $invoiceid;
2571
2572     my $dbh = C4::Context->dbh;
2573     my $query = qq{
2574         SELECT *
2575         FROM aqinvoices
2576         WHERE invoiceid = ?
2577     };
2578     my $sth = $dbh->prepare($query);
2579     $sth->execute($invoiceid);
2580
2581     $invoice = $sth->fetchrow_hashref;
2582     return $invoice;
2583 }
2584
2585 =head3 GetInvoiceDetails
2586
2587     my $invoice = GetInvoiceDetails($invoiceid)
2588
2589 Return informations about an invoice + the list of related order lines
2590
2591 Orders informations are in $invoice->{orders} (array ref)
2592
2593 =cut
2594
2595 sub GetInvoiceDetails {
2596     my ($invoiceid) = @_;
2597
2598     if ( !defined $invoiceid ) {
2599         carp 'GetInvoiceDetails called without an invoiceid';
2600         return;
2601     }
2602
2603     my $dbh = C4::Context->dbh;
2604     my $query = q{
2605         SELECT aqinvoices.*, aqbooksellers.name AS suppliername
2606         FROM aqinvoices
2607           LEFT JOIN aqbooksellers ON aqinvoices.booksellerid = aqbooksellers.id
2608         WHERE invoiceid = ?
2609     };
2610     my $sth = $dbh->prepare($query);
2611     $sth->execute($invoiceid);
2612
2613     my $invoice = $sth->fetchrow_hashref;
2614
2615     $query = q{
2616         SELECT aqorders.*,
2617                 biblio.*,
2618                 biblio.copyrightdate,
2619                 biblioitems.publishercode,
2620                 biblioitems.publicationyear,
2621                 aqbasket.basketname,
2622                 aqbasketgroups.id AS basketgroupid,
2623                 aqbasketgroups.name AS basketgroupname
2624         FROM aqorders
2625           LEFT JOIN aqbasket ON aqorders.basketno = aqbasket.basketno
2626           LEFT JOIN aqbasketgroups ON aqbasket.basketgroupid = aqbasketgroups.id
2627           LEFT JOIN biblio ON aqorders.biblionumber = biblio.biblionumber
2628           LEFT JOIN biblioitems ON aqorders.biblionumber = biblioitems.biblionumber
2629         WHERE invoiceid = ?
2630     };
2631     $sth = $dbh->prepare($query);
2632     $sth->execute($invoiceid);
2633     $invoice->{orders} = $sth->fetchall_arrayref({});
2634     $invoice->{orders} ||= []; # force an empty arrayref if fetchall_arrayref fails
2635
2636     return $invoice;
2637 }
2638
2639 =head3 AddInvoice
2640
2641     my $invoiceid = AddInvoice(
2642         invoicenumber => $invoicenumber,
2643         booksellerid => $booksellerid,
2644         shipmentdate => $shipmentdate,
2645         billingdate => $billingdate,
2646         closedate => $closedate,
2647         shipmentcost => $shipmentcost,
2648         shipmentcost_budgetid => $shipmentcost_budgetid
2649     );
2650
2651 Create a new invoice and return its id or undef if it fails.
2652
2653 =cut
2654
2655 sub AddInvoice {
2656     my %invoice = @_;
2657
2658     return unless(%invoice and $invoice{invoicenumber});
2659
2660     my @columns = qw(invoicenumber booksellerid shipmentdate billingdate
2661         closedate shipmentcost shipmentcost_budgetid message_id);
2662
2663     my @set_strs;
2664     my @set_args;
2665     foreach my $key (keys %invoice) {
2666         if(0 < grep(/^$key$/, @columns)) {
2667             push @set_strs, "$key = ?";
2668             push @set_args, ($invoice{$key} || undef);
2669         }
2670     }
2671
2672     my $rv;
2673     if(@set_args > 0) {
2674         my $dbh = C4::Context->dbh;
2675         my $query = "INSERT INTO aqinvoices SET ";
2676         $query .= join (",", @set_strs);
2677         my $sth = $dbh->prepare($query);
2678         $rv = $sth->execute(@set_args);
2679         if($rv) {
2680             $rv = $dbh->last_insert_id(undef, undef, 'aqinvoices', undef);
2681         }
2682     }
2683     return $rv;
2684 }
2685
2686 =head3 ModInvoice
2687
2688     ModInvoice(
2689         invoiceid => $invoiceid,    # Mandatory
2690         invoicenumber => $invoicenumber,
2691         booksellerid => $booksellerid,
2692         shipmentdate => $shipmentdate,
2693         billingdate => $billingdate,
2694         closedate => $closedate,
2695         shipmentcost => $shipmentcost,
2696         shipmentcost_budgetid => $shipmentcost_budgetid
2697     );
2698
2699 Modify an invoice, invoiceid is mandatory.
2700
2701 Return undef if it fails.
2702
2703 =cut
2704
2705 sub ModInvoice {
2706     my %invoice = @_;
2707
2708     return unless(%invoice and $invoice{invoiceid});
2709
2710     my @columns = qw(invoicenumber booksellerid shipmentdate billingdate
2711         closedate shipmentcost shipmentcost_budgetid);
2712
2713     my @set_strs;
2714     my @set_args;
2715     foreach my $key (keys %invoice) {
2716         if(0 < grep(/^$key$/, @columns)) {
2717             push @set_strs, "$key = ?";
2718             push @set_args, ($invoice{$key} || undef);
2719         }
2720     }
2721
2722     my $dbh = C4::Context->dbh;
2723     my $query = "UPDATE aqinvoices SET ";
2724     $query .= join(",", @set_strs);
2725     $query .= " WHERE invoiceid = ?";
2726
2727     my $sth = $dbh->prepare($query);
2728     $sth->execute(@set_args, $invoice{invoiceid});
2729 }
2730
2731 =head3 CloseInvoice
2732
2733     CloseInvoice($invoiceid);
2734
2735 Close an invoice.
2736
2737 Equivalent to ModInvoice(invoiceid => $invoiceid, closedate => undef);
2738
2739 =cut
2740
2741 sub CloseInvoice {
2742     my ($invoiceid) = @_;
2743
2744     return unless $invoiceid;
2745
2746     my $dbh = C4::Context->dbh;
2747     my $query = qq{
2748         UPDATE aqinvoices
2749         SET closedate = CAST(NOW() AS DATE)
2750         WHERE invoiceid = ?
2751     };
2752     my $sth = $dbh->prepare($query);
2753     $sth->execute($invoiceid);
2754 }
2755
2756 =head3 ReopenInvoice
2757
2758     ReopenInvoice($invoiceid);
2759
2760 Reopen an invoice
2761
2762 Equivalent to ModInvoice(invoiceid => $invoiceid, closedate => output_pref({ dt=>dt_from_string, dateonly=>1, otputpref=>'iso' }))
2763
2764 =cut
2765
2766 sub ReopenInvoice {
2767     my ($invoiceid) = @_;
2768
2769     return unless $invoiceid;
2770
2771     my $dbh = C4::Context->dbh;
2772     my $query = qq{
2773         UPDATE aqinvoices
2774         SET closedate = NULL
2775         WHERE invoiceid = ?
2776     };
2777     my $sth = $dbh->prepare($query);
2778     $sth->execute($invoiceid);
2779 }
2780
2781 =head3 DelInvoice
2782
2783     DelInvoice($invoiceid);
2784
2785 Delete an invoice if there are no items attached to it.
2786
2787 =cut
2788
2789 sub DelInvoice {
2790     my ($invoiceid) = @_;
2791
2792     return unless $invoiceid;
2793
2794     my $dbh   = C4::Context->dbh;
2795     my $query = qq{
2796         SELECT COUNT(*)
2797         FROM aqorders
2798         WHERE invoiceid = ?
2799     };
2800     my $sth = $dbh->prepare($query);
2801     $sth->execute($invoiceid);
2802     my $res = $sth->fetchrow_arrayref;
2803     if ( $res && $res->[0] == 0 ) {
2804         $query = qq{
2805             DELETE FROM aqinvoices
2806             WHERE invoiceid = ?
2807         };
2808         my $sth = $dbh->prepare($query);
2809         return ( $sth->execute($invoiceid) > 0 );
2810     }
2811     return;
2812 }
2813
2814 =head3 MergeInvoices
2815
2816     MergeInvoices($invoiceid, \@sourceids);
2817
2818 Merge the invoices identified by the IDs in \@sourceids into
2819 the invoice identified by $invoiceid.
2820
2821 =cut
2822
2823 sub MergeInvoices {
2824     my ($invoiceid, $sourceids) = @_;
2825
2826     return unless $invoiceid;
2827     foreach my $sourceid (@$sourceids) {
2828         next if $sourceid == $invoiceid;
2829         my $source = GetInvoiceDetails($sourceid);
2830         foreach my $order (@{$source->{'orders'}}) {
2831             $order->{'invoiceid'} = $invoiceid;
2832             ModOrder($order);
2833         }
2834         DelInvoice($source->{'invoiceid'});
2835     }
2836     return;
2837 }
2838
2839 =head3 GetBiblioCountByBasketno
2840
2841 $biblio_count = &GetBiblioCountByBasketno($basketno);
2842
2843 Looks up the biblio's count that has basketno value $basketno
2844
2845 Returns a quantity
2846
2847 =cut
2848
2849 sub GetBiblioCountByBasketno {
2850     my ($basketno) = @_;
2851     my $dbh          = C4::Context->dbh;
2852     my $query        = "
2853         SELECT COUNT( DISTINCT( biblionumber ) )
2854         FROM   aqorders
2855         WHERE  basketno = ?
2856             AND (datecancellationprinted IS NULL OR datecancellationprinted='0000-00-00')
2857         ";
2858
2859     my $sth = $dbh->prepare($query);
2860     $sth->execute($basketno);
2861     return $sth->fetchrow;
2862 }
2863
2864 # Note this subroutine should be moved to Koha::Acquisition::Order
2865 # Will do when a DBIC decision will be taken.
2866 sub populate_order_with_prices {
2867     my ($params) = @_;
2868
2869     my $order        = $params->{order};
2870     my $booksellerid = $params->{booksellerid};
2871     return unless $booksellerid;
2872
2873     my $bookseller = Koha::Acquisition::Booksellers->find( $booksellerid );
2874
2875     my $receiving = $params->{receiving};
2876     my $ordering  = $params->{ordering};
2877     my $discount  = $order->{discount};
2878     $discount /= 100 if $discount > 1;
2879
2880     if ($ordering) {
2881         $order->{tax_rate_on_ordering} //= $order->{tax_rate};
2882         if ( $bookseller->listincgst ) {
2883             # The user entered the rrp tax included
2884             $order->{rrp_tax_included} = $order->{rrp};
2885
2886             # rrp tax excluded = rrp tax included / ( 1 + tax rate )
2887             $order->{rrp_tax_excluded} = $order->{rrp_tax_included} / ( 1 + $order->{tax_rate_on_ordering} );
2888
2889             # ecost tax excluded = rrp tax excluded * ( 1 - discount )
2890             $order->{ecost_tax_excluded} = $order->{rrp_tax_excluded} * ( 1 - $discount );
2891
2892             # ecost tax included = rrp tax included  ( 1 - discount )
2893             $order->{ecost_tax_included} = $order->{rrp_tax_included} * ( 1 - $discount );
2894         }
2895         else {
2896             # The user entered the rrp tax excluded
2897             $order->{rrp_tax_excluded} = $order->{rrp};
2898
2899             # rrp tax included = rrp tax excluded * ( 1 - tax rate )
2900             $order->{rrp_tax_included} = $order->{rrp_tax_excluded} * ( 1 + $order->{tax_rate_on_ordering} );
2901
2902             # ecost tax excluded = rrp tax excluded * ( 1 - discount )
2903             $order->{ecost_tax_excluded} = $order->{rrp_tax_excluded} * ( 1 - $discount );
2904
2905             # ecost tax included = rrp tax excluded * ( 1 - tax rate ) * ( 1 - discount )
2906             $order->{ecost_tax_included} =
2907                 $order->{rrp_tax_excluded} *
2908                 ( 1 + $order->{tax_rate_on_ordering} ) *
2909                 ( 1 - $discount );
2910         }
2911
2912         # tax value = quantity * ecost tax excluded * tax rate
2913         $order->{tax_value_on_ordering} =
2914             $order->{quantity} * $order->{ecost_tax_excluded} * $order->{tax_rate_on_ordering};
2915     }
2916
2917     if ($receiving) {
2918         $order->{tax_rate_on_receiving} //= $order->{tax_rate};
2919         if ( $bookseller->invoiceincgst ) {
2920             # Trick for unitprice. If the unit price rounded value is the same as the ecost rounded value
2921             # we need to keep the exact ecost value
2922             if ( Koha::Number::Price->new( $order->{unitprice} )->round == Koha::Number::Price->new( $order->{ecost_tax_included} )->round ) {
2923                 $order->{unitprice} = $order->{ecost_tax_included};
2924             }
2925
2926             # The user entered the unit price tax included
2927             $order->{unitprice_tax_included} = $order->{unitprice};
2928
2929             # unit price tax excluded = unit price tax included / ( 1 + tax rate )
2930             $order->{unitprice_tax_excluded} = $order->{unitprice_tax_included} / ( 1 + $order->{tax_rate_on_receiving} );
2931         }
2932         else {
2933             # Trick for unitprice. If the unit price rounded value is the same as the ecost rounded value
2934             # we need to keep the exact ecost value
2935             if ( Koha::Number::Price->new( $order->{unitprice} )->round == Koha::Number::Price->new( $order->{ecost_tax_excluded} )->round ) {
2936                 $order->{unitprice} = $order->{ecost_tax_excluded};
2937             }
2938
2939             # The user entered the unit price tax excluded
2940             $order->{unitprice_tax_excluded} = $order->{unitprice};
2941
2942
2943             # unit price tax included = unit price tax included * ( 1 + tax rate )
2944             $order->{unitprice_tax_included} = $order->{unitprice_tax_excluded} * ( 1 + $order->{tax_rate_on_receiving} );
2945         }
2946
2947         # tax value = quantity * unit price tax excluded * tax rate
2948         $order->{tax_value_on_receiving} = $order->{quantity} * $order->{unitprice_tax_excluded} * $order->{tax_rate_on_receiving};
2949     }
2950
2951     return $order;
2952 }
2953
2954 =head3 GetOrderUsers
2955
2956     $order_users_ids = &GetOrderUsers($ordernumber);
2957
2958 Returns a list of all borrowernumbers that are in order users list
2959
2960 =cut
2961
2962 sub GetOrderUsers {
2963     my ($ordernumber) = @_;
2964
2965     return unless $ordernumber;
2966
2967     my $query = q|
2968         SELECT borrowernumber
2969         FROM aqorder_users
2970         WHERE ordernumber = ?
2971     |;
2972     my $dbh = C4::Context->dbh;
2973     my $sth = $dbh->prepare($query);
2974     $sth->execute($ordernumber);
2975     my $results = $sth->fetchall_arrayref( {} );
2976
2977     my @borrowernumbers;
2978     foreach (@$results) {
2979         push @borrowernumbers, $_->{'borrowernumber'};
2980     }
2981
2982     return @borrowernumbers;
2983 }
2984
2985 =head3 ModOrderUsers
2986
2987     my @order_users_ids = (1, 2, 3);
2988     &ModOrderUsers($ordernumber, @basketusers_ids);
2989
2990 Delete all users from order users list, and add users in C<@order_users_ids>
2991 to this users list.
2992
2993 =cut
2994
2995 sub ModOrderUsers {
2996     my ( $ordernumber, @order_users_ids ) = @_;
2997
2998     return unless $ordernumber;
2999
3000     my $dbh   = C4::Context->dbh;
3001     my $query = q|
3002         DELETE FROM aqorder_users
3003         WHERE ordernumber = ?
3004     |;
3005     my $sth = $dbh->prepare($query);
3006     $sth->execute($ordernumber);
3007
3008     $query = q|
3009         INSERT INTO aqorder_users (ordernumber, borrowernumber)
3010         VALUES (?, ?)
3011     |;
3012     $sth = $dbh->prepare($query);
3013     foreach my $order_user_id (@order_users_ids) {
3014         $sth->execute( $ordernumber, $order_user_id );
3015     }
3016 }
3017
3018 sub NotifyOrderUsers {
3019     my ($ordernumber) = @_;
3020
3021     my @borrowernumbers = GetOrderUsers($ordernumber);
3022     return unless @borrowernumbers;
3023
3024     my $order = GetOrder( $ordernumber );
3025     for my $borrowernumber (@borrowernumbers) {
3026         my $borrower = C4::Members::GetMember( borrowernumber => $borrowernumber );
3027         my $library = Koha::Libraries->find( $borrower->{branchcode} )->unblessed;
3028         my $biblio = C4::Biblio::GetBiblio( $order->{biblionumber} );
3029         my $letter = C4::Letters::GetPreparedLetter(
3030             module      => 'acquisition',
3031             letter_code => 'ACQ_NOTIF_ON_RECEIV',
3032             branchcode  => $library->{branchcode},
3033             tables      => {
3034                 'branches'    => $library,
3035                 'borrowers'   => $borrower,
3036                 'biblio'      => $biblio,
3037                 'aqorders'    => $order,
3038             },
3039         );
3040         if ( $letter ) {
3041             C4::Letters::EnqueueLetter(
3042                 {
3043                     letter         => $letter,
3044                     borrowernumber => $borrowernumber,
3045                     LibraryName    => C4::Context->preference("LibraryName"),
3046                     message_transport_type => 'email',
3047                 }
3048             ) or warn "can't enqueue letter $letter";
3049         }
3050     }
3051 }
3052
3053 =head3 FillWithDefaultValues
3054
3055 FillWithDefaultValues( $marc_record );
3056
3057 This will update the record with default value defined in the ACQ framework.
3058 For all existing fields, if a default value exists and there are no subfield, it will be created.
3059 If the field does not exist, it will be created too.
3060
3061 =cut
3062
3063 sub FillWithDefaultValues {
3064     my ($record) = @_;
3065     my $tagslib = C4::Biblio::GetMarcStructure( 1, 'ACQ', { unsafe => 1 } );
3066     if ($tagslib) {
3067         my ($itemfield) =
3068           C4::Biblio::GetMarcFromKohaField( 'items.itemnumber', '' );
3069         for my $tag ( sort keys %$tagslib ) {
3070             next unless $tag;
3071             next if $tag == $itemfield;
3072             for my $subfield ( sort keys %{ $tagslib->{$tag} } ) {
3073                 next if IsMarcStructureInternal($tagslib->{$tag}{$subfield});
3074                 my $defaultvalue = $tagslib->{$tag}{$subfield}{defaultvalue};
3075                 if ( defined $defaultvalue and $defaultvalue ne '' ) {
3076                     my @fields = $record->field($tag);
3077                     if (@fields) {
3078                         for my $field (@fields) {
3079                             unless ( defined $field->subfield($subfield) ) {
3080                                 $field->add_subfields(
3081                                     $subfield => $defaultvalue );
3082                             }
3083                         }
3084                     }
3085                     else {
3086                         $record->insert_fields_ordered(
3087                             MARC::Field->new(
3088                                 $tag, '', '', $subfield => $defaultvalue
3089                             )
3090                         );
3091                     }
3092                 }
3093             }
3094         }
3095     }
3096 }
3097
3098 1;
3099 __END__
3100
3101 =head1 AUTHOR
3102
3103 Koha Development Team <http://koha-community.org/>
3104
3105 =cut