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 unless $creator_rs;
 429     return Koha::Patron->_new_from_dbic( $creator_rs );
 430 }
 431
 432 =head3 duplicate_to
 433
 434     my $duplicated_order = $order->duplicate_to($basket, [$default_values]);
 435
 436 Duplicate an existing order and attach it to a basket. $default_values can be specified as a hashref
 437 that contain default values for the different order's attributes.
 438 Items will be duplicated as well but barcodes will be set to null.
 439
 440 =cut
 441
 442 sub duplicate_to {
 443     my ( $self, $basket, $default_values ) = @_;
 444     my $new_order;
 445     $default_values //= {};
 446     Koha::Database->schema->txn_do(
 447         sub {
 448             my $order_info = $self->unblessed;
 449             undef $order_info->{ordernumber};
 450             for my $field (
 451                 qw(
 452                 ordernumber
 453                 received_on
 454                 datereceived
 455                 invoiceid
 456                 datecancellationprinted
 457                 cancellationreason
 458                 purchaseordernumber
 459                 claims_count
 460                 claimed_date
 461                 parent_ordernumber
 462                 )
 463               )
 464             {
 465                 undef $order_info->{$field};
 466             }
 467             $order_info->{placed_on}        = dt_from_string;
 468             $order_info->{entrydate}        = dt_from_string;
 469             $order_info->{orderstatus}      = 'new';
 470             $order_info->{quantityreceived} = 0;
 471             while ( my ( $field, $value ) = each %$default_values ) {
 472                 $order_info->{$field} = $value;
 473             }
 474
 475             my $userenv = C4::Context->userenv;
 476             $order_info->{created_by} = $userenv->{number};
 477             $order_info->{basketno} = $basket->basketno;
 478
 479             $new_order = Koha::Acquisition::Order->new($order_info)->store;
 480
 481             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
 482                 my $items = $self->items;
 483                 while ( my ($item) = $items->next ) {
 484                     my $item_info = $item->unblessed;
 485                     undef $item_info->{itemnumber};
 486                     undef $item_info->{barcode};
 487                     my $new_item = Koha::Item->new($item_info)->store;
 488                     $new_order->add_item( $new_item->itemnumber );
 489                 }
 490             }
 491         }
 492     );
 493     return $new_order;
 494 }
 495
 496 =head3 populate_with_prices_for_ordering
 497
 498 Sets calculated values for an order - all values are stored with full precision
 499 regardless of rounding preference except for tax value which is calculated on
 500 rounded values if requested
 501
 502     $order->populate_with_prices_for_ordering()
 503
 504 The values set are:
 505     rrp_tax_included
 506     rrp_tax_excluded
 507     ecost_tax_included
 508     ecost_tax_excluded
 509     tax_value_on_ordering
 510
 511 =cut
 512
 513 sub populate_with_prices_for_ordering {
 514     my ($self) = @_;
 515
 516     my $bookseller = $self->basket->bookseller;
 517     return unless $bookseller;
 518
 519     my $discount = $self->discount || 0;
 520     $discount /= 100 if $discount > 1;
 521
 522     if ( $bookseller->listincgst ) {
 523         # The user entered the prices tax included
 524         $self->unitprice($self->unitprice + 0);
 525         $self->unitprice_tax_included($self->unitprice);
 526         $self->rrp_tax_included($self->rrp);
 527
 528         # price tax excluded = price tax included / ( 1 + tax rate )
 529         $self->unitprice_tax_excluded( $self->unitprice_tax_included / ( 1 + $self->tax_rate_on_ordering ) );
 530         $self->rrp_tax_excluded( $self->rrp_tax_included / ( 1 + $self->tax_rate_on_ordering ) );
 531
 532         # ecost tax included = rrp tax included  ( 1 - discount )
 533         $self->ecost_tax_included($self->rrp_tax_included * ( 1 - $discount ));
 534
 535         # ecost tax excluded = rrp tax excluded * ( 1 - discount )
 536         $self->ecost_tax_excluded($self->rrp_tax_excluded * ( 1 - $discount ));
 537
 538         # tax value = quantity * ecost tax excluded * tax rate
 539         # we should use the unitprice if included
 540         my $cost_tax_included = $self->unitprice_tax_included == 0 ? $self->ecost_tax_included : $self->unitprice_tax_included;
 541         my $cost_tax_excluded = $self->unitprice_tax_excluded == 0 ? $self->ecost_tax_excluded : $self->unitprice_tax_excluded;
 542         $self->tax_value_on_ordering( ( C4::Acquisition::get_rounded_price($cost_tax_included) - C4::Acquisition::get_rounded_price($cost_tax_excluded) ) * $self->quantity );
 543     } else {
 544         # The user entered the prices tax excluded
 545         $self->unitprice_tax_excluded($self->unitprice);
 546         $self->rrp_tax_excluded($self->rrp);
 547
 548         # price tax included = price tax excluded * ( 1 - tax rate )
 549         $self->unitprice_tax_included($self->unitprice_tax_excluded * ( 1 + $self->tax_rate_on_ordering ));
 550         $self->rrp_tax_included($self->rrp_tax_excluded * ( 1 + $self->tax_rate_on_ordering ));
 551
 552         # ecost tax excluded = rrp tax excluded * ( 1 - discount )
 553         $self->ecost_tax_excluded($self->rrp_tax_excluded * ( 1 - $discount ));
 554
 555         # ecost tax included = rrp tax excluded * ( 1 + tax rate ) * ( 1 - discount ) = ecost tax excluded * ( 1 + tax rate )
 556         $self->ecost_tax_included($self->ecost_tax_excluded * ( 1 + $self->tax_rate_on_ordering ));
 557
 558         # tax value = quantity * ecost tax included * tax rate
 559         # we should use the unitprice if included
 560         my $cost_tax_excluded = $self->unitprice_tax_excluded == 0 ? $self->ecost_tax_excluded : $self->unitprice_tax_excluded;
 561         $self->tax_value_on_ordering($self->quantity * C4::Acquisition::get_rounded_price($cost_tax_excluded) * $self->tax_rate_on_ordering);
 562     }
 563 }
 564
 565 =head3 populate_with_prices_for_receiving
 566
 567 Sets calculated values for an order - all values are stored with full precision
 568 regardless of rounding preference except for tax value which is calculated on
 569 rounded values if requested
 570
 571     $order->populate_with_prices_for_receiving()
 572
 573 The values set are:
 574     unitprice_tax_included
 575     unitprice_tax_excluded
 576     tax_value_on_receiving
 577
 578 Note: When receiving, if the rounded value of the unitprice matches the rounded
 579 value of the ecost then then ecost (full precision) is used.
 580
 581 =cut
 582
 583 sub populate_with_prices_for_receiving {
 584     my ($self) = @_;
 585
 586     my $bookseller = $self->basket->bookseller;
 587     return unless $bookseller;
 588
 589     my $discount = $self->discount || 0;
 590     $discount /= 100 if $discount > 1;
 591
 592     if ($bookseller->invoiceincgst) {
 593         # Trick for unitprice. If the unit price rounded value is the same as the ecost rounded value
 594         # we need to keep the exact ecost value
 595         if ( Koha::Number::Price->new( $self->unitprice )->round == Koha::Number::Price->new( $self->ecost_tax_included )->round ) {
 596             $self->unitprice($self->ecost_tax_included);
 597         }
 598
 599         # The user entered the unit price tax included
 600         $self->unitprice_tax_included($self->unitprice);
 601
 602         # unit price tax excluded = unit price tax included / ( 1 + tax rate )
 603         $self->unitprice_tax_excluded($self->unitprice_tax_included / ( 1 + $self->tax_rate_on_receiving ));
 604     } else {
 605         # Trick for unitprice. If the unit price rounded value is the same as the ecost rounded value
 606         # we need to keep the exact ecost value
 607         if ( Koha::Number::Price->new($self->unitprice)->round == Koha::Number::Price->new($self->ecost_tax_excluded)->round ) {
 608             $self->unitprice($self->ecost_tax_excluded);
 609         }
 610
 611         # The user entered the unit price tax excluded
 612         $self->unitprice_tax_excluded($self->unitprice);
 613
 614
 615         # unit price tax included = unit price tax included * ( 1 + tax rate )
 616         $self->unitprice_tax_included($self->unitprice_tax_excluded * ( 1 + $self->tax_rate_on_receiving ));
 617     }
 618
 619     # tax value = quantity * unit price tax excluded * tax rate
 620     $self->tax_value_on_receiving($self->quantity * C4::Acquisition::get_rounded_price($self->unitprice_tax_excluded) * $self->tax_rate_on_receiving);
 621 }
 622
 623 =head3 to_api_mapping
 624
 625 This method returns the mapping for representing a Koha::Acquisition::Order object
 626 on the API.
 627
 628 =cut
 629
 630 sub to_api_mapping {
 631     return {
 632         basketno                      => 'basket_id',
 633         biblionumber                  => 'biblio_id',
 634         deleted_biblionumber          => 'deleted_biblio_id',
 635         budget_id                     => 'fund_id',
 636         budgetdate                    => undef,                    # unused
 637         cancellationreason            => 'cancellation_reason',
 638         claimed_date                  => 'last_claim_date',
 639         datecancellationprinted       => 'cancellation_date',
 640         datereceived                  => 'date_received',
 641         discount                      => 'discount_rate',
 642         entrydate                     => 'entry_date',
 643         freight                       => 'shipping_cost',
 644         invoiceid                     => 'invoice_id',
 645         line_item_id                  => undef,                    # EDIFACT related
 646         listprice                     => 'list_price',
 647         order_internalnote            => 'internal_note',
 648         order_vendornote              => 'vendor_note',
 649         ordernumber                   => 'order_id',
 650         orderstatus                   => 'status',
 651         parent_ordernumber            => 'parent_order_id',
 652         purchaseordernumber           => undef,                    # obsolete
 653         quantityreceived              => 'quantity_received',
 654         replacementprice              => 'replacement_price',
 655         sort1                         => 'statistics_1',
 656         sort1_authcat                 => 'statistics_1_authcat',
 657         sort2                         => 'statistics_2',
 658         sort2_authcat                 => 'statistics_2_authcat',
 659         subscriptionid                => 'subscription_id',
 660         suppliers_reference_number    => undef,                    # EDIFACT related
 661         suppliers_reference_qualifier => undef,                    # EDIFACT related
 662         suppliers_report              => undef,                    # EDIFACT related
 663         tax_rate_bak                  => undef,                    # unused
 664         tax_value_bak                 => undef,                    # unused
 665         uncertainprice                => 'uncertain_price',
 666         unitprice                     => 'unit_price',
 667         unitprice_tax_excluded        => 'unit_price_tax_excluded',
 668         unitprice_tax_included        => 'unit_price_tax_included',
 669         invoice_unitprice             => 'invoice_unit_price',
 670     };
 671 }
 672
 673 =head2 Internal methods
 674
 675 =head3 _type
 676
 677 =cut
 678
 679 sub _type {
 680     return 'Aqorder';
 681 }
 682
 683 1;