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