Bug 22521: DBRev 18.12.00.055
[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 under the
6 # terms of the GNU General Public License as published by the Free Software
7 # Foundation; either version 3 of the License, or (at your option) any later
8 # version.
9 #
10 # Koha is distributed in the hope that it will be useful, but WITHOUT ANY
11 # WARRANTY; without even the implied warranty of MERCHANTABILITY or FITNESS FOR
12 # A PARTICULAR PURPOSE.  See the GNU General Public License for more details.
13 #
14 # You should have received a copy of the GNU General Public License along
15 # with Koha; if not, write to the Free Software Foundation, Inc.,
16 # 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301 USA.
17
18 use Modern::Perl;
19
20 use Carp qw( croak );
21
22 use Koha::Acquisition::Baskets;
23 use Koha::Acquisition::Funds;
24 use Koha::Acquisition::Invoices;
25 use Koha::Database;
26 use Koha::DateUtils qw( dt_from_string output_pref );
27 use Koha::Biblios;
28 use Koha::Items;
29 use Koha::Subscriptions;
30
31 use base qw(Koha::Object);
32
33 =head1 NAME
34
35 Koha::Acquisition::Order Object class
36
37 =head1 API
38
39 =head2 Class methods
40
41 =head3 new
42
43 Overloaded I<new> method for backwards compatibility.
44
45 =cut
46
47 sub new {
48     my ( $self, $params ) = @_;
49
50     my $schema  = Koha::Database->new->schema;
51     my @columns = $schema->source('Aqorder')->columns;
52
53     my $values =
54       { map { exists $params->{$_} ? ( $_ => $params->{$_} ) : () } @columns };
55     return $self->SUPER::new($values);
56 }
57
58 =head3 store
59
60 Overloaded I<store> method for backwards compatibility.
61
62 =cut
63
64 sub store {
65     my ($self) = @_;
66
67     my $schema  = Koha::Database->new->schema;
68     # Override quantity for standing orders
69     $self->quantity(1) if ( $self->basketno && $schema->resultset('Aqbasket')->find( $self->basketno )->is_standing );
70
71     # if these parameters are missing, we can't continue
72     for my $key (qw( basketno quantity biblionumber budget_id )) {
73         croak "Cannot insert order: Mandatory parameter $key is missing"
74           unless $self->$key;
75     }
76
77     if (not defined $self->{created_by}) {
78         my $userenv = C4::Context->userenv;
79         if ($userenv) {
80             $self->created_by($userenv->{number});
81         }
82     }
83
84     $self->quantityreceived(0) unless $self->quantityreceived;
85     $self->entrydate(dt_from_string) unless $self->entrydate;
86
87     $self->ordernumber(undef) unless $self->ordernumber;
88     $self = $self->SUPER::store( $self );
89
90     unless ( $self->parent_ordernumber ) {
91         $self->set( { parent_ordernumber => $self->ordernumber } );
92         $self = $self->SUPER::store( $self );
93     }
94
95     return $self;
96 }
97
98 =head3 add_item
99
100   $order->add_item( $itemnumber );
101
102 Link an item to this order.
103
104 =cut
105
106 sub add_item {
107     my ( $self, $itemnumber )  = @_;
108
109     my $schema = Koha::Database->new->schema;
110     my $rs = $schema->resultset('AqordersItem');
111     $rs->create({ ordernumber => $self->ordernumber, itemnumber => $itemnumber });
112 }
113
114 =head3 basket
115
116     my $basket = Koha::Acquisition::Orders->find( $id )->basket;
117
118 Returns the basket associated to the order.
119
120 =cut
121
122 sub basket {
123     my ( $self )  = @_;
124     my $basket_rs = $self->_result->basketno;
125     return Koha::Acquisition::Basket->_new_from_dbic( $basket_rs );
126 }
127
128 =head3 fund
129
130     my $fund = $order->fund
131
132 Returns the fund (aqbudgets) associated to the order.
133
134 =cut
135
136 sub fund {
137     my ( $self )  = @_;
138     my $fund_rs = $self->_result->budget;
139     return Koha::Acquisition::Fund->_new_from_dbic( $fund_rs );
140 }
141
142 =head3 invoice
143
144     my $invoice = $order->invoice
145
146 Returns the invoice associated to the order.
147
148 =cut
149
150 sub invoice {
151     my ( $self )  = @_;
152     my $invoice_rs = $self->_result->invoiceid;
153     return unless $invoice_rs;
154     return Koha::Acquisition::Invoice->_new_from_dbic( $invoice_rs );
155 }
156
157 =head3 subscription
158
159     my $subscription = $order->subscription
160
161 Returns the subscription associated to the order.
162
163 =cut
164
165 sub subscription {
166     my ( $self )  = @_;
167     my $subscription_rs = $self->_result->subscriptionid;
168     return unless $subscription_rs;
169     return Koha::Subscription->_new_from_dbic( $subscription_rs );
170 }
171
172 =head3 items
173
174     my $items = $order->items
175
176 Returns the items associated to the order.
177
178 =cut
179
180 sub items {
181     my ( $self )  = @_;
182     # aqorders_items is not a join table
183     # There is no FK on items (may have been deleted)
184     my $items_rs = $self->_result->aqorders_items;
185     my @itemnumbers = $items_rs->get_column( 'itemnumber' )->all;
186     return Koha::Items->search({ itemnumber => \@itemnumbers });
187 }
188
189 =head3 biblio
190
191     my $biblio = $order->biblio
192
193 Returns the bibliographic record associated to the order
194
195 =cut
196
197 sub biblio {
198     my ( $self ) = @_;
199     my $biblio_rs= $self->_result->biblionumber;
200     return Koha::Biblio->_new_from_dbic( $biblio_rs );
201 }
202
203 =head3 duplicate_to
204
205     my $duplicated_order = $order->duplicate_to($basket, [$default_values]);
206
207 Duplicate an existing order and attach it to a basket. $default_values can be specified as a hashref
208 that contain default values for the different order's attributes.
209 Items will be duplicated as well but barcodes will be set to null.
210
211 =cut
212
213 sub duplicate_to {
214     my ( $self, $basket, $default_values ) = @_;
215     my $new_order;
216     $default_values //= {};
217     Koha::Database->schema->txn_do(
218         sub {
219             my $order_info = $self->unblessed;
220             undef $order_info->{ordernumber};
221             for my $field (
222                 qw(
223                 ordernumber
224                 received_on
225                 datereceived
226                 datecancellationprinted
227                 cancellationreason
228                 purchaseordernumber
229                 claims_count
230                 claimed_date
231                 parent_ordernumber
232                 )
233               )
234             {
235                 undef $order_info->{$field};
236             }
237             $order_info->{placed_on}        = dt_from_string;
238             $order_info->{entrydate}        = dt_from_string;
239             $order_info->{orderstatus}      = 'new';
240             $order_info->{quantityreceived} = 0;
241             while ( my ( $field, $value ) = each %$default_values ) {
242                 $order_info->{$field} = $value;
243             }
244
245             my $userenv = C4::Context->userenv;
246             $order_info->{created_by} = $userenv->{number};
247             $order_info->{basketno} = $basket->basketno;
248
249             $new_order = Koha::Acquisition::Order->new($order_info)->store;
250
251             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
252                 my $items = $self->items;
253                 while ( my ($item) = $items->next ) {
254                     my $item_info = $item->unblessed;
255                     undef $item_info->{itemnumber};
256                     undef $item_info->{barcode};
257                     my $new_item = Koha::Item->new($item_info)->store;
258                     $new_order->add_item( $new_item->itemnumber );
259                 }
260             }
261         }
262     );
263     return $new_order;
264 }
265
266
267 =head2 Internal methods
268
269 =head3 _type
270
271 =cut
272
273 sub _type {
274     return 'Aqorder';
275 }
276
277 1;