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