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