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