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