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