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     try {
 128         # Delete the related items
 129         $self->items->safe_delete;
 130
 131         my $biblio = $self->biblio;
 132         if ( $biblio and $delete_biblio ) {
 133
 134             if (    $biblio->active_orders->count - 1 == 0 # minus ourself
 135                 and $biblio->subscriptions->count == 0
 136                 and $biblio->items->count == 0 )
 137             {
 138
 139                 my $error = DelBiblio( $biblio->id );
 140                 $self->add_message({ message => 'error_delbiblio', error => $error })
 141                   if $error;
 142             }
 143             else {
 144                 $self->add_message({ message => 'error_delbiblio' });
 145             }
 146         }
 147     }
 148     catch {
 149         if ( ref($_) eq 'Koha::Exceptions::Object::CannotBeDeleted' ) {
 150             my $object = $_->object;
 151             if ( ref($object) eq 'Koha::Item' ) {
 152                 $self->add_message({ message => 'error_delitem' });
 153             }
 154         }
 155     };
 156
 157     # Update order status
 158     $self->set(
 159         {
 160             cancellationreason      => $reason,
 161             datecancellationprinted => \'NOW()',
 162             orderstatus             => 'cancelled',
 163         }
 164     )->store;
 165
 166     return $self;
 167 }
 168
 169 =head3 add_item
 170
 171   $order->add_item( $itemnumber );
 172
 173 Link an item to this order.
 174
 175 =cut
 176
 177 sub add_item {
 178     my ( $self, $itemnumber )  = @_;
 179
 180     my $schema = Koha::Database->new->schema;
 181     my $rs = $schema->resultset('AqordersItem');
 182     $rs->create({ ordernumber => $self->ordernumber, itemnumber => $itemnumber });
 183 }
 184
 185 =head3 basket
 186
 187     my $basket = $order->basket;
 188
 189 Returns the I<Koha::Acquisition::Basket> object for the basket associated
 190 to the order.
 191
 192 =cut
 193
 194 sub basket {
 195     my ( $self )  = @_;
 196     my $basket_rs = $self->_result->basket;
 197     return Koha::Acquisition::Basket->_new_from_dbic( $basket_rs );
 198 }
 199
 200 =head3 fund
 201
 202     my $fund = $order->fund;
 203
 204 Returns the I<Koha::Acquisition::Fund> object for the fund (aqbudgets)
 205 associated to the order.
 206
 207 =cut
 208
 209 sub fund {
 210     my ( $self )  = @_;
 211     my $fund_rs = $self->_result->fund;
 212     return Koha::Acquisition::Fund->_new_from_dbic( $fund_rs );
 213 }
 214
 215 =head3 invoice
 216
 217     my $invoice = $order->invoice;
 218
 219 Returns the I<Koha::Acquisition::Invoice> object for the invoice associated
 220 to the order.
 221
 222 It returns B<undef> if no linked invoice is found.
 223
 224 =cut
 225
 226 sub invoice {
 227     my ( $self )  = @_;
 228     my $invoice_rs = $self->_result->invoice;
 229     return unless $invoice_rs;
 230     return Koha::Acquisition::Invoice->_new_from_dbic( $invoice_rs );
 231 }
 232
 233 =head3 subscription
 234
 235     my $subscription = $order->subscription
 236
 237 Returns the I<Koha::Subscription> object for the subscription associated
 238 to the order.
 239
 240 It returns B<undef> if no linked subscription is found.
 241
 242 =cut
 243
 244 sub subscription {
 245     my ( $self )  = @_;
 246     my $subscription_rs = $self->_result->subscription;
 247     return unless $subscription_rs;
 248     return Koha::Subscription->_new_from_dbic( $subscription_rs );
 249 }
 250
 251 =head3 current_item_level_holds
 252
 253     my $holds = $order->current_item_level_holds;
 254
 255 Returns the current item-level holds associated to the order. It returns a I<Koha::Holds>
 256 resultset.
 257
 258 =cut
 259
 260 sub current_item_level_holds {
 261     my ($self) = @_;
 262
 263     my $items_rs     = $self->_result->aqorders_items;
 264     my @item_numbers = $items_rs->get_column('itemnumber')->all;
 265     my $biblio       = $self->biblio;
 266
 267     unless ( $biblio and @item_numbers ) {
 268         return Koha::Holds->new->empty;
 269     }
 270
 271     return $biblio->current_holds->search(
 272         {
 273             itemnumber => {
 274                 -in => \@item_numbers
 275             }
 276         }
 277     );
 278 }
 279
 280 =head3 items
 281
 282     my $items = $order->items
 283
 284 Returns the items associated to the order.
 285
 286 =cut
 287
 288 sub items {
 289     my ( $self )  = @_;
 290     # aqorders_items is not a join table
 291     # There is no FK on items (may have been deleted)
 292     my $items_rs = $self->_result->aqorders_items;
 293     my @itemnumbers = $items_rs->get_column( 'itemnumber' )->all;
 294     return Koha::Items->search({ itemnumber => \@itemnumbers });
 295 }
 296
 297 =head3 biblio
 298
 299     my $biblio = $order->biblio
 300
 301 Returns the bibliographic record associated to the order
 302
 303 =cut
 304
 305 sub biblio {
 306     my ( $self ) = @_;
 307     my $biblio_rs= $self->_result->biblio;
 308     return unless $biblio_rs;
 309     return Koha::Biblio->_new_from_dbic( $biblio_rs );
 310 }
 311
 312 =head3 claims
 313
 314     my $claims = $order->claims
 315
 316 Return the claims history for this order
 317
 318 =cut
 319
 320 sub claims {
 321     my ( $self ) = @_;
 322     my $claims_rs = $self->_result->aqorders_claims;
 323     return Koha::Acquisition::Order::Claims->_new_from_dbic( $claims_rs );
 324 }
 325
 326 =head3 claim
 327
 328     my $claim = $order->claim
 329
 330 Do claim for this order
 331
 332 =cut
 333
 334 sub claim {
 335     my ( $self ) = @_;
 336     my $claim_rs = $self->_result->create_related('aqorders_claims', {});
 337     return Koha::Acquisition::Order::Claim->_new_from_dbic($claim_rs);
 338 }
 339
 340 =head3 claims_count
 341
 342 my $nb_of_claims = $order->claims_count;
 343
 344 This is the equivalent of $order->claims->count. Keeping it for retrocompatibilty.
 345
 346 =cut
 347
 348 sub claims_count {
 349     my ( $self ) = @_;
 350     return $self->claims->count;
 351 }
 352
 353 =head3 claimed_date
 354
 355 my $last_claim_date = $order->claimed_date;
 356
 357 This is the equivalent of $order->claims->last->claimed_on. Keeping it for retrocompatibilty.
 358
 359 =cut
 360
 361 sub claimed_date {
 362     my ( $self ) = @_;
 363     my $last_claim = $self->claims->last;
 364     return unless $last_claim;
 365     return $last_claim->claimed_on;
 366 }
 367
 368 =head3 duplicate_to
 369
 370     my $duplicated_order = $order->duplicate_to($basket, [$default_values]);
 371
 372 Duplicate an existing order and attach it to a basket. $default_values can be specified as a hashref
 373 that contain default values for the different order's attributes.
 374 Items will be duplicated as well but barcodes will be set to null.
 375
 376 =cut
 377
 378 sub duplicate_to {
 379     my ( $self, $basket, $default_values ) = @_;
 380     my $new_order;
 381     $default_values //= {};
 382     Koha::Database->schema->txn_do(
 383         sub {
 384             my $order_info = $self->unblessed;
 385             undef $order_info->{ordernumber};
 386             for my $field (
 387                 qw(
 388                 ordernumber
 389                 received_on
 390                 datereceived
 391                 invoiceid
 392                 datecancellationprinted
 393                 cancellationreason
 394                 purchaseordernumber
 395                 claims_count
 396                 claimed_date
 397                 parent_ordernumber
 398                 )
 399               )
 400             {
 401                 undef $order_info->{$field};
 402             }
 403             $order_info->{placed_on}        = dt_from_string;
 404             $order_info->{entrydate}        = dt_from_string;
 405             $order_info->{orderstatus}      = 'new';
 406             $order_info->{quantityreceived} = 0;
 407             while ( my ( $field, $value ) = each %$default_values ) {
 408                 $order_info->{$field} = $value;
 409             }
 410
 411             my $userenv = C4::Context->userenv;
 412             $order_info->{created_by} = $userenv->{number};
 413             $order_info->{basketno} = $basket->basketno;
 414
 415             $new_order = Koha::Acquisition::Order->new($order_info)->store;
 416
 417             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
 418                 my $items = $self->items;
 419                 while ( my ($item) = $items->next ) {
 420                     my $item_info = $item->unblessed;
 421                     undef $item_info->{itemnumber};
 422                     undef $item_info->{barcode};
 423                     my $new_item = Koha::Item->new($item_info)->store;
 424                     $new_order->add_item( $new_item->itemnumber );
 425                 }
 426             }
 427         }
 428     );
 429     return $new_order;
 430 }
 431
 432 =head3 to_api_mapping
 433
 434 This method returns the mapping for representing a Koha::Acquisition::Order object
 435 on the API.
 436
 437 =cut
 438
 439 sub to_api_mapping {
 440     return {
 441         basketno                      => 'basket_id',
 442         biblionumber                  => 'biblio_id',
 443         budget_id                     => 'fund_id',
 444         budgetdate                    => undef,                    # unused
 445         cancellationreason            => 'cancellation_reason',
 446         claimed_date                  => 'last_claim_date',
 447         datecancellationprinted       => 'cancellation_date',
 448         datereceived                  => 'date_received',
 449         discount                      => 'discount_rate',
 450         entrydate                     => 'entry_date',
 451         freight                       => 'shipping_cost',
 452         invoiceid                     => 'invoice_id',
 453         line_item_id                  => undef,                    # EDIFACT related
 454         listprice                     => 'list_price',
 455         order_internalnote            => 'internal_note',
 456         order_vendornote              => 'vendor_note',
 457         ordernumber                   => 'order_id',
 458         orderstatus                   => 'status',
 459         parent_ordernumber            => 'parent_order_id',
 460         purchaseordernumber           => undef,                    # obsolete
 461         quantityreceived              => 'quantity_received',
 462         replacementprice              => 'replacement_price',
 463         sort1                         => 'statistics_1',
 464         sort1_authcat                 => 'statistics_1_authcat',
 465         sort2                         => 'statistics_2',
 466         sort2_authcat                 => 'statistics_2_authcat',
 467         subscriptionid                => 'subscription_id',
 468         suppliers_reference_number    => undef,                    # EDIFACT related
 469         suppliers_reference_qualifier => undef,                    # EDIFACT related
 470         suppliers_report              => undef,                    # EDIFACT related
 471         tax_rate_bak                  => undef,                    # unused
 472         tax_value_bak                 => undef,                    # unused
 473         uncertainprice                => 'uncertain_price',
 474         unitprice                     => 'unit_price',
 475         unitprice_tax_excluded        => 'unit_price_tax_excluded',
 476         unitprice_tax_included        => 'unit_price_tax_included'
 477     };
 478 }
 479
 480 =head2 Internal methods
 481
 482 =head3 _type
 483
 484 =cut
 485
 486 sub _type {
 487     return 'Aqorder';
 488 }
 489
 490 1;