Bug 26515: Don't need to call safe_to_delete
[koha.git] / Koha / Acquisition / Order.pm
blob07dea689390f3c9ff3ce3166ff25f3e436d57b6e
1 package Koha::Acquisition::Order;
3 # This file is part of Koha.
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.
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.
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>.
18 use Modern::Perl;
20 use Carp qw( croak );
21 use Try::Tiny;
23 use C4::Biblio qw(DelBiblio);
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;
37 use base qw(Koha::Object);
39 =head1 NAME
41 Koha::Acquisition::Order Object class
43 =head1 API
45 =head2 Class methods
47 =head3 new
49 Overloaded I<new> method for backwards compatibility.
51 =cut
53 sub new {
54 my ( $self, $params ) = @_;
56 my $schema = Koha::Database->new->schema;
57 my @columns = $schema->source('Aqorder')->columns;
59 my $values =
60 { map { exists $params->{$_} ? ( $_ => $params->{$_} ) : () } @columns };
61 return $self->SUPER::new($values);
64 =head3 store
66 Overloaded I<store> method for backwards compatibility.
68 =cut
70 sub store {
71 my ($self) = @_;
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 );
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;
83 if (not defined $self->{created_by}) {
84 my $userenv = C4::Context->userenv;
85 if ($userenv) {
86 $self->created_by($userenv->{number});
90 $self->quantityreceived(0) unless $self->quantityreceived;
91 $self->entrydate(dt_from_string) unless $self->entrydate;
93 $self->ordernumber(undef) unless $self->ordernumber;
94 $self = $self->SUPER::store( $self );
96 unless ( $self->parent_ordernumber ) {
97 $self->set( { parent_ordernumber => $self->ordernumber } );
98 $self = $self->SUPER::store( $self );
101 return $self;
104 =head3 cancel
106 $order->cancel(
107 { [ reason => $reason,
108 delete_biblio => $delete_biblio ]
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.
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.
119 =cut
121 sub cancel {
122 my ($self, $params) = @_;
124 my $delete_biblio = $params->{delete_biblio};
125 my $reason = $params->{reason};
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(
134 message => 'error_delitem',
135 payload => { item => $item, reason => $deleted }
141 my $biblio = $self->biblio;
142 if ( $biblio and $delete_biblio ) {
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
153 my $error = DelBiblio( $biblio->id );
154 $self->add_message(
156 message => 'error_delbiblio',
157 payload => { biblio => $biblio, reason => $error }
159 ) if $error;
161 else {
163 my $message;
165 if ( $biblio->active_orders->search(
166 { ordernumber => { '!=' => $self->ordernumber } }
167 )->count > 0 ) {
168 $message = 'error_delbiblio_active_orders';
170 elsif ( $biblio->subscriptions->count > 0 ) {
171 $message = 'error_delbiblio_subscriptions';
173 else { # $biblio->items->count > 0
174 $message = 'error_delbiblio_items';
177 $self->add_message(
179 message => $message,
180 payload => { biblio => $biblio }
186 # Update order status
187 $self->set(
189 cancellationreason => $reason,
190 datecancellationprinted => \'NOW()',
191 orderstatus => 'cancelled',
193 )->store;
195 return $self;
198 =head3 add_item
200 $order->add_item( $itemnumber );
202 Link an item to this order.
204 =cut
206 sub add_item {
207 my ( $self, $itemnumber ) = @_;
209 my $schema = Koha::Database->new->schema;
210 my $rs = $schema->resultset('AqordersItem');
211 $rs->create({ ordernumber => $self->ordernumber, itemnumber => $itemnumber });
214 =head3 basket
216 my $basket = $order->basket;
218 Returns the I<Koha::Acquisition::Basket> object for the basket associated
219 to the order.
221 =cut
223 sub basket {
224 my ( $self ) = @_;
225 my $basket_rs = $self->_result->basket;
226 return Koha::Acquisition::Basket->_new_from_dbic( $basket_rs );
229 =head3 fund
231 my $fund = $order->fund;
233 Returns the I<Koha::Acquisition::Fund> object for the fund (aqbudgets)
234 associated to the order.
236 =cut
238 sub fund {
239 my ( $self ) = @_;
240 my $fund_rs = $self->_result->fund;
241 return Koha::Acquisition::Fund->_new_from_dbic( $fund_rs );
244 =head3 invoice
246 my $invoice = $order->invoice;
248 Returns the I<Koha::Acquisition::Invoice> object for the invoice associated
249 to the order.
251 It returns B<undef> if no linked invoice is found.
253 =cut
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 );
262 =head3 subscription
264 my $subscription = $order->subscription
266 Returns the I<Koha::Subscription> object for the subscription associated
267 to the order.
269 It returns B<undef> if no linked subscription is found.
271 =cut
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 );
280 =head3 current_item_level_holds
282 my $holds = $order->current_item_level_holds;
284 Returns the current item-level holds associated to the order. It returns a I<Koha::Holds>
285 resultset.
287 =cut
289 sub current_item_level_holds {
290 my ($self) = @_;
292 my $items_rs = $self->_result->aqorders_items;
293 my @item_numbers = $items_rs->get_column('itemnumber')->all;
294 my $biblio = $self->biblio;
296 unless ( $biblio and @item_numbers ) {
297 return Koha::Holds->new->empty;
300 return $biblio->current_holds->search(
302 itemnumber => {
303 -in => \@item_numbers
309 =head3 items
311 my $items = $order->items
313 Returns the items associated to the order.
315 =cut
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 });
326 =head3 biblio
328 my $biblio = $order->biblio
330 Returns the bibliographic record associated to the order
332 =cut
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 );
341 =head3 claims
343 my $claims = $order->claims
345 Return the claims history for this order
347 =cut
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 );
355 =head3 claim
357 my $claim = $order->claim
359 Do claim for this order
361 =cut
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);
369 =head3 claims_count
371 my $nb_of_claims = $order->claims_count;
373 This is the equivalent of $order->claims->count. Keeping it for retrocompatibilty.
375 =cut
377 sub claims_count {
378 my ( $self ) = @_;
379 return $self->claims->count;
382 =head3 claimed_date
384 my $last_claim_date = $order->claimed_date;
386 This is the equivalent of $order->claims->last->claimed_on. Keeping it for retrocompatibilty.
388 =cut
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;
397 =head3 duplicate_to
399 my $duplicated_order = $order->duplicate_to($basket, [$default_values]);
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.
405 =cut
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 (
417 ordernumber
418 received_on
419 datereceived
420 invoiceid
421 datecancellationprinted
422 cancellationreason
423 purchaseordernumber
424 claims_count
425 claimed_date
426 parent_ordernumber
430 undef $order_info->{$field};
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;
440 my $userenv = C4::Context->userenv;
441 $order_info->{created_by} = $userenv->{number};
442 $order_info->{basketno} = $basket->basketno;
444 $new_order = Koha::Acquisition::Order->new($order_info)->store;
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 );
458 return $new_order;
461 =head3 to_api_mapping
463 This method returns the mapping for representing a Koha::Acquisition::Order object
464 on the API.
466 =cut
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'
509 =head2 Internal methods
511 =head3 _type
513 =cut
515 sub _type {
516 return 'Aqorder';