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