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