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