C4/Acquisition.pm

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