Koha/Acquisition/Order.pm

   1 package Koha::Acquisition::Order;
   2
   3 # This file is part of Koha.
   4 #
   5 # Koha is free software; you can redistribute it and/or modify it
   6 # under the terms of the GNU General Public License as published by
   7 # the Free Software Foundation; either version 3 of the License, or
   8 # (at your option) any later version.
   9 #
  10 # Koha is distributed in the hope that it will be useful, but
  11 # WITHOUT ANY WARRANTY; without even the implied warranty of
  12 # MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
  13 # GNU General Public License for more details.
  14 #
  15 # You should have received a copy of the GNU General Public License
  16 # along with Koha; if not, see <http://www.gnu.org/licenses>.
  17
  18 use Modern::Perl;
  19
  20 use Carp qw( croak );
  21
  22 use C4::Biblio qw( DelBiblio );
  23 use C4::Acquisition;
  24 use C4::Suggestions qw( ModSuggestion );
  25
  26 use Koha::Acquisition::Baskets;
  27 use Koha::Acquisition::Funds;
  28 use Koha::Acquisition::Invoices;
  29 use Koha::Acquisition::Order::Claims;
  30 use Koha::Database;
  31 use Koha::DateUtils qw( dt_from_string );
  32 use Koha::Exceptions::Object;
  33 use Koha::Biblios;
  34 use Koha::Holds;
  35 use Koha::Items;
  36 use Koha::Number::Price;
  37 use Koha::Patrons;
  38 use Koha::Subscriptions;
  39
  40 use base qw(Koha::Object Koha::Object::Mixin::AdditionalFields);
  41
  42 =head1 NAME
  43
  44 Koha::Acquisition::Order Object class
  45
  46 =head1 API
  47
  48 =head2 Class methods
  49
  50 =head3 new
  51
  52 Overloaded I<new> method for backwards compatibility.
  53
  54 =cut
  55
  56 sub new {
  57     my ( $self, $params ) = @_;
  58
  59     my $schema  = Koha::Database->new->schema;
  60     my @columns = $schema->source('Aqorder')->columns;
  61
  62     my $values =
  63       { map { exists $params->{$_} ? ( $_ => $params->{$_} ) : () } @columns };
  64     return $self->SUPER::new($values);
  65 }
  66
  67 =head3 store
  68
  69 Overloaded I<store> method for backwards compatibility.
  70
  71 =cut
  72
  73 sub store {
  74     my ($self) = @_;
  75
  76     my $schema  = Koha::Database->new->schema;
  77     # Override quantity for standing orders
  78     $self->quantity(1) if ( $self->basketno && $schema->resultset('Aqbasket')->find( $self->basketno )->is_standing );
  79
  80     # if these parameters are missing, we can't continue
  81     for my $key (qw( basketno quantity biblionumber budget_id )) {
  82         next if $key eq 'biblionumber' && ($self->orderstatus // q{}) eq 'cancelled'; # cancelled order might have biblionumber NULL
  83         croak "Cannot insert order: Mandatory parameter $key is missing"
  84           unless $self->$key;
  85     }
  86
  87     if (not defined $self->{created_by}) {
  88         my $userenv = C4::Context->userenv;
  89         if ($userenv) {
  90             $self->created_by($userenv->{number});
  91         }
  92     }
  93
  94     $self->quantityreceived(0) unless $self->quantityreceived;
  95     $self->entrydate(dt_from_string) unless $self->entrydate;
  96
  97     $self->ordernumber(undef) unless $self->ordernumber;
  98     $self = $self->SUPER::store( $self );
  99
 100     unless ( $self->parent_ordernumber ) {
 101         $self->set( { parent_ordernumber => $self->ordernumber } );
 102         $self = $self->SUPER::store( $self );
 103     }
 104
 105     return $self;
 106 }
 107
 108 =head3 cancel
 109
 110     $order->cancel(
 111         {
 112             [
 113                 reason        => $reason,
 114                 delete_biblio => $delete_biblio
 115             ]
 116         }
 117     );
 118
 119 This method marks an order as cancelled, optionally using the I<reason> parameter.
 120 As the order is cancelled, the (eventual) items linked to it are removed.
 121 If I<delete_biblio> is passed, it will try to remove the linked biblio.
 122
 123 If either the items or biblio removal fails, an error message is added to the object
 124 so the caller can take appropriate actions.
 125
 126 =cut
 127
 128 sub cancel {
 129     my ($self, $params) = @_;
 130
 131     my $delete_biblio = $params->{delete_biblio};
 132     my $reason        = $params->{reason};
 133
 134     # Delete the related items
 135     my $items = $self->items;
 136     while ( my $item = $items->next ) {
 137         my $deleted = $item->safe_delete;
 138         unless ( $deleted ) {
 139             $self->add_message(
 140                 {
 141                     message => 'error_delitem',
 142                     payload => { item => $item, reason => @{$deleted->messages}[0]->message }
 143                 }
 144             );
 145         }
 146     }
 147
 148     # If ordered from a suggestion, revert the suggestion status to ACCEPTED
 149     my $suggestion = Koha::Suggestions->find({ biblionumber => $self->biblionumber, status => "ORDERED" });
 150     if ( $suggestion and $suggestion->id ) {
 151         ModSuggestion(
 152             {
 153                 suggestionid => $suggestion->id,
 154                 biblionumber => $self->biblionumber,
 155                 STATUS       => 'ACCEPTED',
 156             }
 157         );
 158     }
 159
 160     my $biblio = $self->biblio;
 161     if ( $biblio and $delete_biblio ) {
 162
 163         if (
 164             $biblio->active_orders->search(
 165                 { ordernumber => { '!=' => $self->ordernumber } }
 166             )->count == 0
 167             and $biblio->subscriptions->count == 0
 168             and $biblio->items->count == 0
 169             )
 170         {
 171
 172             my $error = DelBiblio( $biblio->id );
 173             $self->add_message(
 174                 {
 175                     message => 'error_delbiblio',
 176                     payload => { biblio => $biblio, reason => $error }
 177                 }
 178             ) if $error;
 179             $self->biblionumber(undef) unless $error; # constraint cleared biblionumber in db already
 180         }
 181         else {
 182
 183             my $message;
 184
 185             if ( $biblio->active_orders->search(
 186                 { ordernumber => { '!=' => $self->ordernumber } }
 187             )->count > 0 ) {
 188                 $message = 'error_delbiblio_active_orders';
 189             }
 190             elsif ( $biblio->subscriptions->count > 0 ) {
 191                 $message = 'error_delbiblio_subscriptions';
 192             }
 193             else { # $biblio->items->count > 0
 194                 $message = 'error_delbiblio_items';
 195             }
 196
 197             $self->add_message(
 198                 {
 199                     message => $message,
 200                     payload => { biblio => $biblio }
 201                 }
 202             );
 203         }
 204     }
 205
 206     # Update order status
 207     $self->set(
 208         {
 209             cancellationreason      => $reason,
 210             datecancellationprinted => \'NOW()',
 211             orderstatus             => 'cancelled',
 212         }
 213     )->store;
 214
 215     return $self;
 216 }
 217
 218 =head3 add_item
 219
 220   $order->add_item( $itemnumber );
 221
 222 Link an item to this order.
 223
 224 =cut
 225
 226 sub add_item {
 227     my ( $self, $itemnumber )  = @_;
 228
 229     my $schema = Koha::Database->new->schema;
 230     my $rs = $schema->resultset('AqordersItem');
 231     $rs->create({ ordernumber => $self->ordernumber, itemnumber => $itemnumber });
 232 }
 233
 234 =head3 basket
 235
 236     my $basket = $order->basket;
 237
 238 Returns the I<Koha::Acquisition::Basket> object for the basket associated
 239 to the order.
 240
 241 =cut
 242
 243 sub basket {
 244     my ( $self )  = @_;
 245     my $basket_rs = $self->_result->basket;
 246     return Koha::Acquisition::Basket->_new_from_dbic( $basket_rs );
 247 }
 248
 249 =head3 fund
 250
 251     my $fund = $order->fund;
 252
 253 Returns the I<Koha::Acquisition::Fund> object for the fund (aqbudgets)
 254 associated to the order.
 255
 256 =cut
 257
 258 sub fund {
 259     my ( $self )  = @_;
 260     my $fund_rs = $self->_result->fund;
 261     return Koha::Acquisition::Fund->_new_from_dbic( $fund_rs );
 262 }
 263
 264 =head3 invoice
 265
 266     my $invoice = $order->invoice;
 267
 268 Returns the I<Koha::Acquisition::Invoice> object for the invoice associated
 269 to the order.
 270
 271 It returns B<undef> if no linked invoice is found.
 272
 273 =cut
 274
 275 sub invoice {
 276     my ( $self )  = @_;
 277     my $invoice_rs = $self->_result->invoice;
 278     return unless $invoice_rs;
 279     return Koha::Acquisition::Invoice->_new_from_dbic( $invoice_rs );
 280 }
 281
 282 =head3 subscription
 283
 284     my $subscription = $order->subscription
 285
 286 Returns the I<Koha::Subscription> object for the subscription associated
 287 to the order.
 288
 289 It returns B<undef> if no linked subscription is found.
 290
 291 =cut
 292
 293 sub subscription {
 294     my ( $self )  = @_;
 295     my $subscription_rs = $self->_result->subscription;
 296     return unless $subscription_rs;
 297     return Koha::Subscription->_new_from_dbic( $subscription_rs );
 298 }
 299
 300 =head3 current_item_level_holds
 301
 302     my $holds = $order->current_item_level_holds;
 303
 304 Returns the current item-level holds associated to the order. It returns a I<Koha::Holds>
 305 resultset.
 306
 307 =cut
 308
 309 sub current_item_level_holds {
 310     my ($self) = @_;
 311
 312     my $items_rs     = $self->_result->aqorders_items;
 313     my @item_numbers = $items_rs->get_column('itemnumber')->all;
 314     my $biblio       = $self->biblio;
 315
 316     unless ( $biblio and @item_numbers ) {
 317         return Koha::Holds->new->empty;
 318     }
 319
 320     return $biblio->current_holds->search(
 321         {
 322             itemnumber => {
 323                 -in => \@item_numbers
 324             }
 325         }
 326     );
 327 }
 328
 329 =head3 items
 330
 331     my $items = $order->items
 332
 333 Returns the items associated to the order.
 334
 335 =cut
 336
 337 sub items {
 338     my ( $self )  = @_;
 339     # aqorders_items is not a join table
 340     # There is no FK on items (may have been deleted)
 341     my $items_rs = $self->_result->aqorders_items;
 342     my @itemnumbers = $items_rs->get_column( 'itemnumber' )->all;
 343     return Koha::Items->search({ itemnumber => \@itemnumbers });
 344 }
 345
 346 =head3 biblio
 347
 348     my $biblio = $order->biblio
 349
 350 Returns the bibliographic record associated to the order
 351
 352 =cut
 353
 354 sub biblio {
 355     my ( $self ) = @_;
 356     my $biblio_rs= $self->_result->biblio;
 357     return unless $biblio_rs;
 358     return Koha::Biblio->_new_from_dbic( $biblio_rs );
 359 }
 360
 361 =head3 claims
 362
 363     my $claims = $order->claims
 364
 365 Return the claims history for this order
 366
 367 =cut
 368
 369 sub claims {
 370     my ( $self ) = @_;
 371     my $claims_rs = $self->_result->aqorders_claims;
 372     return Koha::Acquisition::Order::Claims->_new_from_dbic( $claims_rs );
 373 }
 374
 375 =head3 claim
 376
 377     my $claim = $order->claim
 378
 379 Do claim for this order
 380
 381 =cut
 382
 383 sub claim {
 384     my ( $self ) = @_;
 385     my $claim_rs = $self->_result->create_related('aqorders_claims', {});
 386     return Koha::Acquisition::Order::Claim->_new_from_dbic($claim_rs);
 387 }
 388
 389 =head3 claims_count
 390
 391 my $nb_of_claims = $order->claims_count;
 392
 393 This is the equivalent of $order->claims->count. Keeping it for retrocompatibilty.
 394
 395 =cut
 396
 397 sub claims_count {
 398     my ( $self ) = @_;
 399     return $self->claims->count;
 400 }
 401
 402 =head3 claimed_date
 403
 404 my $last_claim_date = $order->claimed_date;
 405
 406 This is the equivalent of $order->claims->last->claimed_on. Keeping it for retrocompatibilty.
 407
 408 =cut
 409
 410 sub claimed_date {
 411     my ( $self ) = @_;
 412     my $last_claim = $self->claims->last;
 413     return unless $last_claim;
 414     return $last_claim->claimed_on;
 415 }
 416
 417 =head3 creator
 418
 419 my $creator = $order->creator;
 420
 421 Retrieves patron that created this order.
 422
 423 =cut
 424
 425 sub creator {
 426     my ( $self )  = @_;
 427     my $creator_rs = $self->_result->creator;
 428     return Koha::Patron->_new_from_dbic( $creator_rs );
 429 }
 430
 431 =head3 duplicate_to
 432
 433     my $duplicated_order = $order->duplicate_to($basket, [$default_values]);
 434
 435 Duplicate an existing order and attach it to a basket. $default_values can be specified as a hashref
 436 that contain default values for the different order's attributes.
 437 Items will be duplicated as well but barcodes will be set to null.
 438
 439 =cut
 440
 441 sub duplicate_to {
 442     my ( $self, $basket, $default_values ) = @_;
 443     my $new_order;
 444     $default_values //= {};
 445     Koha::Database->schema->txn_do(
 446         sub {
 447             my $order_info = $self->unblessed;
 448             undef $order_info->{ordernumber};
 449             for my $field (
 450                 qw(
 451                 ordernumber
 452                 received_on
 453                 datereceived
 454                 invoiceid
 455                 datecancellationprinted
 456                 cancellationreason
 457                 purchaseordernumber
 458                 claims_count
 459                 claimed_date
 460                 parent_ordernumber
 461                 )
 462               )
 463             {
 464                 undef $order_info->{$field};
 465             }
 466             $order_info->{placed_on}        = dt_from_string;
 467             $order_info->{entrydate}        = dt_from_string;
 468             $order_info->{orderstatus}      = 'new';
 469             $order_info->{quantityreceived} = 0;
 470             while ( my ( $field, $value ) = each %$default_values ) {
 471                 $order_info->{$field} = $value;
 472             }
 473
 474             my $userenv = C4::Context->userenv;
 475             $order_info->{created_by} = $userenv->{number};
 476             $order_info->{basketno} = $basket->basketno;
 477
 478             $new_order = Koha::Acquisition::Order->new($order_info)->store;
 479
 480             if ( ! $self->subscriptionid && $self->basket->effective_create_items eq 'ordering') { # Do copy items if not a subscription order AND if items are created on ordering
 481                 my $items = $self->items;
 482                 while ( my ($item) = $items->next ) {
 483                     my $item_info = $item->unblessed;
 484                     undef $item_info->{itemnumber};
 485                     undef $item_info->{barcode};
 486                     my $new_item = Koha::Item->new($item_info)->store;
 487                     $new_order->add_item( $new_item->itemnumber );
 488                 }
 489             }
 490         }
 491     );
 492     return $new_order;
 493 }
 494
 495 =head3 populate_with_prices_for_ordering
 496
 497 Sets calculated values for an order - all values are stored with full precision
 498 regardless of rounding preference except for tax value which is calculated on
 499 rounded values if requested
 500
 501     $order->populate_with_prices_for_ordering()
 502
 503 The values set are:
 504     rrp_tax_included
 505     rrp_tax_excluded
 506     ecost_tax_included
 507     ecost_tax_excluded
 508     tax_value_on_ordering
 509
 510 =cut
 511
 512 sub populate_with_prices_for_ordering {
 513     my ($self) = @_;
 514
 515     my $bookseller = $self->basket->bookseller;
 516     return unless $bookseller;
 517
 518     my $discount = $self->discount || 0;
 519     $discount /= 100 if $discount > 1;
 520
 521     if ( $bookseller->listincgst ) {
 522         # The user entered the prices tax included
 523         $self->unitprice($self->unitprice + 0);
 524         $self->unitprice_tax_included($self->unitprice);
 525         $self->rrp_tax_included($self->rrp);
 526
 527         # price tax excluded = price tax included / ( 1 + tax rate )
 528         $self->unitprice_tax_excluded( $self->unitprice_tax_included / ( 1 + $self->tax_rate_on_ordering ) );
 529         $self->rrp_tax_excluded( $self->rrp_tax_included / ( 1 + $self->tax_rate_on_ordering ) );
 530
 531         # ecost tax included = rrp tax included  ( 1 - discount )
 532         $self->ecost_tax_included($self->rrp_tax_included * ( 1 - $discount ));
 533
 534         # ecost tax excluded = rrp tax excluded * ( 1 - discount )
 535         $self->ecost_tax_excluded($self->rrp_tax_excluded * ( 1 - $discount ));
 536
 537         # tax value = quantity * ecost tax excluded * tax rate
 538         # we should use the unitprice if included
 539         my $cost_tax_included = $self->unitprice_tax_included == 0 ? $self->ecost_tax_included : $self->unitprice_tax_included;
 540         my $cost_tax_excluded = $self->unitprice_tax_excluded == 0 ? $self->ecost_tax_excluded : $self->unitprice_tax_excluded;
 541         $self->tax_value_on_ordering( ( C4::Acquisition::get_rounded_price($cost_tax_included) - C4::Acquisition::get_rounded_price($cost_tax_excluded) ) * $self->quantity );
 542     } else {
 543         # The user entered the prices tax excluded
 544         $self->unitprice_tax_excluded($self->unitprice);
 545         $self->rrp_tax_excluded($self->rrp);
 546
 547         # price tax included = price tax excluded * ( 1 - tax rate )
 548         $self->unitprice_tax_included($self->unitprice_tax_excluded * ( 1 + $self->tax_rate_on_ordering ));
 549         $self->rrp_tax_included($self->rrp_tax_excluded * ( 1 + $self->tax_rate_on_ordering ));
 550
 551         # ecost tax excluded = rrp tax excluded * ( 1 - discount )
 552         $self->ecost_tax_excluded($self->rrp_tax_excluded * ( 1 - $discount ));
 553
 554         # ecost tax included = rrp tax excluded * ( 1 + tax rate ) * ( 1 - discount ) = ecost tax excluded * ( 1 + tax rate )
 555         $self->ecost_tax_included($self->ecost_tax_excluded * ( 1 + $self->tax_rate_on_ordering ));
 556
 557         # tax value = quantity * ecost tax included * tax rate
 558         # we should use the unitprice if included
 559         my $cost_tax_excluded = $self->unitprice_tax_excluded == 0 ? $self->ecost_tax_excluded : $self->unitprice_tax_excluded;
 560         $self->tax_value_on_ordering($self->quantity * C4::Acquisition::get_rounded_price($cost_tax_excluded) * $self->tax_rate_on_ordering);
 561     }
 562 }
 563
 564 =head3 populate_with_prices_for_receiving
 565
 566 Sets calculated values for an order - all values are stored with full precision
 567 regardless of rounding preference except for tax value which is calculated on
 568 rounded values if requested
 569
 570     $order->populate_with_prices_for_receiving()
 571
 572 The values set are:
 573     unitprice_tax_included
 574     unitprice_tax_excluded
 575     tax_value_on_receiving
 576
 577 Note: When receiving, if the rounded value of the unitprice matches the rounded
 578 value of the ecost then then ecost (full precision) is used.
 579
 580 =cut
 581
 582 sub populate_with_prices_for_receiving {
 583     my ($self) = @_;
 584
 585     my $bookseller = $self->basket->bookseller;
 586     return unless $bookseller;
 587
 588     my $discount = $self->discount || 0;
 589     $discount /= 100 if $discount > 1;
 590
 591     if ($bookseller->invoiceincgst) {
 592         # Trick for unitprice. If the unit price rounded value is the same as the ecost rounded value
 593         # we need to keep the exact ecost value
 594         if ( Koha::Number::Price->new( $self->unitprice )->round == Koha::Number::Price->new( $self->ecost_tax_included )->round ) {
 595             $self->unitprice($self->ecost_tax_included);
 596         }
 597
 598         # The user entered the unit price tax included
 599         $self->unitprice_tax_included($self->unitprice);
 600
 601         # unit price tax excluded = unit price tax included / ( 1 + tax rate )
 602         $self->unitprice_tax_excluded($self->unitprice_tax_included / ( 1 + $self->tax_rate_on_receiving ));
 603     } else {
 604         # Trick for unitprice. If the unit price rounded value is the same as the ecost rounded value
 605         # we need to keep the exact ecost value
 606         if ( Koha::Number::Price->new($self->unitprice)->round == Koha::Number::Price->new($self->ecost_tax_excluded)->round ) {
 607             $self->unitprice($self->ecost_tax_excluded);
 608         }
 609
 610         # The user entered the unit price tax excluded
 611         $self->unitprice_tax_excluded($self->unitprice);
 612
 613
 614         # unit price tax included = unit price tax included * ( 1 + tax rate )
 615         $self->unitprice_tax_included($self->unitprice_tax_excluded * ( 1 + $self->tax_rate_on_receiving ));
 616     }
 617
 618     # tax value = quantity * unit price tax excluded * tax rate
 619     $self->tax_value_on_receiving($self->quantity * C4::Acquisition::get_rounded_price($self->unitprice_tax_excluded) * $self->tax_rate_on_receiving);
 620 }
 621
 622 =head3 to_api_mapping
 623
 624 This method returns the mapping for representing a Koha::Acquisition::Order object
 625 on the API.
 626
 627 =cut
 628
 629 sub to_api_mapping {
 630     return {
 631         basketno                      => 'basket_id',
 632         biblionumber                  => 'biblio_id',
 633         deleted_biblionumber          => 'deleted_biblio_id',
 634         budget_id                     => 'fund_id',
 635         budgetdate                    => undef,                    # unused
 636         cancellationreason            => 'cancellation_reason',
 637         claimed_date                  => 'last_claim_date',
 638         datecancellationprinted       => 'cancellation_date',
 639         datereceived                  => 'date_received',
 640         discount                      => 'discount_rate',
 641         entrydate                     => 'entry_date',
 642         freight                       => 'shipping_cost',
 643         invoiceid                     => 'invoice_id',
 644         line_item_id                  => undef,                    # EDIFACT related
 645         listprice                     => 'list_price',
 646         order_internalnote            => 'internal_note',
 647         order_vendornote              => 'vendor_note',
 648         ordernumber                   => 'order_id',
 649         orderstatus                   => 'status',
 650         parent_ordernumber            => 'parent_order_id',
 651         purchaseordernumber           => undef,                    # obsolete
 652         quantityreceived              => 'quantity_received',
 653         replacementprice              => 'replacement_price',
 654         sort1                         => 'statistics_1',
 655         sort1_authcat                 => 'statistics_1_authcat',
 656         sort2                         => 'statistics_2',
 657         sort2_authcat                 => 'statistics_2_authcat',
 658         subscriptionid                => 'subscription_id',
 659         suppliers_reference_number    => undef,                    # EDIFACT related
 660         suppliers_reference_qualifier => undef,                    # EDIFACT related
 661         suppliers_report              => undef,                    # EDIFACT related
 662         tax_rate_bak                  => undef,                    # unused
 663         tax_value_bak                 => undef,                    # unused
 664         uncertainprice                => 'uncertain_price',
 665         unitprice                     => 'unit_price',
 666         unitprice_tax_excluded        => 'unit_price_tax_excluded',
 667         unitprice_tax_included        => 'unit_price_tax_included',
 668         invoice_unitprice             => 'invoice_unit_price',
 669     };
 670 }
 671
 672 =head2 Internal methods
 673
 674 =head3 _type
 675
 676 =cut
 677
 678 sub _type {
 679     return 'Aqorder';
 680 }
 681
 682 1;