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