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