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 use Try::Tiny;
  22
  23 use C4::Biblio qw(DelBiblio);
  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 output_pref );
  31 use Koha::Exceptions::Object;
  32 use Koha::Biblios;
  33 use Koha::Holds;
  34 use Koha::Items;
  35 use Koha::Subscriptions;
  36
  37 use base qw(Koha::Object);
  38
  39 =head1 NAME
  40
  41 Koha::Acquisition::Order Object class
  42
  43 =head1 API
  44
  45 =head2 Class methods
  46
  47 =head3 new
  48
  49 Overloaded I<new> method for backwards compatibility.
  50
  51 =cut
  52
  53 sub new {
  54     my ( $self, $params ) = @_;
  55
  56     my $schema  = Koha::Database->new->schema;
  57     my @columns = $schema->source('Aqorder')->columns;
  58
  59     my $values =
  60       { map { exists $params->{$_} ? ( $_ => $params->{$_} ) : () } @columns };
  61     return $self->SUPER::new($values);
  62 }
  63
  64 =head3 store
  65
  66 Overloaded I<store> method for backwards compatibility.
  67
  68 =cut
  69
  70 sub store {
  71     my ($self) = @_;
  72
  73     my $schema  = Koha::Database->new->schema;
  74     # Override quantity for standing orders
  75     $self->quantity(1) if ( $self->basketno && $schema->resultset('Aqbasket')->find( $self->basketno )->is_standing );
  76
  77     # if these parameters are missing, we can't continue
  78     for my $key (qw( basketno quantity biblionumber budget_id )) {
  79         croak "Cannot insert order: Mandatory parameter $key is missing"
  80           unless $self->$key;
  81     }
  82
  83     if (not defined $self->{created_by}) {
  84         my $userenv = C4::Context->userenv;
  85         if ($userenv) {
  86             $self->created_by($userenv->{number});
  87         }
  88     }
  89
  90     $self->quantityreceived(0) unless $self->quantityreceived;
  91     $self->entrydate(dt_from_string) unless $self->entrydate;
  92
  93     $self->ordernumber(undef) unless $self->ordernumber;
  94     $self = $self->SUPER::store( $self );
  95
  96     unless ( $self->parent_ordernumber ) {
  97         $self->set( { parent_ordernumber => $self->ordernumber } );
  98         $self = $self->SUPER::store( $self );
  99     }
 100
 101     return $self;
 102 }
 103
 104 =head3 cancel
 105
 106     $order->cancel(
 107         { [ reason        => $reason,
 108             delete_biblio => $delete_biblio ]
 109         }
 110     );
 111
 112 This method marks an order as cancelled, optionally using the I<reason> parameter.
 113 As the order is cancelled, the (eventual) items linked to it are removed.
 114 If I<delete_biblio> is passed, it will try to remove the linked biblio.
 115
 116 If either the items or biblio removal fails, an error message is added to the object
 117 so the caller can take appropriate actions.
 118
 119 =cut
 120
 121 sub cancel {
 122     my ($self, $params) = @_;
 123
 124     my $delete_biblio = $params->{delete_biblio};
 125     my $reason        = $params->{reason};
 126
 127     # Delete the related items
 128     my $items = $self->items;
 129     while ( my $item = $items->next ) {
 130         my $safe_to_delete = $item->safe_to_delete;
 131         if ( $safe_to_delete eq '1' ) {
 132             $item->safe_delete;
 133         }
 134         else {
 135             $self->add_message(
 136                 {
 137                     message => 'error_delitem',
 138                     payload => { item => $item, reason => $safe_to_delete }
 139                 }
 140             );
 141         }
 142     }
 143
 144     my $biblio = $self->biblio;
 145     if ( $biblio and $delete_biblio ) {
 146
 147         if (
 148             $biblio->active_orders->search(
 149                 { ordernumber => { '!=' => $self->ordernumber } }
 150             )->count == 0
 151             and $biblio->subscriptions->count == 0
 152             and $biblio->items->count == 0
 153             )
 154         {
 155
 156             my $error = DelBiblio( $biblio->id );
 157             $self->add_message(
 158                 {
 159                     message => 'error_delbiblio',
 160                     payload => { biblio => $biblio, reason => $error }
 161                 }
 162             ) if $error;
 163         }
 164         else {
 165
 166             my $message;
 167
 168             if ( $biblio->active_orders->search(
 169                 { ordernumber => { '!=' => $self->ordernumber } }
 170             )->count > 0 ) {
 171                 $message = 'error_delbiblio_active_orders';
 172             }
 173             elsif ( $biblio->subscriptions->count > 0 ) {
 174                 $message = 'error_delbiblio_subscriptions';
 175             }
 176             else { # $biblio->items->count > 0
 177                 $message = 'error_delbiblio_items';
 178             }
 179
 180             $self->add_message(
 181                 {
 182                     message => $message,
 183                     payload => { biblio => $biblio }
 184                 }
 185             );
 186         }
 187     }
 188
 189     # Update order status
 190     $self->set(
 191         {
 192             cancellationreason      => $reason,
 193             datecancellationprinted => \'NOW()',
 194             orderstatus             => 'cancelled',
 195         }
 196     )->store;
 197
 198     return $self;
 199 }
 200
 201 =head3 add_item
 202
 203   $order->add_item( $itemnumber );
 204
 205 Link an item to this order.
 206
 207 =cut
 208
 209 sub add_item {
 210     my ( $self, $itemnumber )  = @_;
 211
 212     my $schema = Koha::Database->new->schema;
 213     my $rs = $schema->resultset('AqordersItem');
 214     $rs->create({ ordernumber => $self->ordernumber, itemnumber => $itemnumber });
 215 }
 216
 217 =head3 basket
 218
 219     my $basket = $order->basket;
 220
 221 Returns the I<Koha::Acquisition::Basket> object for the basket associated
 222 to the order.
 223
 224 =cut
 225
 226 sub basket {
 227     my ( $self )  = @_;
 228     my $basket_rs = $self->_result->basket;
 229     return Koha::Acquisition::Basket->_new_from_dbic( $basket_rs );
 230 }
 231
 232 =head3 fund
 233
 234     my $fund = $order->fund;
 235
 236 Returns the I<Koha::Acquisition::Fund> object for the fund (aqbudgets)
 237 associated to the order.
 238
 239 =cut
 240
 241 sub fund {
 242     my ( $self )  = @_;
 243     my $fund_rs = $self->_result->fund;
 244     return Koha::Acquisition::Fund->_new_from_dbic( $fund_rs );
 245 }
 246
 247 =head3 invoice
 248
 249     my $invoice = $order->invoice;
 250
 251 Returns the I<Koha::Acquisition::Invoice> object for the invoice associated
 252 to the order.
 253
 254 It returns B<undef> if no linked invoice is found.
 255
 256 =cut
 257
 258 sub invoice {
 259     my ( $self )  = @_;
 260     my $invoice_rs = $self->_result->invoice;
 261     return unless $invoice_rs;
 262     return Koha::Acquisition::Invoice->_new_from_dbic( $invoice_rs );
 263 }
 264
 265 =head3 subscription
 266
 267     my $subscription = $order->subscription
 268
 269 Returns the I<Koha::Subscription> object for the subscription associated
 270 to the order.
 271
 272 It returns B<undef> if no linked subscription is found.
 273
 274 =cut
 275
 276 sub subscription {
 277     my ( $self )  = @_;
 278     my $subscription_rs = $self->_result->subscription;
 279     return unless $subscription_rs;
 280     return Koha::Subscription->_new_from_dbic( $subscription_rs );
 281 }
 282
 283 =head3 current_item_level_holds
 284
 285     my $holds = $order->current_item_level_holds;
 286
 287 Returns the current item-level holds associated to the order. It returns a I<Koha::Holds>
 288 resultset.
 289
 290 =cut
 291
 292 sub current_item_level_holds {
 293     my ($self) = @_;
 294
 295     my $items_rs     = $self->_result->aqorders_items;
 296     my @item_numbers = $items_rs->get_column('itemnumber')->all;
 297     my $biblio       = $self->biblio;
 298
 299     unless ( $biblio and @item_numbers ) {
 300         return Koha::Holds->new->empty;
 301     }
 302
 303     return $biblio->current_holds->search(
 304         {
 305             itemnumber => {
 306                 -in => \@item_numbers
 307             }
 308         }
 309     );
 310 }
 311
 312 =head3 items
 313
 314     my $items = $order->items
 315
 316 Returns the items associated to the order.
 317
 318 =cut
 319
 320 sub items {
 321     my ( $self )  = @_;
 322     # aqorders_items is not a join table
 323     # There is no FK on items (may have been deleted)
 324     my $items_rs = $self->_result->aqorders_items;
 325     my @itemnumbers = $items_rs->get_column( 'itemnumber' )->all;
 326     return Koha::Items->search({ itemnumber => \@itemnumbers });
 327 }
 328
 329 =head3 biblio
 330
 331     my $biblio = $order->biblio
 332
 333 Returns the bibliographic record associated to the order
 334
 335 =cut
 336
 337 sub biblio {
 338     my ( $self ) = @_;
 339     my $biblio_rs= $self->_result->biblio;
 340     return unless $biblio_rs;
 341     return Koha::Biblio->_new_from_dbic( $biblio_rs );
 342 }
 343
 344 =head3 claims
 345
 346     my $claims = $order->claims
 347
 348 Return the claims history for this order
 349
 350 =cut
 351
 352 sub claims {
 353     my ( $self ) = @_;
 354     my $claims_rs = $self->_result->aqorders_claims;
 355     return Koha::Acquisition::Order::Claims->_new_from_dbic( $claims_rs );
 356 }
 357
 358 =head3 claim
 359
 360     my $claim = $order->claim
 361
 362 Do claim for this order
 363
 364 =cut
 365
 366 sub claim {
 367     my ( $self ) = @_;
 368     my $claim_rs = $self->_result->create_related('aqorders_claims', {});
 369     return Koha::Acquisition::Order::Claim->_new_from_dbic($claim_rs);
 370 }
 371
 372 =head3 claims_count
 373
 374 my $nb_of_claims = $order->claims_count;
 375
 376 This is the equivalent of $order->claims->count. Keeping it for retrocompatibilty.
 377
 378 =cut
 379
 380 sub claims_count {
 381     my ( $self ) = @_;
 382     return $self->claims->count;
 383 }
 384
 385 =head3 claimed_date
 386
 387 my $last_claim_date = $order->claimed_date;
 388
 389 This is the equivalent of $order->claims->last->claimed_on. Keeping it for retrocompatibilty.
 390
 391 =cut
 392
 393 sub claimed_date {
 394     my ( $self ) = @_;
 395     my $last_claim = $self->claims->last;
 396     return unless $last_claim;
 397     return $last_claim->claimed_on;
 398 }
 399
 400 =head3 duplicate_to
 401
 402     my $duplicated_order = $order->duplicate_to($basket, [$default_values]);
 403
 404 Duplicate an existing order and attach it to a basket. $default_values can be specified as a hashref
 405 that contain default values for the different order's attributes.
 406 Items will be duplicated as well but barcodes will be set to null.
 407
 408 =cut
 409
 410 sub duplicate_to {
 411     my ( $self, $basket, $default_values ) = @_;
 412     my $new_order;
 413     $default_values //= {};
 414     Koha::Database->schema->txn_do(
 415         sub {
 416             my $order_info = $self->unblessed;
 417             undef $order_info->{ordernumber};
 418             for my $field (
 419                 qw(
 420                 ordernumber
 421                 received_on
 422                 datereceived
 423                 invoiceid
 424                 datecancellationprinted
 425                 cancellationreason
 426                 purchaseordernumber
 427                 claims_count
 428                 claimed_date
 429                 parent_ordernumber
 430                 )
 431               )
 432             {
 433                 undef $order_info->{$field};
 434             }
 435             $order_info->{placed_on}        = dt_from_string;
 436             $order_info->{entrydate}        = dt_from_string;
 437             $order_info->{orderstatus}      = 'new';
 438             $order_info->{quantityreceived} = 0;
 439             while ( my ( $field, $value ) = each %$default_values ) {
 440                 $order_info->{$field} = $value;
 441             }
 442
 443             my $userenv = C4::Context->userenv;
 444             $order_info->{created_by} = $userenv->{number};
 445             $order_info->{basketno} = $basket->basketno;
 446
 447             $new_order = Koha::Acquisition::Order->new($order_info)->store;
 448
 449             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
 450                 my $items = $self->items;
 451                 while ( my ($item) = $items->next ) {
 452                     my $item_info = $item->unblessed;
 453                     undef $item_info->{itemnumber};
 454                     undef $item_info->{barcode};
 455                     my $new_item = Koha::Item->new($item_info)->store;
 456                     $new_order->add_item( $new_item->itemnumber );
 457                 }
 458             }
 459         }
 460     );
 461     return $new_order;
 462 }
 463
 464 =head3 to_api_mapping
 465
 466 This method returns the mapping for representing a Koha::Acquisition::Order object
 467 on the API.
 468
 469 =cut
 470
 471 sub to_api_mapping {
 472     return {
 473         basketno                      => 'basket_id',
 474         biblionumber                  => 'biblio_id',
 475         budget_id                     => 'fund_id',
 476         budgetdate                    => undef,                    # unused
 477         cancellationreason            => 'cancellation_reason',
 478         claimed_date                  => 'last_claim_date',
 479         datecancellationprinted       => 'cancellation_date',
 480         datereceived                  => 'date_received',
 481         discount                      => 'discount_rate',
 482         entrydate                     => 'entry_date',
 483         freight                       => 'shipping_cost',
 484         invoiceid                     => 'invoice_id',
 485         line_item_id                  => undef,                    # EDIFACT related
 486         listprice                     => 'list_price',
 487         order_internalnote            => 'internal_note',
 488         order_vendornote              => 'vendor_note',
 489         ordernumber                   => 'order_id',
 490         orderstatus                   => 'status',
 491         parent_ordernumber            => 'parent_order_id',
 492         purchaseordernumber           => undef,                    # obsolete
 493         quantityreceived              => 'quantity_received',
 494         replacementprice              => 'replacement_price',
 495         sort1                         => 'statistics_1',
 496         sort1_authcat                 => 'statistics_1_authcat',
 497         sort2                         => 'statistics_2',
 498         sort2_authcat                 => 'statistics_2_authcat',
 499         subscriptionid                => 'subscription_id',
 500         suppliers_reference_number    => undef,                    # EDIFACT related
 501         suppliers_reference_qualifier => undef,                    # EDIFACT related
 502         suppliers_report              => undef,                    # EDIFACT related
 503         tax_rate_bak                  => undef,                    # unused
 504         tax_value_bak                 => undef,                    # unused
 505         uncertainprice                => 'uncertain_price',
 506         unitprice                     => 'unit_price',
 507         unitprice_tax_excluded        => 'unit_price_tax_excluded',
 508         unitprice_tax_included        => 'unit_price_tax_included'
 509     };
 510 }
 511
 512 =head2 Internal methods
 513
 514 =head3 _type
 515
 516 =cut
 517
 518 sub _type {
 519     return 'Aqorder';
 520 }
 521
 522 1;