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