C4/Acquisition.pm

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