C4/Acquisition.pm

   1 package C4::Acquisition;
   2
   3 # Copyright 2000-2002 Katipo Communications
   4 #
   5 # This file is part of Koha.
   6 #
   7 # Koha is free software; you can redistribute it and/or modify it
   8 # under the terms of the GNU General Public License as published by
   9 # the Free Software Foundation; either version 3 of the License, or
  10 # (at your option) any later version.
  11 #
  12 # Koha is distributed in the hope that it will be useful, but
  13 # WITHOUT ANY WARRANTY; without even the implied warranty of
  14 # MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
  15 # GNU General Public License for more details.
  16 #
  17 # You should have received a copy of the GNU General Public License
  18 # along with Koha; if not, see <http://www.gnu.org/licenses>.
  19
  20
  21 use Modern::Perl;
  22 use Carp;
  23 use C4::Context;
  24 use C4::Debug;
  25 use C4::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         &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( $basketno, { orderby => 'biblio.title', cancelled => 0|1 } );
1040
1041 Looks up the pending (non-cancelled) orders with the given basket
1042 number.
1043
1044 If cancelled is set, only cancelled orders will be returned.
1045
1046 =cut
1047
1048 sub GetOrders {
1049     my ( $basketno, $params ) = @_;
1050
1051     return () unless $basketno;
1052
1053     my $orderby = $params->{orderby};
1054     my $cancelled = $params->{cancelled} || 0;
1055
1056     my $dbh   = C4::Context->dbh;
1057     my $query = q|
1058         SELECT biblio.*,biblioitems.*,
1059                 aqorders.*,
1060                 aqbudgets.*,
1061         |;
1062     $query .= $cancelled
1063       ? q|
1064                 aqorders_transfers.ordernumber_to AS transferred_to,
1065                 aqorders_transfers.timestamp AS transferred_to_timestamp
1066     |
1067       : q|
1068                 aqorders_transfers.ordernumber_from AS transferred_from,
1069                 aqorders_transfers.timestamp AS transferred_from_timestamp
1070     |;
1071     $query .= q|
1072         FROM    aqorders
1073             LEFT JOIN aqbudgets        ON aqbudgets.budget_id = aqorders.budget_id
1074             LEFT JOIN biblio           ON biblio.biblionumber = aqorders.biblionumber
1075             LEFT JOIN biblioitems      ON biblioitems.biblionumber =biblio.biblionumber
1076     |;
1077     $query .= $cancelled
1078       ? q|
1079             LEFT JOIN aqorders_transfers ON aqorders_transfers.ordernumber_from = aqorders.ordernumber
1080     |
1081       : q|
1082             LEFT JOIN aqorders_transfers ON aqorders_transfers.ordernumber_to = aqorders.ordernumber
1083
1084     |;
1085     $query .= q|
1086         WHERE   basketno=?
1087     |;
1088
1089     if ($cancelled) {
1090         $orderby ||= q|biblioitems.publishercode, biblio.title|;
1091         $query .= q|
1092             AND (datecancellationprinted IS NOT NULL
1093                AND datecancellationprinted <> '0000-00-00')
1094         |;
1095     }
1096     else {
1097         $orderby ||=
1098           q|aqorders.datecancellationprinted desc, aqorders.timestamp desc|;
1099         $query .= q|
1100             AND (datecancellationprinted IS NULL OR datecancellationprinted='0000-00-00')
1101         |;
1102     }
1103
1104     $query .= " ORDER BY $orderby";
1105     my $orders =
1106       $dbh->selectall_arrayref( $query, { Slice => {} }, $basketno );
1107     return @{$orders};
1108
1109 }
1110
1111 #------------------------------------------------------------#
1112
1113 =head3 GetOrdersByBiblionumber
1114
1115   @orders = &GetOrdersByBiblionumber($biblionumber);
1116
1117 Looks up the orders with linked to a specific $biblionumber, including
1118 cancelled orders and received orders.
1119
1120 return :
1121 C<@orders> is an array of references-to-hash, whose keys are the
1122 fields from the aqorders, biblio, and biblioitems tables in the Koha database.
1123
1124 =cut
1125
1126 sub GetOrdersByBiblionumber {
1127     my $biblionumber = shift;
1128     return unless $biblionumber;
1129     my $dbh   = C4::Context->dbh;
1130     my $query  ="
1131         SELECT biblio.*,biblioitems.*,
1132                 aqorders.*,
1133                 aqbudgets.*
1134         FROM    aqorders
1135             LEFT JOIN aqbudgets        ON aqbudgets.budget_id = aqorders.budget_id
1136             LEFT JOIN biblio           ON biblio.biblionumber = aqorders.biblionumber
1137             LEFT JOIN biblioitems      ON biblioitems.biblionumber =biblio.biblionumber
1138         WHERE   aqorders.biblionumber=?
1139     ";
1140     my $result_set =
1141       $dbh->selectall_arrayref( $query, { Slice => {} }, $biblionumber );
1142     return @{$result_set};
1143
1144 }
1145
1146 #------------------------------------------------------------#
1147
1148 =head3 GetOrder
1149
1150   $order = &GetOrder($ordernumber);
1151
1152 Looks up an order by order number.
1153
1154 Returns a reference-to-hash describing the order. The keys of
1155 C<$order> are fields from the biblio, biblioitems, aqorders tables of the Koha database.
1156
1157 =cut
1158
1159 sub GetOrder {
1160     my ($ordernumber) = @_;
1161     return unless $ordernumber;
1162
1163     my $dbh      = C4::Context->dbh;
1164     my $query = qq{SELECT
1165                 aqorders.*,
1166                 biblio.title,
1167                 biblio.author,
1168                 aqbasket.basketname,
1169                 borrowers.branchcode,
1170                 biblioitems.publicationyear,
1171                 biblio.copyrightdate,
1172                 biblioitems.editionstatement,
1173                 biblioitems.isbn,
1174                 biblioitems.ean,
1175                 biblio.seriestitle,
1176                 biblioitems.publishercode,
1177                 aqorders.rrp              AS unitpricesupplier,
1178                 aqorders.ecost            AS unitpricelib,
1179                 aqorders.claims_count     AS claims_count,
1180                 aqorders.claimed_date     AS claimed_date,
1181                 aqbudgets.budget_name     AS budget,
1182                 aqbooksellers.name        AS supplier,
1183                 aqbooksellers.id          AS supplierid,
1184                 biblioitems.publishercode AS publisher,
1185                 ADDDATE(aqbasket.closedate, INTERVAL aqbooksellers.deliverytime DAY) AS estimateddeliverydate,
1186                 DATE(aqbasket.closedate)  AS orderdate,
1187                 aqorders.quantity - COALESCE(aqorders.quantityreceived,0)                 AS quantity_to_receive,
1188                 (aqorders.quantity - COALESCE(aqorders.quantityreceived,0)) * aqorders.rrp AS subtotal,
1189                 DATEDIFF(CURDATE( ),closedate) AS latesince
1190                 FROM aqorders LEFT JOIN biblio ON biblio.biblionumber = aqorders.biblionumber
1191                 LEFT JOIN biblioitems ON biblioitems.biblionumber = biblio.biblionumber
1192                 LEFT JOIN aqbudgets ON aqorders.budget_id = aqbudgets.budget_id,
1193                 aqbasket LEFT JOIN borrowers  ON aqbasket.authorisedby = borrowers.borrowernumber
1194                 LEFT JOIN aqbooksellers       ON aqbasket.booksellerid = aqbooksellers.id
1195                 WHERE aqorders.basketno = aqbasket.basketno
1196                     AND ordernumber=?};
1197     my $result_set =
1198       $dbh->selectall_arrayref( $query, { Slice => {} }, $ordernumber );
1199
1200     # result_set assumed to contain 1 match
1201     return $result_set->[0];
1202 }
1203
1204 =head3 GetLastOrderNotReceivedFromSubscriptionid
1205
1206   $order = &GetLastOrderNotReceivedFromSubscriptionid($subscriptionid);
1207
1208 Returns a reference-to-hash describing the last order not received for a subscription.
1209
1210 =cut
1211
1212 sub GetLastOrderNotReceivedFromSubscriptionid {
1213     my ( $subscriptionid ) = @_;
1214     my $dbh                = C4::Context->dbh;
1215     my $query              = qq|
1216         SELECT * FROM aqorders
1217         LEFT JOIN subscription
1218             ON ( aqorders.subscriptionid = subscription.subscriptionid )
1219         WHERE aqorders.subscriptionid = ?
1220             AND aqorders.datereceived IS NULL
1221         LIMIT 1
1222     |;
1223     my $result_set =
1224       $dbh->selectall_arrayref( $query, { Slice => {} }, $subscriptionid );
1225
1226     # result_set assumed to contain 1 match
1227     return $result_set->[0];
1228 }
1229
1230 =head3 GetLastOrderReceivedFromSubscriptionid
1231
1232   $order = &GetLastOrderReceivedFromSubscriptionid($subscriptionid);
1233
1234 Returns a reference-to-hash describing the last order received for a subscription.
1235
1236 =cut
1237
1238 sub GetLastOrderReceivedFromSubscriptionid {
1239     my ( $subscriptionid ) = @_;
1240     my $dbh                = C4::Context->dbh;
1241     my $query              = qq|
1242         SELECT * FROM aqorders
1243         LEFT JOIN subscription
1244             ON ( aqorders.subscriptionid = subscription.subscriptionid )
1245         WHERE aqorders.subscriptionid = ?
1246             AND aqorders.datereceived =
1247                 (
1248                     SELECT MAX( aqorders.datereceived )
1249                     FROM aqorders
1250                     LEFT JOIN subscription
1251                         ON ( aqorders.subscriptionid = subscription.subscriptionid )
1252                         WHERE aqorders.subscriptionid = ?
1253                             AND aqorders.datereceived IS NOT NULL
1254                 )
1255         ORDER BY ordernumber DESC
1256         LIMIT 1
1257     |;
1258     my $result_set =
1259       $dbh->selectall_arrayref( $query, { Slice => {} }, $subscriptionid, $subscriptionid );
1260
1261     # result_set assumed to contain 1 match
1262     return $result_set->[0];
1263
1264 }
1265
1266 #------------------------------------------------------------#
1267
1268 =head3 ModOrder
1269
1270   &ModOrder(\%hashref);
1271
1272 Modifies an existing order. Updates the order with order number
1273 $hashref->{'ordernumber'} and biblionumber $hashref->{'biblionumber'}. All
1274 other keys of the hash update the fields with the same name in the aqorders
1275 table of the Koha database.
1276
1277 =cut
1278
1279 sub ModOrder {
1280     my $orderinfo = shift;
1281
1282     die "Ordernumber is required"     if $orderinfo->{'ordernumber'} eq  '' ;
1283     die "Biblionumber is required"  if  $orderinfo->{'biblionumber'} eq '';
1284
1285     my $dbh = C4::Context->dbh;
1286     my @params;
1287
1288     # update uncertainprice to an integer, just in case (under FF, checked boxes have the value "ON" by default)
1289     $orderinfo->{uncertainprice}=1 if $orderinfo->{uncertainprice};
1290
1291 #    delete($orderinfo->{'branchcode'});
1292     # the hash contains a lot of entries not in aqorders, so get the columns ...
1293     my $sth = $dbh->prepare("SELECT * FROM aqorders LIMIT 1;");
1294     $sth->execute;
1295     my $colnames = $sth->{NAME};
1296         #FIXME Be careful. If aqorders would have columns with diacritics,
1297         #you should need to decode what you get back from NAME.
1298         #See report 10110 and guided_reports.pl
1299     my $query = "UPDATE aqorders SET ";
1300
1301     foreach my $orderinfokey (grep(!/ordernumber/, keys %$orderinfo)){
1302         # ... and skip hash entries that are not in the aqorders table
1303         # FIXME : probably not the best way to do it (would be better to have a correct hash)
1304         next unless grep(/^$orderinfokey$/, @$colnames);
1305             $query .= "$orderinfokey=?, ";
1306             push(@params, $orderinfo->{$orderinfokey});
1307     }
1308
1309     $query .= "timestamp=NOW()  WHERE  ordernumber=?";
1310     push(@params, $orderinfo->{'ordernumber'} );
1311     $sth = $dbh->prepare($query);
1312     $sth->execute(@params);
1313     return;
1314 }
1315
1316 #------------------------------------------------------------#
1317
1318 =head3 ModItemOrder
1319
1320     ModItemOrder($itemnumber, $ordernumber);
1321
1322 Modifies the ordernumber of an item in aqorders_items.
1323
1324 =cut
1325
1326 sub ModItemOrder {
1327     my ($itemnumber, $ordernumber) = @_;
1328
1329     return unless ($itemnumber and $ordernumber);
1330
1331     my $dbh = C4::Context->dbh;
1332     my $query = qq{
1333         UPDATE aqorders_items
1334         SET ordernumber = ?
1335         WHERE itemnumber = ?
1336     };
1337     my $sth = $dbh->prepare($query);
1338     return $sth->execute($ordernumber, $itemnumber);
1339 }
1340
1341 #------------------------------------------------------------#
1342
1343 =head3 ModReceiveOrder
1344
1345   &ModReceiveOrder({
1346     biblionumber => $biblionumber,
1347     ordernumber => $ordernumber,
1348     quantityreceived => $quantityreceived,
1349     user => $user,
1350     cost => $cost,
1351     ecost => $ecost,
1352     invoiceid => $invoiceid,
1353     rrp => $rrp,
1354     budget_id => $budget_id,
1355     datereceived => $datereceived,
1356     received_itemnumbers => \@received_itemnumbers,
1357     order_internalnote => $order_internalnote,
1358     order_vendornote => $order_vendornote,
1359    });
1360
1361 Updates an order, to reflect the fact that it was received, at least
1362 in part. All arguments not mentioned below update the fields with the
1363 same name in the aqorders table of the Koha database.
1364
1365 If a partial order is received, splits the order into two.
1366
1367 Updates the order with bibilionumber C<$biblionumber> and ordernumber
1368 C<$ordernumber>.
1369
1370 =cut
1371
1372
1373 sub ModReceiveOrder {
1374     my ( $params ) = @_;
1375     my $biblionumber = $params->{biblionumber};
1376     my $ordernumber = $params->{ordernumber};
1377     my $quantrec = $params->{quantityreceived};
1378     my $user = $params->{user};
1379     my $cost = $params->{cost};
1380     my $ecost = $params->{ecost};
1381     my $invoiceid = $params->{invoiceid};
1382     my $rrp = $params->{rrp};
1383     my $budget_id = $params->{budget_id};
1384     my $datereceived = $params->{datereceived};
1385     my $received_items = $params->{received_items};
1386     my $order_internalnote = $params->{order_internalnote};
1387     my $order_vendornote = $params->{order_vendornote};
1388
1389     my $dbh = C4::Context->dbh;
1390     $datereceived = C4::Dates->output('iso') unless $datereceived;
1391     my $suggestionid = GetSuggestionFromBiblionumber( $biblionumber );
1392     if ($suggestionid) {
1393         ModSuggestion( {suggestionid=>$suggestionid,
1394                         STATUS=>'AVAILABLE',
1395                         biblionumber=> $biblionumber}
1396                         );
1397     }
1398
1399     my $result_set = $dbh->selectall_arrayref(
1400 q{SELECT * FROM aqorders WHERE biblionumber=? AND aqorders.ordernumber=?},
1401         { Slice => {} }, $biblionumber, $ordernumber
1402     );
1403
1404     # we assume we have a unique order
1405     my $order = $result_set->[0];
1406
1407     my $new_ordernumber = $ordernumber;
1408     if ( $order->{quantity} > $quantrec ) {
1409         # Split order line in two parts: the first is the original order line
1410         # without received items (the quantity is decreased),
1411         # the second part is a new order line with quantity=quantityrec
1412         # (entirely received)
1413         my $query = q|
1414             UPDATE aqorders
1415             SET quantity = ?,
1416                 orderstatus = 'partial'|;
1417         $query .= q|, order_internalnote = ?| if defined $order_internalnote;
1418         $query .= q|, order_vendornote = ?| if defined $order_vendornote;
1419         $query .= q| WHERE ordernumber = ?|;
1420         my $sth = $dbh->prepare($query);
1421
1422         $sth->execute(
1423             $order->{quantity} - $quantrec,
1424             ( defined $order_internalnote ? $order_internalnote : () ),
1425             ( defined $order_vendornote ? $order_vendornote : () ),
1426             $ordernumber
1427         );
1428
1429         delete $order->{'ordernumber'};
1430         $order->{'budget_id'} = ( $budget_id || $order->{'budget_id'} );
1431         $order->{'quantity'} = $quantrec;
1432         $order->{'quantityreceived'} = $quantrec;
1433         $order->{'datereceived'} = $datereceived;
1434         $order->{'invoiceid'} = $invoiceid;
1435         $order->{'unitprice'} = $cost;
1436         $order->{'rrp'} = $rrp;
1437         $order->{ecost} = $ecost;
1438         $order->{'orderstatus'} = 'complete';
1439         $new_ordernumber = Koha::Acquisition::Order->new($order)->insert->{ordernumber};
1440
1441         if ($received_items) {
1442             foreach my $itemnumber (@$received_items) {
1443                 ModItemOrder($itemnumber, $new_ordernumber);
1444             }
1445         }
1446     } else {
1447         my $query = q|
1448             update aqorders
1449             set quantityreceived=?,datereceived=?,invoiceid=?,
1450                 unitprice=?,rrp=?,ecost=?,budget_id=?,orderstatus='complete'|;
1451         $query .= q|, order_internalnote = ?| if defined $order_internalnote;
1452         $query .= q|, order_vendornote = ?| if defined $order_vendornote;
1453         $query .= q| where biblionumber=? and ordernumber=?|;
1454         my $sth = $dbh->prepare( $query );
1455         $sth->execute(
1456             $quantrec,
1457             $datereceived,
1458             $invoiceid,
1459             $cost,
1460             $rrp,
1461             $ecost,
1462             ( $budget_id ? $budget_id : $order->{budget_id} ),
1463             ( defined $order_internalnote ? $order_internalnote : () ),
1464             ( defined $order_vendornote ? $order_vendornote : () ),
1465             $biblionumber,
1466             $ordernumber
1467         );
1468
1469         # All items have been received, sent a notification to users
1470         NotifyOrderUsers( $ordernumber );
1471
1472     }
1473     return ($datereceived, $new_ordernumber);
1474 }
1475
1476 =head3 CancelReceipt
1477
1478     my $parent_ordernumber = CancelReceipt($ordernumber);
1479
1480     Cancel an order line receipt and update the parent order line, as if no
1481     receipt was made.
1482     If items are created at receipt (AcqCreateItem = receiving) then delete
1483     these items.
1484
1485 =cut
1486
1487 sub CancelReceipt {
1488     my $ordernumber = shift;
1489
1490     return unless $ordernumber;
1491
1492     my $dbh = C4::Context->dbh;
1493     my $query = qq{
1494         SELECT datereceived, parent_ordernumber, quantity
1495         FROM aqorders
1496         WHERE ordernumber = ?
1497     };
1498     my $sth = $dbh->prepare($query);
1499     $sth->execute($ordernumber);
1500     my $order = $sth->fetchrow_hashref;
1501     unless($order) {
1502         warn "CancelReceipt: order $ordernumber does not exist";
1503         return;
1504     }
1505     unless($order->{'datereceived'}) {
1506         warn "CancelReceipt: order $ordernumber is not received";
1507         return;
1508     }
1509
1510     my $parent_ordernumber = $order->{'parent_ordernumber'};
1511
1512     my @itemnumbers = GetItemnumbersFromOrder( $ordernumber );
1513
1514     if($parent_ordernumber == $ordernumber || not $parent_ordernumber) {
1515         # The order line has no parent, just mark it as not received
1516         $query = qq{
1517             UPDATE aqorders
1518             SET quantityreceived = ?,
1519                 datereceived = ?,
1520                 invoiceid = ?,
1521                 orderstatus = 'ordered'
1522             WHERE ordernumber = ?
1523         };
1524         $sth = $dbh->prepare($query);
1525         $sth->execute(0, undef, undef, $ordernumber);
1526         _cancel_items_receipt( $ordernumber );
1527     } else {
1528         # The order line has a parent, increase parent quantity and delete
1529         # the order line.
1530         $query = qq{
1531             SELECT quantity, datereceived
1532             FROM aqorders
1533             WHERE ordernumber = ?
1534         };
1535         $sth = $dbh->prepare($query);
1536         $sth->execute($parent_ordernumber);
1537         my $parent_order = $sth->fetchrow_hashref;
1538         unless($parent_order) {
1539             warn "Parent order $parent_ordernumber does not exist.";
1540             return;
1541         }
1542         if($parent_order->{'datereceived'}) {
1543             warn "CancelReceipt: parent order is received.".
1544                 " Can't cancel receipt.";
1545             return;
1546         }
1547         $query = qq{
1548             UPDATE aqorders
1549             SET quantity = ?,
1550                 orderstatus = 'ordered'
1551             WHERE ordernumber = ?
1552         };
1553         $sth = $dbh->prepare($query);
1554         my $rv = $sth->execute(
1555             $order->{'quantity'} + $parent_order->{'quantity'},
1556             $parent_ordernumber
1557         );
1558         unless($rv) {
1559             warn "Cannot update parent order line, so do not cancel".
1560                 " receipt";
1561             return;
1562         }
1563         _cancel_items_receipt( $ordernumber, $parent_ordernumber );
1564         # Delete order line
1565         $query = qq{
1566             DELETE FROM aqorders
1567             WHERE ordernumber = ?
1568         };
1569         $sth = $dbh->prepare($query);
1570         $sth->execute($ordernumber);
1571
1572     }
1573
1574     if(C4::Context->preference('AcqCreateItem') eq 'ordering') {
1575         my @affects = split q{\|}, C4::Context->preference("AcqItemSetSubfieldsWhenReceiptIsCancelled");
1576         if ( @affects ) {
1577             for my $in ( @itemnumbers ) {
1578                 my $biblionumber = C4::Biblio::GetBiblionumberFromItemnumber( $in );
1579                 my $frameworkcode = GetFrameworkCode($biblionumber);
1580                 my ( $itemfield ) = GetMarcFromKohaField( 'items.itemnumber', $frameworkcode );
1581                 my $item = C4::Items::GetMarcItem( $biblionumber, $in );
1582                 for my $affect ( @affects ) {
1583                     my ( $sf, $v ) = split q{=}, $affect, 2;
1584                     foreach ( $item->field($itemfield) ) {
1585                         $_->update( $sf => $v );
1586                     }
1587                 }
1588                 C4::Items::ModItemFromMarc( $item, $biblionumber, $in );
1589             }
1590         }
1591     }
1592
1593     return $parent_ordernumber;
1594 }
1595
1596 sub _cancel_items_receipt {
1597     my ( $ordernumber, $parent_ordernumber ) = @_;
1598     $parent_ordernumber ||= $ordernumber;
1599
1600     my @itemnumbers = GetItemnumbersFromOrder($ordernumber);
1601     if(C4::Context->preference('AcqCreateItem') eq 'receiving') {
1602         # Remove items that were created at receipt
1603         my $query = qq{
1604             DELETE FROM items, aqorders_items
1605             USING items, aqorders_items
1606             WHERE items.itemnumber = ? AND aqorders_items.itemnumber = ?
1607         };
1608         my $dbh = C4::Context->dbh;
1609         my $sth = $dbh->prepare($query);
1610         foreach my $itemnumber (@itemnumbers) {
1611             $sth->execute($itemnumber, $itemnumber);
1612         }
1613     } else {
1614         # Update items
1615         foreach my $itemnumber (@itemnumbers) {
1616             ModItemOrder($itemnumber, $parent_ordernumber);
1617         }
1618     }
1619 }
1620
1621 #------------------------------------------------------------#
1622
1623 =head3 SearchOrders
1624
1625 @results = &SearchOrders({
1626     ordernumber => $ordernumber,
1627     search => $search,
1628     biblionumber => $biblionumber,
1629     ean => $ean,
1630     booksellerid => $booksellerid,
1631     basketno => $basketno,
1632     owner => $owner,
1633     pending => $pending
1634     ordered => $ordered
1635 });
1636
1637 Searches for orders.
1638
1639 C<$owner> Finds order for the logged in user.
1640 C<$pending> Finds pending orders. Ignores completed and cancelled orders.
1641 C<$ordered> Finds orders to receive only (status 'ordered' or 'partial').
1642
1643
1644 C<@results> is an array of references-to-hash with the keys are fields
1645 from aqorders, biblio, biblioitems and aqbasket tables.
1646
1647 =cut
1648
1649 sub SearchOrders {
1650     my ( $params ) = @_;
1651     my $ordernumber = $params->{ordernumber};
1652     my $search = $params->{search};
1653     my $ean = $params->{ean};
1654     my $booksellerid = $params->{booksellerid};
1655     my $basketno = $params->{basketno};
1656     my $basketname = $params->{basketname};
1657     my $basketgroupname = $params->{basketgroupname};
1658     my $owner = $params->{owner};
1659     my $pending = $params->{pending};
1660     my $ordered = $params->{ordered};
1661     my $biblionumber = $params->{biblionumber};
1662     my $budget_id = $params->{budget_id};
1663
1664     my $dbh = C4::Context->dbh;
1665     my @args = ();
1666     my $query = q{
1667         SELECT aqbasket.basketno,
1668                borrowers.surname,
1669                borrowers.firstname,
1670                biblio.*,
1671                biblioitems.isbn,
1672                biblioitems.biblioitemnumber,
1673                aqbasket.authorisedby,
1674                aqbasket.booksellerid,
1675                aqbasket.closedate,
1676                aqbasket.creationdate,
1677                aqbasket.basketname,
1678                aqbasketgroups.id as basketgroupid,
1679                aqbasketgroups.name as basketgroupname,
1680                aqorders.*
1681         FROM aqorders
1682             LEFT JOIN aqbasket ON aqorders.basketno = aqbasket.basketno
1683             LEFT JOIN aqbasketgroups ON aqbasket.basketgroupid = aqbasketgroups.id
1684             LEFT JOIN borrowers ON aqbasket.authorisedby=borrowers.borrowernumber
1685             LEFT JOIN biblio ON aqorders.biblionumber=biblio.biblionumber
1686             LEFT JOIN biblioitems ON biblioitems.biblionumber=biblio.biblionumber
1687     };
1688
1689     # If we search on ordernumber, we retrieve the transfered order if a transfer has been done.
1690     $query .= q{
1691             LEFT JOIN aqorders_transfers ON aqorders_transfers.ordernumber_to = aqorders.ordernumber
1692     } if $ordernumber;
1693
1694     $query .= q{
1695         WHERE (datecancellationprinted is NULL)
1696     };
1697
1698     if ( $pending or $ordered ) {
1699         $query .= q{ AND (quantity > quantityreceived OR quantityreceived is NULL)};
1700     }
1701     if ( $ordered ) {
1702         $query .= q{ AND aqorders.orderstatus IN ( "ordered", "partial" )};
1703     }
1704
1705     my $userenv = C4::Context->userenv;
1706     if ( C4::Context->preference("IndependentBranches") ) {
1707         unless ( C4::Context->IsSuperLibrarian() ) {
1708             $query .= q{
1709                 AND (
1710                     borrowers.branchcode = ?
1711                     OR borrowers.branchcode  = ''
1712                 )
1713             };
1714             push @args, $userenv->{branch};
1715         }
1716     }
1717
1718     if ( $ordernumber ) {
1719         $query .= ' AND ( aqorders.ordernumber = ? OR aqorders_transfers.ordernumber_from = ? ) ';
1720         push @args, ( $ordernumber, $ordernumber );
1721     }
1722     if ( $biblionumber ) {
1723         $query .= 'AND aqorders.biblionumber = ?';
1724         push @args, $biblionumber;
1725     }
1726     if( $search ) {
1727         $query .= ' AND (biblio.title LIKE ? OR biblio.author LIKE ? OR biblioitems.isbn LIKE ?)';
1728         push @args, ("%$search%","%$search%","%$search%");
1729     }
1730     if ( $ean ) {
1731         $query .= ' AND biblioitems.ean = ?';
1732         push @args, $ean;
1733     }
1734     if ( $booksellerid ) {
1735         $query .= 'AND aqbasket.booksellerid = ?';
1736         push @args, $booksellerid;
1737     }
1738     if( $basketno ) {
1739         $query .= 'AND aqbasket.basketno = ?';
1740         push @args, $basketno;
1741     }
1742     if( $basketname ) {
1743         $query .= 'AND aqbasket.basketname LIKE ?';
1744         push @args, "%$basketname%";
1745     }
1746     if( $basketgroupname ) {
1747         $query .= ' AND aqbasketgroups.name LIKE ?';
1748         push @args, "%$basketgroupname%";
1749     }
1750
1751     if ( $owner ) {
1752         $query .= ' AND aqbasket.authorisedby=? ';
1753         push @args, $userenv->{'number'};
1754     }
1755
1756     if ( $budget_id ) {
1757         $query .= ' AND aqorders.budget_id = ?';
1758         push @args, $budget_id;
1759     }
1760
1761     $query .= ' ORDER BY aqbasket.basketno';
1762
1763     my $sth = $dbh->prepare($query);
1764     $sth->execute(@args);
1765     return $sth->fetchall_arrayref({});
1766 }
1767
1768 #------------------------------------------------------------#
1769
1770 =head3 DelOrder
1771
1772   &DelOrder($biblionumber, $ordernumber);
1773
1774 Cancel the order with the given order and biblio numbers. It does not
1775 delete any entries in the aqorders table, it merely marks them as
1776 cancelled.
1777
1778 =cut
1779
1780 sub DelOrder {
1781     my ( $bibnum, $ordernumber, $delete_biblio, $reason ) = @_;
1782
1783     my $error;
1784     my $dbh = C4::Context->dbh;
1785     my $query = "
1786         UPDATE aqorders
1787         SET    datecancellationprinted=now(), orderstatus='cancelled'
1788     ";
1789     if($reason) {
1790         $query .= ", cancellationreason = ? ";
1791     }
1792     $query .= "
1793         WHERE biblionumber=? AND ordernumber=?
1794     ";
1795     my $sth = $dbh->prepare($query);
1796     if($reason) {
1797         $sth->execute($reason, $bibnum, $ordernumber);
1798     } else {
1799         $sth->execute( $bibnum, $ordernumber );
1800     }
1801     $sth->finish;
1802
1803     my @itemnumbers = GetItemnumbersFromOrder( $ordernumber );
1804     foreach my $itemnumber (@itemnumbers){
1805         my $delcheck = C4::Items::DelItemCheck( $dbh, $bibnum, $itemnumber );
1806
1807         if($delcheck != 1) {
1808             $error->{'delitem'} = 1;
1809         }
1810     }
1811
1812     if($delete_biblio) {
1813         # We get the number of remaining items
1814         my $itemcount = C4::Items::GetItemsCount($bibnum);
1815
1816         # If there are no items left,
1817         if ( $itemcount == 0 ) {
1818             # We delete the record
1819             my $delcheck = DelBiblio($bibnum);
1820
1821             if($delcheck) {
1822                 $error->{'delbiblio'} = 1;
1823             }
1824         }
1825     }
1826
1827     return $error;
1828 }
1829
1830 =head3 TransferOrder
1831
1832     my $newordernumber = TransferOrder($ordernumber, $basketno);
1833
1834 Transfer an order line to a basket.
1835 Mark $ordernumber as cancelled with an internal note 'Cancelled and transfered
1836 to BOOKSELLER on DATE' and create new order with internal note
1837 'Transfered from BOOKSELLER on DATE'.
1838 Move all attached items to the new order.
1839 Received orders cannot be transfered.
1840 Return the ordernumber of created order.
1841
1842 =cut
1843
1844 sub TransferOrder {
1845     my ($ordernumber, $basketno) = @_;
1846
1847     return unless ($ordernumber and $basketno);
1848
1849     my $order = GetOrder( $ordernumber );
1850     return if $order->{datereceived};
1851     my $basket = GetBasket($basketno);
1852     return unless $basket;
1853
1854     my $dbh = C4::Context->dbh;
1855     my ($query, $sth, $rv);
1856
1857     $query = q{
1858         UPDATE aqorders
1859         SET datecancellationprinted = CAST(NOW() AS date)
1860         WHERE ordernumber = ?
1861     };
1862     $sth = $dbh->prepare($query);
1863     $rv = $sth->execute($ordernumber);
1864
1865     delete $order->{'ordernumber'};
1866     delete $order->{parent_ordernumber};
1867     $order->{'basketno'} = $basketno;
1868
1869     my $newordernumber = Koha::Acquisition::Order->new($order)->insert->{ordernumber};
1870
1871     $query = q{
1872         UPDATE aqorders_items
1873         SET ordernumber = ?
1874         WHERE ordernumber = ?
1875     };
1876     $sth = $dbh->prepare($query);
1877     $sth->execute($newordernumber, $ordernumber);
1878
1879     $query = q{
1880         INSERT INTO aqorders_transfers (ordernumber_from, ordernumber_to)
1881         VALUES (?, ?)
1882     };
1883     $sth = $dbh->prepare($query);
1884     $sth->execute($ordernumber, $newordernumber);
1885
1886     return $newordernumber;
1887 }
1888
1889 =head2 FUNCTIONS ABOUT PARCELS
1890
1891 =head3 GetParcels
1892
1893   $results = &GetParcels($bookseller, $order, $code, $datefrom, $dateto);
1894
1895 get a lists of parcels.
1896
1897 * Input arg :
1898
1899 =over
1900
1901 =item $bookseller
1902 is the bookseller this function has to get parcels.
1903
1904 =item $order
1905 To know on what criteria the results list has to be ordered.
1906
1907 =item $code
1908 is the booksellerinvoicenumber.
1909
1910 =item $datefrom & $dateto
1911 to know on what date this function has to filter its search.
1912
1913 =back
1914
1915 * return:
1916 a pointer on a hash list containing parcel informations as such :
1917
1918 =over
1919
1920 =item Creation date
1921
1922 =item Last operation
1923
1924 =item Number of biblio
1925
1926 =item Number of items
1927
1928 =back
1929
1930 =cut
1931
1932 sub GetParcels {
1933     my ($bookseller,$order, $code, $datefrom, $dateto) = @_;
1934     my $dbh    = C4::Context->dbh;
1935     my @query_params = ();
1936     my $strsth ="
1937         SELECT  aqinvoices.invoicenumber,
1938                 datereceived,purchaseordernumber,
1939                 count(DISTINCT biblionumber) AS biblio,
1940                 sum(quantity) AS itemsexpected,
1941                 sum(quantityreceived) AS itemsreceived
1942         FROM   aqorders LEFT JOIN aqbasket ON aqbasket.basketno = aqorders.basketno
1943         LEFT JOIN aqinvoices ON aqorders.invoiceid = aqinvoices.invoiceid
1944         WHERE aqbasket.booksellerid = ? and datereceived IS NOT NULL
1945     ";
1946     push @query_params, $bookseller;
1947
1948     if ( defined $code ) {
1949         $strsth .= ' and aqinvoices.invoicenumber like ? ';
1950         # add a % to the end of the code to allow stemming.
1951         push @query_params, "$code%";
1952     }
1953
1954     if ( defined $datefrom ) {
1955         $strsth .= ' and datereceived >= ? ';
1956         push @query_params, $datefrom;
1957     }
1958
1959     if ( defined $dateto ) {
1960         $strsth .=  'and datereceived <= ? ';
1961         push @query_params, $dateto;
1962     }
1963
1964     $strsth .= "group by aqinvoices.invoicenumber,datereceived ";
1965
1966     # can't use a placeholder to place this column name.
1967     # but, we could probably be checking to make sure it is a column that will be fetched.
1968     $strsth .= "order by $order " if ($order);
1969
1970     my $sth = $dbh->prepare($strsth);
1971
1972     $sth->execute( @query_params );
1973     my $results = $sth->fetchall_arrayref({});
1974     return @{$results};
1975 }
1976
1977 #------------------------------------------------------------#
1978
1979 =head3 GetLateOrders
1980
1981   @results = &GetLateOrders;
1982
1983 Searches for bookseller with late orders.
1984
1985 return:
1986 the table of supplier with late issues. This table is full of hashref.
1987
1988 =cut
1989
1990 sub GetLateOrders {
1991     my $delay      = shift;
1992     my $supplierid = shift;
1993     my $branch     = shift;
1994     my $estimateddeliverydatefrom = shift;
1995     my $estimateddeliverydateto = shift;
1996
1997     my $dbh = C4::Context->dbh;
1998
1999     #BEWARE, order of parenthesis and LEFT JOIN is important for speed
2000     my $dbdriver = C4::Context->config("db_scheme") || "mysql";
2001
2002     my @query_params = ();
2003     my $select = "
2004     SELECT aqbasket.basketno,
2005         aqorders.ordernumber,
2006         DATE(aqbasket.closedate)  AS orderdate,
2007         aqbasket.basketname       AS basketname,
2008         aqbasket.basketgroupid    AS basketgroupid,
2009         aqbasketgroups.name       AS basketgroupname,
2010         aqorders.rrp              AS unitpricesupplier,
2011         aqorders.ecost            AS unitpricelib,
2012         aqorders.claims_count     AS claims_count,
2013         aqorders.claimed_date     AS claimed_date,
2014         aqbudgets.budget_name     AS budget,
2015         borrowers.branchcode      AS branch,
2016         aqbooksellers.name        AS supplier,
2017         aqbooksellers.id          AS supplierid,
2018         biblio.author, biblio.title,
2019         biblioitems.publishercode AS publisher,
2020         biblioitems.publicationyear,
2021         ADDDATE(aqbasket.closedate, INTERVAL aqbooksellers.deliverytime DAY) AS estimateddeliverydate,
2022     ";
2023     my $from = "
2024     FROM
2025         aqorders LEFT JOIN biblio     ON biblio.biblionumber         = aqorders.biblionumber
2026         LEFT JOIN biblioitems         ON biblioitems.biblionumber    = biblio.biblionumber
2027         LEFT JOIN aqbudgets           ON aqorders.budget_id          = aqbudgets.budget_id,
2028         aqbasket LEFT JOIN borrowers  ON aqbasket.authorisedby       = borrowers.borrowernumber
2029         LEFT JOIN aqbooksellers       ON aqbasket.booksellerid       = aqbooksellers.id
2030         LEFT JOIN aqbasketgroups      ON aqbasket.basketgroupid      = aqbasketgroups.id
2031         WHERE aqorders.basketno = aqbasket.basketno
2032         AND ( datereceived = ''
2033             OR datereceived IS NULL
2034             OR aqorders.quantityreceived < aqorders.quantity
2035         )
2036         AND aqbasket.closedate IS NOT NULL
2037         AND (aqorders.datecancellationprinted IS NULL OR aqorders.datecancellationprinted='0000-00-00')
2038     ";
2039     my $having = "";
2040     if ($dbdriver eq "mysql") {
2041         $select .= "
2042         aqorders.quantity - COALESCE(aqorders.quantityreceived,0)                 AS quantity,
2043         (aqorders.quantity - COALESCE(aqorders.quantityreceived,0)) * aqorders.rrp AS subtotal,
2044         DATEDIFF(CAST(now() AS date),closedate) AS latesince
2045         ";
2046         if ( defined $delay ) {
2047             $from .= " AND (closedate <= DATE_SUB(CAST(now() AS date),INTERVAL ? DAY)) " ;
2048             push @query_params, $delay;
2049         }
2050         $having = "
2051         HAVING quantity          <> 0
2052             AND unitpricesupplier <> 0
2053             AND unitpricelib      <> 0
2054         ";
2055     } else {
2056         # FIXME: account for IFNULL as above
2057         $select .= "
2058                 aqorders.quantity                AS quantity,
2059                 aqorders.quantity * aqorders.rrp AS subtotal,
2060                 (CAST(now() AS date) - closedate)            AS latesince
2061         ";
2062         if ( defined $delay ) {
2063             $from .= " AND (closedate <= (CAST(now() AS date) -(INTERVAL ? DAY)) ";
2064             push @query_params, $delay;
2065         }
2066     }
2067     if (defined $supplierid) {
2068         $from .= ' AND aqbasket.booksellerid = ? ';
2069         push @query_params, $supplierid;
2070     }
2071     if (defined $branch) {
2072         $from .= ' AND borrowers.branchcode LIKE ? ';
2073         push @query_params, $branch;
2074     }
2075
2076     if ( defined $estimateddeliverydatefrom or defined $estimateddeliverydateto ) {
2077         $from .= ' AND aqbooksellers.deliverytime IS NOT NULL ';
2078     }
2079     if ( defined $estimateddeliverydatefrom ) {
2080         $from .= ' AND ADDDATE(aqbasket.closedate, INTERVAL aqbooksellers.deliverytime DAY) >= ?';
2081         push @query_params, $estimateddeliverydatefrom;
2082     }
2083     if ( defined $estimateddeliverydateto ) {
2084         $from .= ' AND ADDDATE(aqbasket.closedate, INTERVAL aqbooksellers.deliverytime DAY) <= ?';
2085         push @query_params, $estimateddeliverydateto;
2086     }
2087     if ( defined $estimateddeliverydatefrom and not defined $estimateddeliverydateto ) {
2088         $from .= ' AND ADDDATE(aqbasket.closedate, INTERVAL aqbooksellers.deliverytime DAY) <= CAST(now() AS date)';
2089     }
2090     if (C4::Context->preference("IndependentBranches")
2091             && !C4::Context->IsSuperLibrarian() ) {
2092         $from .= ' AND borrowers.branchcode LIKE ? ';
2093         push @query_params, C4::Context->userenv->{branch};
2094     }
2095     $from .= " AND orderstatus <> 'cancelled' ";
2096     my $query = "$select $from $having\nORDER BY latesince, basketno, borrowers.branchcode, supplier";
2097     $debug and print STDERR "GetLateOrders query: $query\nGetLateOrders args: " . join(" ",@query_params);
2098     my $sth = $dbh->prepare($query);
2099     $sth->execute(@query_params);
2100     my @results;
2101     while (my $data = $sth->fetchrow_hashref) {
2102         push @results, $data;
2103     }
2104     return @results;
2105 }
2106
2107 #------------------------------------------------------------#
2108
2109 =head3 GetHistory
2110
2111   \@order_loop = GetHistory( %params );
2112
2113 Retreives some acquisition history information
2114
2115 params:
2116   title
2117   author
2118   name
2119   isbn
2120   ean
2121   from_placed_on
2122   to_placed_on
2123   basket                  - search both basket name and number
2124   booksellerinvoicenumber
2125   basketgroupname
2126   budget
2127   orderstatus (note that orderstatus '' will retrieve orders
2128                of any status except cancelled)
2129   biblionumber
2130   get_canceled_order (if set to a true value, cancelled orders will
2131                       be included)
2132
2133 returns:
2134     $order_loop is a list of hashrefs that each look like this:
2135             {
2136                 'author'           => 'Twain, Mark',
2137                 'basketno'         => '1',
2138                 'biblionumber'     => '215',
2139                 'count'            => 1,
2140                 'creationdate'     => 'MM/DD/YYYY',
2141                 'datereceived'     => undef,
2142                 'ecost'            => '1.00',
2143                 'id'               => '1',
2144                 'invoicenumber'    => undef,
2145                 'name'             => '',
2146                 'ordernumber'      => '1',
2147                 'quantity'         => 1,
2148                 'quantityreceived' => undef,
2149                 'title'            => 'The Adventures of Huckleberry Finn'
2150             }
2151
2152 =cut
2153
2154 sub GetHistory {
2155 # don't run the query if there are no parameters (list would be too long for sure !)
2156     croak "No search params" unless @_;
2157     my %params = @_;
2158     my $title = $params{title};
2159     my $author = $params{author};
2160     my $isbn   = $params{isbn};
2161     my $ean    = $params{ean};
2162     my $name = $params{name};
2163     my $from_placed_on = $params{from_placed_on};
2164     my $to_placed_on = $params{to_placed_on};
2165     my $basket = $params{basket};
2166     my $booksellerinvoicenumber = $params{booksellerinvoicenumber};
2167     my $basketgroupname = $params{basketgroupname};
2168     my $budget = $params{budget};
2169     my $orderstatus = $params{orderstatus};
2170     my $biblionumber = $params{biblionumber};
2171     my $get_canceled_order = $params{get_canceled_order} || 0;
2172     my $ordernumber = $params{ordernumber};
2173     my $search_children_too = $params{search_children_too} || 0;
2174     my $created_by = $params{created_by} || [];
2175
2176     my @order_loop;
2177     my $total_qty         = 0;
2178     my $total_qtyreceived = 0;
2179     my $total_price       = 0;
2180
2181     my $dbh   = C4::Context->dbh;
2182     my $query ="
2183         SELECT
2184             COALESCE(biblio.title,     deletedbiblio.title)     AS title,
2185             COALESCE(biblio.author,    deletedbiblio.author)    AS author,
2186             COALESCE(biblioitems.isbn, deletedbiblioitems.isbn) AS isbn,
2187             COALESCE(biblioitems.ean,  deletedbiblioitems.ean)  AS ean,
2188             aqorders.basketno,
2189             aqbasket.basketname,
2190             aqbasket.basketgroupid,
2191             aqbasket.authorisedby,
2192             concat( borrowers.firstname,' ',borrowers.surname) AS authorisedbyname,
2193             aqbasketgroups.name as groupname,
2194             aqbooksellers.name,
2195             aqbasket.creationdate,
2196             aqorders.datereceived,
2197             aqorders.quantity,
2198             aqorders.quantityreceived,
2199             aqorders.ecost,
2200             aqorders.ordernumber,
2201             aqorders.invoiceid,
2202             aqinvoices.invoicenumber,
2203             aqbooksellers.id as id,
2204             aqorders.biblionumber,
2205             aqorders.orderstatus,
2206             aqorders.parent_ordernumber,
2207             aqbudgets.budget_name
2208             ";
2209     $query .= ", aqbudgets.budget_id AS budget" if defined $budget;
2210     $query .= "
2211         FROM aqorders
2212         LEFT JOIN aqbasket ON aqorders.basketno=aqbasket.basketno
2213         LEFT JOIN aqbasketgroups ON aqbasket.basketgroupid=aqbasketgroups.id
2214         LEFT JOIN aqbooksellers ON aqbasket.booksellerid=aqbooksellers.id
2215         LEFT JOIN biblioitems ON biblioitems.biblionumber=aqorders.biblionumber
2216         LEFT JOIN biblio ON biblio.biblionumber=aqorders.biblionumber
2217         LEFT JOIN aqbudgets ON aqorders.budget_id=aqbudgets.budget_id
2218         LEFT JOIN aqinvoices ON aqorders.invoiceid = aqinvoices.invoiceid
2219         LEFT JOIN deletedbiblio ON deletedbiblio.biblionumber=aqorders.biblionumber
2220         LEFT JOIN deletedbiblioitems ON deletedbiblioitems.biblionumber=aqorders.biblionumber
2221         LEFT JOIN borrowers ON aqbasket.authorisedby=borrowers.borrowernumber
2222         ";
2223
2224     $query .= " WHERE 1 ";
2225
2226     unless ($get_canceled_order or (defined $orderstatus and $orderstatus eq 'cancelled')) {
2227         $query .= " AND (datecancellationprinted is NULL or datecancellationprinted='0000-00-00') ";
2228     }
2229
2230     my @query_params  = ();
2231
2232     if ( $biblionumber ) {
2233         $query .= " AND biblio.biblionumber = ?";
2234         push @query_params, $biblionumber;
2235     }
2236
2237     if ( $title ) {
2238         $query .= " AND biblio.title LIKE ? ";
2239         $title =~ s/\s+/%/g;
2240         push @query_params, "%$title%";
2241     }
2242
2243     if ( $author ) {
2244         $query .= " AND biblio.author LIKE ? ";
2245         push @query_params, "%$author%";
2246     }
2247
2248     if ( $isbn ) {
2249         $query .= " AND biblioitems.isbn LIKE ? ";
2250         push @query_params, "%$isbn%";
2251     }
2252     if ( $ean ) {
2253         $query .= " AND biblioitems.ean = ? ";
2254         push @query_params, "$ean";
2255     }
2256     if ( $name ) {
2257         $query .= " AND aqbooksellers.name LIKE ? ";
2258         push @query_params, "%$name%";
2259     }
2260
2261     if ( $budget ) {
2262         $query .= " AND aqbudgets.budget_id = ? ";
2263         push @query_params, "$budget";
2264     }
2265
2266     if ( $from_placed_on ) {
2267         $query .= " AND creationdate >= ? ";
2268         push @query_params, $from_placed_on;
2269     }
2270
2271     if ( $to_placed_on ) {
2272         $query .= " AND creationdate <= ? ";
2273         push @query_params, $to_placed_on;
2274     }
2275
2276     if ( defined $orderstatus and $orderstatus ne '') {
2277         $query .= " AND aqorders.orderstatus = ? ";
2278         push @query_params, "$orderstatus";
2279     }
2280
2281     if ($basket) {
2282         if ($basket =~ m/^\d+$/) {
2283             $query .= " AND aqorders.basketno = ? ";
2284             push @query_params, $basket;
2285         } else {
2286             $query .= " AND aqbasket.basketname LIKE ? ";
2287             push @query_params, "%$basket%";
2288         }
2289     }
2290
2291     if ($booksellerinvoicenumber) {
2292         $query .= " AND aqinvoices.invoicenumber LIKE ? ";
2293         push @query_params, "%$booksellerinvoicenumber%";
2294     }
2295
2296     if ($basketgroupname) {
2297         $query .= " AND aqbasketgroups.name LIKE ? ";
2298         push @query_params, "%$basketgroupname%";
2299     }
2300
2301     if ($ordernumber) {
2302         $query .= " AND (aqorders.ordernumber = ? ";
2303         push @query_params, $ordernumber;
2304         if ($search_children_too) {
2305             $query .= " OR aqorders.parent_ordernumber = ? ";
2306             push @query_params, $ordernumber;
2307         }
2308         $query .= ") ";
2309     }
2310
2311     if ( @$created_by ) {
2312         $query .= ' AND aqbasket.authorisedby IN ( ' . join( ',', ('?') x @$created_by ) . ')';
2313         push @query_params, @$created_by;
2314     }
2315
2316
2317     if ( C4::Context->preference("IndependentBranches") ) {
2318         unless ( C4::Context->IsSuperLibrarian() ) {
2319             $query .= " AND (borrowers.branchcode = ? OR borrowers.branchcode ='' ) ";
2320             push @query_params, C4::Context->userenv->{branch};
2321         }
2322     }
2323     $query .= " ORDER BY id";
2324
2325     return $dbh->selectall_arrayref( $query, { Slice => {} }, @query_params );
2326 }
2327
2328 =head2 GetRecentAcqui
2329
2330   $results = GetRecentAcqui($days);
2331
2332 C<$results> is a ref to a table which containts hashref
2333
2334 =cut
2335
2336 sub GetRecentAcqui {
2337     my $limit  = shift;
2338     my $dbh    = C4::Context->dbh;
2339     my $query = "
2340         SELECT *
2341         FROM   biblio
2342         ORDER BY timestamp DESC
2343         LIMIT  0,".$limit;
2344
2345     my $sth = $dbh->prepare($query);
2346     $sth->execute;
2347     my $results = $sth->fetchall_arrayref({});
2348     return $results;
2349 }
2350
2351 #------------------------------------------------------------#
2352
2353 =head3 AddClaim
2354
2355   &AddClaim($ordernumber);
2356
2357 Add a claim for an order
2358
2359 =cut
2360
2361 sub AddClaim {
2362     my ($ordernumber) = @_;
2363     my $dbh          = C4::Context->dbh;
2364     my $query        = "
2365         UPDATE aqorders SET
2366             claims_count = claims_count + 1,
2367             claimed_date = CURDATE()
2368         WHERE ordernumber = ?
2369         ";
2370     my $sth = $dbh->prepare($query);
2371     $sth->execute($ordernumber);
2372 }
2373
2374 =head3 GetInvoices
2375
2376     my @invoices = GetInvoices(
2377         invoicenumber => $invoicenumber,
2378         supplierid => $supplierid,
2379         suppliername => $suppliername,
2380         shipmentdatefrom => $shipmentdatefrom, # ISO format
2381         shipmentdateto => $shipmentdateto, # ISO format
2382         billingdatefrom => $billingdatefrom, # ISO format
2383         billingdateto => $billingdateto, # ISO format
2384         isbneanissn => $isbn_or_ean_or_issn,
2385         title => $title,
2386         author => $author,
2387         publisher => $publisher,
2388         publicationyear => $publicationyear,
2389         branchcode => $branchcode,
2390         order_by => $order_by
2391     );
2392
2393 Return a list of invoices that match all given criteria.
2394
2395 $order_by is "column_name (asc|desc)", where column_name is any of
2396 'invoicenumber', 'booksellerid', 'shipmentdate', 'billingdate', 'closedate',
2397 'shipmentcost', 'shipmentcost_budgetid'.
2398
2399 asc is the default if omitted
2400
2401 =cut
2402
2403 sub GetInvoices {
2404     my %args = @_;
2405
2406     my @columns = qw(invoicenumber booksellerid shipmentdate billingdate
2407         closedate shipmentcost shipmentcost_budgetid);
2408
2409     my $dbh = C4::Context->dbh;
2410     my $query = qq{
2411         SELECT aqinvoices.*, aqbooksellers.name AS suppliername,
2412           COUNT(
2413             DISTINCT IF(
2414               aqorders.datereceived IS NOT NULL,
2415               aqorders.biblionumber,
2416               NULL
2417             )
2418           ) AS receivedbiblios,
2419           COUNT(
2420              DISTINCT IF(
2421               aqorders.subscriptionid IS NOT NULL,
2422               aqorders.subscriptionid,
2423               NULL
2424             )
2425           ) AS is_linked_to_subscriptions,
2426           SUM(aqorders.quantityreceived) AS receiveditems
2427         FROM aqinvoices
2428           LEFT JOIN aqbooksellers ON aqbooksellers.id = aqinvoices.booksellerid
2429           LEFT JOIN aqorders ON aqorders.invoiceid = aqinvoices.invoiceid
2430           LEFT JOIN aqbasket ON aqbasket.basketno=aqorders.basketno
2431           LEFT JOIN borrowers ON aqbasket.authorisedby=borrowers.borrowernumber
2432           LEFT JOIN biblio ON aqorders.biblionumber = biblio.biblionumber
2433           LEFT JOIN biblioitems ON biblio.biblionumber = biblioitems.biblionumber
2434           LEFT JOIN subscription ON biblio.biblionumber = subscription.biblionumber
2435     };
2436
2437     my @bind_args;
2438     my @bind_strs;
2439     if($args{supplierid}) {
2440         push @bind_strs, " aqinvoices.booksellerid = ? ";
2441         push @bind_args, $args{supplierid};
2442     }
2443     if($args{invoicenumber}) {
2444         push @bind_strs, " aqinvoices.invoicenumber LIKE ? ";
2445         push @bind_args, "%$args{invoicenumber}%";
2446     }
2447     if($args{suppliername}) {
2448         push @bind_strs, " aqbooksellers.name LIKE ? ";
2449         push @bind_args, "%$args{suppliername}%";
2450     }
2451     if($args{shipmentdatefrom}) {
2452         push @bind_strs, " aqinvoices.shipmentdate >= ? ";
2453         push @bind_args, $args{shipmentdatefrom};
2454     }
2455     if($args{shipmentdateto}) {
2456         push @bind_strs, " aqinvoices.shipmentdate <= ? ";
2457         push @bind_args, $args{shipmentdateto};
2458     }
2459     if($args{billingdatefrom}) {
2460         push @bind_strs, " aqinvoices.billingdate >= ? ";
2461         push @bind_args, $args{billingdatefrom};
2462     }
2463     if($args{billingdateto}) {
2464         push @bind_strs, " aqinvoices.billingdate <= ? ";
2465         push @bind_args, $args{billingdateto};
2466     }
2467     if($args{isbneanissn}) {
2468         push @bind_strs, " (biblioitems.isbn LIKE CONCAT('%', ?, '%') OR biblioitems.ean LIKE CONCAT('%', ?, '%') OR biblioitems.issn LIKE CONCAT('%', ?, '%') ) ";
2469         push @bind_args, $args{isbneanissn}, $args{isbneanissn}, $args{isbneanissn};
2470     }
2471     if($args{title}) {
2472         push @bind_strs, " biblio.title LIKE CONCAT('%', ?, '%') ";
2473         push @bind_args, $args{title};
2474     }
2475     if($args{author}) {
2476         push @bind_strs, " biblio.author LIKE CONCAT('%', ?, '%') ";
2477         push @bind_args, $args{author};
2478     }
2479     if($args{publisher}) {
2480         push @bind_strs, " biblioitems.publishercode LIKE CONCAT('%', ?, '%') ";
2481         push @bind_args, $args{publisher};
2482     }
2483     if($args{publicationyear}) {
2484         push @bind_strs, " ((biblioitems.publicationyear LIKE CONCAT('%', ?, '%')) OR (biblio.copyrightdate LIKE CONCAT('%', ?, '%'))) ";
2485         push @bind_args, $args{publicationyear}, $args{publicationyear};
2486     }
2487     if($args{branchcode}) {
2488         push @bind_strs, " borrowers.branchcode = ? ";
2489         push @bind_args, $args{branchcode};
2490     }
2491
2492     $query .= " WHERE " . join(" AND ", @bind_strs) if @bind_strs;
2493     $query .= " GROUP BY aqinvoices.invoiceid ";
2494
2495     if($args{order_by}) {
2496         my ($column, $direction) = split / /, $args{order_by};
2497         if(grep /^$column$/, @columns) {
2498             $direction ||= 'ASC';
2499             $query .= " ORDER BY $column $direction";
2500         }
2501     }
2502
2503     my $sth = $dbh->prepare($query);
2504     $sth->execute(@bind_args);
2505
2506     my $results = $sth->fetchall_arrayref({});
2507     return @$results;
2508 }
2509
2510 =head3 GetInvoice
2511
2512     my $invoice = GetInvoice($invoiceid);
2513
2514 Get informations about invoice with given $invoiceid
2515
2516 Return a hash filled with aqinvoices.* fields
2517
2518 =cut
2519
2520 sub GetInvoice {
2521     my ($invoiceid) = @_;
2522     my $invoice;
2523
2524     return unless $invoiceid;
2525
2526     my $dbh = C4::Context->dbh;
2527     my $query = qq{
2528         SELECT *
2529         FROM aqinvoices
2530         WHERE invoiceid = ?
2531     };
2532     my $sth = $dbh->prepare($query);
2533     $sth->execute($invoiceid);
2534
2535     $invoice = $sth->fetchrow_hashref;
2536     return $invoice;
2537 }
2538
2539 =head3 GetInvoiceDetails
2540
2541     my $invoice = GetInvoiceDetails($invoiceid)
2542
2543 Return informations about an invoice + the list of related order lines
2544
2545 Orders informations are in $invoice->{orders} (array ref)
2546
2547 =cut
2548
2549 sub GetInvoiceDetails {
2550     my ($invoiceid) = @_;
2551
2552     if ( !defined $invoiceid ) {
2553         carp 'GetInvoiceDetails called without an invoiceid';
2554         return;
2555     }
2556
2557     my $dbh = C4::Context->dbh;
2558     my $query = q{
2559         SELECT aqinvoices.*, aqbooksellers.name AS suppliername
2560         FROM aqinvoices
2561           LEFT JOIN aqbooksellers ON aqinvoices.booksellerid = aqbooksellers.id
2562         WHERE invoiceid = ?
2563     };
2564     my $sth = $dbh->prepare($query);
2565     $sth->execute($invoiceid);
2566
2567     my $invoice = $sth->fetchrow_hashref;
2568
2569     $query = q{
2570         SELECT aqorders.*,
2571                 biblio.*,
2572                 biblio.copyrightdate,
2573                 biblioitems.publishercode,
2574                 biblioitems.publicationyear,
2575                 aqbasket.basketname,
2576                 aqbasketgroups.id AS basketgroupid,
2577                 aqbasketgroups.name AS basketgroupname
2578         FROM aqorders
2579           LEFT JOIN aqbasket ON aqorders.basketno = aqbasket.basketno
2580           LEFT JOIN aqbasketgroups ON aqbasket.basketgroupid = aqbasketgroups.id
2581           LEFT JOIN biblio ON aqorders.biblionumber = biblio.biblionumber
2582           LEFT JOIN biblioitems ON aqorders.biblionumber = biblioitems.biblionumber
2583         WHERE invoiceid = ?
2584     };
2585     $sth = $dbh->prepare($query);
2586     $sth->execute($invoiceid);
2587     $invoice->{orders} = $sth->fetchall_arrayref({});
2588     $invoice->{orders} ||= []; # force an empty arrayref if fetchall_arrayref fails
2589
2590     return $invoice;
2591 }
2592
2593 =head3 AddInvoice
2594
2595     my $invoiceid = AddInvoice(
2596         invoicenumber => $invoicenumber,
2597         booksellerid => $booksellerid,
2598         shipmentdate => $shipmentdate,
2599         billingdate => $billingdate,
2600         closedate => $closedate,
2601         shipmentcost => $shipmentcost,
2602         shipmentcost_budgetid => $shipmentcost_budgetid
2603     );
2604
2605 Create a new invoice and return its id or undef if it fails.
2606
2607 =cut
2608
2609 sub AddInvoice {
2610     my %invoice = @_;
2611
2612     return unless(%invoice and $invoice{invoicenumber});
2613
2614     my @columns = qw(invoicenumber booksellerid shipmentdate billingdate
2615         closedate shipmentcost shipmentcost_budgetid);
2616
2617     my @set_strs;
2618     my @set_args;
2619     foreach my $key (keys %invoice) {
2620         if(0 < grep(/^$key$/, @columns)) {
2621             push @set_strs, "$key = ?";
2622             push @set_args, ($invoice{$key} || undef);
2623         }
2624     }
2625
2626     my $rv;
2627     if(@set_args > 0) {
2628         my $dbh = C4::Context->dbh;
2629         my $query = "INSERT INTO aqinvoices SET ";
2630         $query .= join (",", @set_strs);
2631         my $sth = $dbh->prepare($query);
2632         $rv = $sth->execute(@set_args);
2633         if($rv) {
2634             $rv = $dbh->last_insert_id(undef, undef, 'aqinvoices', undef);
2635         }
2636     }
2637     return $rv;
2638 }
2639
2640 =head3 ModInvoice
2641
2642     ModInvoice(
2643         invoiceid => $invoiceid,    # Mandatory
2644         invoicenumber => $invoicenumber,
2645         booksellerid => $booksellerid,
2646         shipmentdate => $shipmentdate,
2647         billingdate => $billingdate,
2648         closedate => $closedate,
2649         shipmentcost => $shipmentcost,
2650         shipmentcost_budgetid => $shipmentcost_budgetid
2651     );
2652
2653 Modify an invoice, invoiceid is mandatory.
2654
2655 Return undef if it fails.
2656
2657 =cut
2658
2659 sub ModInvoice {
2660     my %invoice = @_;
2661
2662     return unless(%invoice and $invoice{invoiceid});
2663
2664     my @columns = qw(invoicenumber booksellerid shipmentdate billingdate
2665         closedate shipmentcost shipmentcost_budgetid);
2666
2667     my @set_strs;
2668     my @set_args;
2669     foreach my $key (keys %invoice) {
2670         if(0 < grep(/^$key$/, @columns)) {
2671             push @set_strs, "$key = ?";
2672             push @set_args, ($invoice{$key} || undef);
2673         }
2674     }
2675
2676     my $dbh = C4::Context->dbh;
2677     my $query = "UPDATE aqinvoices SET ";
2678     $query .= join(",", @set_strs);
2679     $query .= " WHERE invoiceid = ?";
2680
2681     my $sth = $dbh->prepare($query);
2682     $sth->execute(@set_args, $invoice{invoiceid});
2683 }
2684
2685 =head3 CloseInvoice
2686
2687     CloseInvoice($invoiceid);
2688
2689 Close an invoice.
2690
2691 Equivalent to ModInvoice(invoiceid => $invoiceid, closedate => undef);
2692
2693 =cut
2694
2695 sub CloseInvoice {
2696     my ($invoiceid) = @_;
2697
2698     return unless $invoiceid;
2699
2700     my $dbh = C4::Context->dbh;
2701     my $query = qq{
2702         UPDATE aqinvoices
2703         SET closedate = CAST(NOW() AS DATE)
2704         WHERE invoiceid = ?
2705     };
2706     my $sth = $dbh->prepare($query);
2707     $sth->execute($invoiceid);
2708 }
2709
2710 =head3 ReopenInvoice
2711
2712     ReopenInvoice($invoiceid);
2713
2714 Reopen an invoice
2715
2716 Equivalent to ModInvoice(invoiceid => $invoiceid, closedate => C4::Dates->new()->output('iso'))
2717
2718 =cut
2719
2720 sub ReopenInvoice {
2721     my ($invoiceid) = @_;
2722
2723     return unless $invoiceid;
2724
2725     my $dbh = C4::Context->dbh;
2726     my $query = qq{
2727         UPDATE aqinvoices
2728         SET closedate = NULL
2729         WHERE invoiceid = ?
2730     };
2731     my $sth = $dbh->prepare($query);
2732     $sth->execute($invoiceid);
2733 }
2734
2735 =head3 DelInvoice
2736
2737     DelInvoice($invoiceid);
2738
2739 Delete an invoice if there are no items attached to it.
2740
2741 =cut
2742
2743 sub DelInvoice {
2744     my ($invoiceid) = @_;
2745
2746     return unless $invoiceid;
2747
2748     my $dbh   = C4::Context->dbh;
2749     my $query = qq{
2750         SELECT COUNT(*)
2751         FROM aqorders
2752         WHERE invoiceid = ?
2753     };
2754     my $sth = $dbh->prepare($query);
2755     $sth->execute($invoiceid);
2756     my $res = $sth->fetchrow_arrayref;
2757     if ( $res && $res->[0] == 0 ) {
2758         $query = qq{
2759             DELETE FROM aqinvoices
2760             WHERE invoiceid = ?
2761         };
2762         my $sth = $dbh->prepare($query);
2763         return ( $sth->execute($invoiceid) > 0 );
2764     }
2765     return;
2766 }
2767
2768 =head3 MergeInvoices
2769
2770     MergeInvoices($invoiceid, \@sourceids);
2771
2772 Merge the invoices identified by the IDs in \@sourceids into
2773 the invoice identified by $invoiceid.
2774
2775 =cut
2776
2777 sub MergeInvoices {
2778     my ($invoiceid, $sourceids) = @_;
2779
2780     return unless $invoiceid;
2781     foreach my $sourceid (@$sourceids) {
2782         next if $sourceid == $invoiceid;
2783         my $source = GetInvoiceDetails($sourceid);
2784         foreach my $order (@{$source->{'orders'}}) {
2785             $order->{'invoiceid'} = $invoiceid;
2786             ModOrder($order);
2787         }
2788         DelInvoice($source->{'invoiceid'});
2789     }
2790     return;
2791 }
2792
2793 =head3 GetBiblioCountByBasketno
2794
2795 $biblio_count = &GetBiblioCountByBasketno($basketno);
2796
2797 Looks up the biblio's count that has basketno value $basketno
2798
2799 Returns a quantity
2800
2801 =cut
2802
2803 sub GetBiblioCountByBasketno {
2804     my ($basketno) = @_;
2805     my $dbh          = C4::Context->dbh;
2806     my $query        = "
2807         SELECT COUNT( DISTINCT( biblionumber ) )
2808         FROM   aqorders
2809         WHERE  basketno = ?
2810             AND (datecancellationprinted IS NULL OR datecancellationprinted='0000-00-00')
2811         ";
2812
2813     my $sth = $dbh->prepare($query);
2814     $sth->execute($basketno);
2815     return $sth->fetchrow;
2816 }
2817
2818 # This is *not* the good way to calcul prices
2819 # But it's how it works at the moment into Koha
2820 # This will be fixed later.
2821 # Note this subroutine should be moved to Koha::Acquisition::Order
2822 # Will do when a DBIC decision will be taken.
2823 sub populate_order_with_prices {
2824     my ($params) = @_;
2825
2826     my $order        = $params->{order};
2827     my $booksellerid = $params->{booksellerid};
2828     return unless $booksellerid;
2829
2830     my $bookseller = Koha::Acquisition::Bookseller->fetch({ id => $booksellerid });
2831
2832     my $receiving = $params->{receiving};
2833     my $ordering  = $params->{ordering};
2834     my $discount  = $order->{discount};
2835     $discount /= 100 if $discount > 1;
2836
2837     $order->{rrp}   = Koha::Number::Price->new( $order->{rrp} )->round;
2838     $order->{ecost} = Koha::Number::Price->new( $order->{ecost} )->round;
2839     if ($ordering) {
2840         if ( $bookseller->{listincgst} ) {
2841             $order->{rrpgsti} = $order->{rrp};
2842             $order->{rrpgste} = Koha::Number::Price->new(
2843                 $order->{rrpgsti} / ( 1 + $order->{gstrate} ) )->round;
2844             $order->{ecostgsti} = $order->{ecost};
2845             $order->{ecostgste} = Koha::Number::Price->new(
2846                 $order->{ecost} / ( 1 + $order->{gstrate} ) )->round;
2847             $order->{gstvalue} = Koha::Number::Price->new(
2848                 ( $order->{ecostgsti} - $order->{ecostgste} ) *
2849                   $order->{quantity} )->round;
2850             $order->{totalgste} = $order->{ecostgste} * $order->{quantity};
2851             $order->{totalgsti} = $order->{ecostgsti} * $order->{quantity};
2852         }
2853         else {
2854             $order->{rrpgste} = $order->{rrp};
2855             $order->{rrpgsti} = Koha::Number::Price->new(
2856                 $order->{rrp} * ( 1 + $order->{gstrate} ) )->round;
2857             $order->{ecostgste} = $order->{ecost};
2858             $order->{ecostgsti} = 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     }
2867
2868     if ($receiving) {
2869         if ( $bookseller->{listincgst} ) {
2870             $order->{unitpricegsti} = Koha::Number::Price->new( $order->{unitprice} )->round;
2871             $order->{unitpricegste} = Koha::Number::Price->new(
2872               $order->{unitpricegsti} / ( 1 + $order->{gstrate} ) )->round;
2873         }
2874         else {
2875             $order->{unitpricegste} = Koha::Number::Price->new( $order->{unitprice} )->round;
2876             $order->{unitpricegsti} = Koha::Number::Price->new(
2877               $order->{unitpricegste} * ( 1 + $order->{gstrate} ) )->round;
2878         }
2879         $order->{gstvalue} = Koha::Number::Price->new(
2880           ( $order->{unitpricegsti} - $order->{unitpricegste} )
2881           * $order->{quantityreceived} )->round;
2882
2883         $order->{totalgste} = $order->{unitpricegste} * $order->{quantity};
2884         $order->{totalgsti} = $order->{unitpricegsti} * $order->{quantity};
2885     }
2886
2887     return $order;
2888 }
2889
2890 =head3 GetOrderUsers
2891
2892     $order_users_ids = &GetOrderUsers($ordernumber);
2893
2894 Returns a list of all borrowernumbers that are in order users list
2895
2896 =cut
2897
2898 sub GetOrderUsers {
2899     my ($ordernumber) = @_;
2900
2901     return unless $ordernumber;
2902
2903     my $query = q|
2904         SELECT borrowernumber
2905         FROM aqorder_users
2906         WHERE ordernumber = ?
2907     |;
2908     my $dbh = C4::Context->dbh;
2909     my $sth = $dbh->prepare($query);
2910     $sth->execute($ordernumber);
2911     my $results = $sth->fetchall_arrayref( {} );
2912
2913     my @borrowernumbers;
2914     foreach (@$results) {
2915         push @borrowernumbers, $_->{'borrowernumber'};
2916     }
2917
2918     return @borrowernumbers;
2919 }
2920
2921 =head3 ModOrderUsers
2922
2923     my @order_users_ids = (1, 2, 3);
2924     &ModOrderUsers($ordernumber, @basketusers_ids);
2925
2926 Delete all users from order users list, and add users in C<@order_users_ids>
2927 to this users list.
2928
2929 =cut
2930
2931 sub ModOrderUsers {
2932     my ( $ordernumber, @order_users_ids ) = @_;
2933
2934     return unless $ordernumber;
2935
2936     my $dbh   = C4::Context->dbh;
2937     my $query = q|
2938         DELETE FROM aqorder_users
2939         WHERE ordernumber = ?
2940     |;
2941     my $sth = $dbh->prepare($query);
2942     $sth->execute($ordernumber);
2943
2944     $query = q|
2945         INSERT INTO aqorder_users (ordernumber, borrowernumber)
2946         VALUES (?, ?)
2947     |;
2948     $sth = $dbh->prepare($query);
2949     foreach my $order_user_id (@order_users_ids) {
2950         $sth->execute( $ordernumber, $order_user_id );
2951     }
2952 }
2953
2954 sub NotifyOrderUsers {
2955     my ($ordernumber) = @_;
2956
2957     my @borrowernumbers = GetOrderUsers($ordernumber);
2958     return unless @borrowernumbers;
2959
2960     my $order = GetOrder( $ordernumber );
2961     for my $borrowernumber (@borrowernumbers) {
2962         my $borrower = C4::Members::GetMember( borrowernumber => $borrowernumber );
2963         my $branch = C4::Branch::GetBranchDetail( $borrower->{branchcode} );
2964         my $biblio = C4::Biblio::GetBiblio( $order->{biblionumber} );
2965         my $letter = C4::Letters::GetPreparedLetter(
2966             module      => 'acquisition',
2967             letter_code => 'ACQ_NOTIF_ON_RECEIV',
2968             branchcode  => $branch->{branchcode},
2969             tables      => {
2970                 'branches'    => $branch,
2971                 'borrowers'   => $borrower,
2972                 'biblio'      => $biblio,
2973                 'aqorders'    => $order,
2974             },
2975         );
2976         if ( $letter ) {
2977             C4::Letters::EnqueueLetter(
2978                 {
2979                     letter         => $letter,
2980                     borrowernumber => $borrowernumber,
2981                     LibraryName    => C4::Context->preference("LibraryName"),
2982                     message_transport_type => 'email',
2983                 }
2984             ) or warn "can't enqueue letter $letter";
2985         }
2986     }
2987 }
2988
2989 1;
2990 __END__
2991
2992 =head1 AUTHOR
2993
2994 Koha Development Team <http://koha-community.org/>
2995
2996 =cut