C4/Acquisition.pm

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