C4/Acquisition.pm

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