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