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