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