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