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