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