Bug 23846: Add a check to the data inconsistencies script
[koha.git] / Koha / StockRotationStage.pm
1 package Koha::StockRotationStage;
2
3 # Copyright PTFS Europe 2016
4 #
5 # This file is part of Koha.
6 #
7 # Koha is free software; you can redistribute it and/or modify it under the
8 # terms of the GNU General Public License as published by the Free Software
9 # Foundation; either version 3 of the License, or (at your option) any later
10 # version.
11 #
12 # Koha is distributed in the hope that it will be useful, but WITHOUT ANY
13 # WARRANTY; without even the implied warranty of MERCHANTABILITY or FITNESS FOR
14 # A PARTICULAR PURPOSE.  See the GNU General Public License for more details.
15 #
16 # You should have received a copy of the GNU General Public License along
17 # with Koha; if not, write to the Free Software Foundation, Inc.,
18 # 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301 USA.
19
20 use Modern::Perl;
21
22 use Koha::Database;
23 use Koha::Library;
24 use Koha::StockRotationRota;
25
26 use base qw(Koha::Object);
27
28 =head1 NAME
29
30 StockRotationStage - Koha StockRotationStage Object class
31
32 =head1 SYNOPSIS
33
34 StockRotationStage class used primarily by stockrotation .pls and the stock
35 rotation cron script.
36
37 =head1 DESCRIPTION
38
39 Standard Koha::Objects definitions, and additional methods.
40
41 =head1 API
42
43 =head2 Class Methods
44
45 =cut
46
47 =head3 _type
48
49 =cut
50
51 sub _type {
52     return 'Stockrotationstage';
53 }
54
55 sub _relation {
56     my ( $self, $method, $type ) = @_;
57     return sub {
58         my $rs = $self->_result->$method;
59         return 0 if !$rs;
60         my $namespace = 'Koha::' . $type;
61         return $namespace->_new_from_dbic( $rs );
62     }
63 }
64
65 =head3 stockrotationitems
66
67   my $stages = Koha::StockRotationStage->stockrotationitems;
68
69 Returns the items associated with the current stage.
70
71 =cut
72
73 sub stockrotationitems {
74     my ( $self ) = @_;
75     return &{$self->_relation(qw/ stockrotationitems StockRotationItems /)};
76 }
77
78 =head3 branchcode
79
80   my $branch = Koha::StockRotationStage->branchcode;
81
82 Returns the branch associated with the current stage.
83
84 =cut
85
86 sub branchcode {
87     my ( $self ) = @_;
88     return &{$self->_relation(qw/ branchcode Library /)};
89 }
90
91 =head3 rota
92
93   my $rota = Koha::StockRotationStage->rota;
94
95 Returns the rota associated with the current stage.
96
97 =cut
98
99 sub rota {
100     my ( $self ) = @_;
101     return &{$self->_relation(qw/ rota StockRotationRota /)};
102 }
103
104 =head3 siblings
105
106   my $siblings = $stage->siblings;
107
108 Koha::Object wrapper around DBIx::Class::Ordered.
109
110 =cut
111
112 sub siblings {
113     my ( $self ) = @_;
114     return &{$self->_relation(qw/ siblings StockRotationStages /)};
115 }
116
117 =head3 next_siblings
118
119   my $next_siblings = $stage->next_siblings;
120
121 Koha::Object wrapper around DBIx::Class::Ordered.
122
123 =cut
124
125 sub next_siblings {
126     my ( $self ) = @_;
127     return &{$self->_relation(qw/ next_siblings StockRotationStages /)};
128 }
129
130 =head3 previous_siblings
131
132   my $previous_siblings = $stage->previous_siblings;
133
134 Koha::Object wrapper around DBIx::Class::Ordered.
135
136 =cut
137
138 sub previous_siblings {
139     my ( $self ) = @_;
140     return &{$self->_relation(qw/ previous_siblings StockRotationStages /)};
141 }
142
143 =head3 next_sibling
144
145   my $next = $stage->next_sibling;
146
147 Koha::Object wrapper around DBIx::Class::Ordered.
148
149 =cut
150
151 sub next_sibling {
152     my ( $self ) = @_;
153     return &{$self->_relation(qw/ next_sibling StockRotationStage /)};
154 }
155
156 =head3 previous_sibling
157
158   my $previous = $stage->previous_sibling;
159
160 Koha::Object Wrapper around DBIx::Class::Ordered.
161
162 =cut
163
164 sub previous_sibling {
165     my ( $self ) = @_;
166     return &{$self->_relation(qw/ previous_sibling StockRotationStage /)};
167 }
168
169 =head3 first_sibling
170
171   my $first = $stage->first_sibling;
172
173 Koha::Object Wrapper around DBIx::Class::Ordered.
174
175 =cut
176
177 sub first_sibling {
178     my ( $self ) = @_;
179     return &{$self->_relation(qw/ first_sibling StockRotationStage /)};
180 }
181
182 =head3 last_sibling
183
184   my $last = $stage->last_sibling;
185
186 Koha::Object Wrapper around DBIx::Class::Ordered.
187
188 =cut
189
190 sub last_sibling {
191     my ( $self ) = @_;
192     return &{$self->_relation(qw/ last_sibling StockRotationStage /)};
193 }
194
195 =head3 move_previous
196
197   1|0 = $stage->move_previous;
198
199 Koha::Object Wrapper around DBIx::Class::Ordered.
200
201 =cut
202
203 sub move_previous {
204     my ( $self ) = @_;
205     return $self->_result->move_previous;
206 }
207
208 =head3 move_next
209
210   1|0 = $stage->move_next;
211
212 Koha::Object Wrapper around DBIx::Class::Ordered.
213
214 =cut
215
216 sub move_next {
217     my ( $self ) = @_;
218     return $self->_result->move_next;
219 }
220
221 =head3 move_first
222
223   1|0 = $stage->move_first;
224
225 Koha::Object Wrapper around DBIx::Class::Ordered.
226
227 =cut
228
229 sub move_first {
230     my ( $self ) = @_;
231     return $self->_result->move_first;
232 }
233
234 =head3 move_last
235
236   1|0 = $stage->move_last;
237
238 Koha::Object Wrapper around DBIx::Class::Ordered.
239
240 =cut
241
242 sub move_last {
243     my ( $self ) = @_;
244     return $self->_result->move_last;
245 }
246
247 =head3 move_to
248
249   1|0 = $stage->move_to($position);
250
251 Koha::Object Wrapper around DBIx::Class::Ordered.
252
253 =cut
254
255 sub move_to {
256     my ( $self, $position ) = @_;
257     return $self->_result->move_to($position)
258         if ( $position le $self->rota->stockrotationstages->count );
259     return 0;
260 }
261
262 =head3 move_to_group
263
264   1|0 = $stage->move_to_group($rota_id, [$position]);
265
266 Koha::Object Wrapper around DBIx::Class::Ordered.
267
268 =cut
269
270 sub move_to_group {
271     my ( $self, $rota_id, $position ) = @_;
272     return $self->_result->move_to_group($rota_id, $position);
273 }
274
275 =head3 delete
276
277   1|0 = $stage->delete;
278
279 Koha::Object Wrapper around DBIx::Class::Ordered.
280
281 =cut
282
283 sub delete {
284     my ( $self ) = @_;
285     return $self->_result->delete;
286 }
287
288 =head3 investigate
289
290   my $report = $stage->investigate($report_so_far);
291
292 Return a stage based report.  This report will mutate and augment the report
293 that is passed to it.  It slots item reports into the branched and temporary
294 rota sections of the report.  It also increments a number of counters.
295
296 For details of intent and context of this procedure, please see
297 Koha::StockRotationRota->investigate.
298
299 =cut
300
301 sub investigate {
302     my ( $self, $report ) = @_;
303     my $new_stage = $self->next_sibling;
304     my $duration = $self->duration;
305     # Generate stage items report
306     my $items_report = $self->stockrotationitems->investigate;
307
308     # Merge into general report
309
310     ## Branched indexes
311     ### The branched indexes work as follows:
312     ### - They contain information about the relevant branch
313     ### - They contain an index of actionable items for that branch
314     ### - They contain an index of non-actionable items for that branch
315
316     ### Items are assigned to a particular branched index as follows:
317     ### - 'advanceable' : assigned to branch of the current stage
318     ###   (this should also be the current holding branch)
319     ### - 'log' items are always assigned to branch of current stage.
320     ### - 'indemand' : assigned to branch of current stage
321     ###   (this should also be the current holding branch)
322     ### - 'initiable' : assigned to the current holding branch of item
323     ### - 'repatriable' : assigned to the current holding branch of item
324
325     ### 'Advanceable', 'log', 'indemand':
326
327     # Set up our stage branch info.
328     my $stagebranch = $self->_result->branchcode;
329     my $stagebranchcode = $stagebranch->branchcode;
330
331     # Initiate our stage branch index if it does not yet exist.
332     if ( !$report->{branched}->{$stagebranchcode} ) {
333         $report->{branched}->{$stagebranchcode} = {
334             code  => $stagebranchcode,
335             name  => $stagebranch->branchname,
336             email => $stagebranch->branchreplyto
337               ? $stagebranch->branchreplyto
338               : $stagebranch->branchemail,
339             phone => $stagebranch->branchphone,
340             items => [],
341             log => [],
342         };
343     }
344
345     push @{$report->{branched}->{$stagebranchcode}->{items}},
346         @{$items_report->{advanceable_items}};
347     push @{$report->{branched}->{$stagebranchcode}->{log}},
348         @{$items_report->{log}};
349     push @{$report->{branched}->{$stagebranchcode}->{items}},
350         @{$items_report->{indemand_items}};
351
352     ### 'Initiable' & 'Repatriable'
353     foreach my $ireport (@{$items_report->{initiable_items}}) {
354         my $branch = $ireport->{branch};
355         my $branchcode = $branch->branchcode;
356         if ( !$report->{branched}->{$branchcode} ) {
357             $report->{branched}->{$branchcode} = {
358                 code  => $branchcode,
359                 name  => $branch->branchname,
360                 email => $stagebranch->branchreplyto
361                   ? $stagebranch->branchreplyto
362                   : $stagebranch->branchemail,
363                 phone => $branch->branchphone,
364                 items => [],
365                 log => [],
366             };
367         }
368         push @{$report->{branched}->{$branchcode}->{items}}, $ireport;
369     }
370
371     foreach my $ireport (@{$items_report->{repatriable_items}}) {
372         my $branch = $ireport->{branch};
373         my $branchcode = $branch->branchcode;
374         if ( !$report->{branched}->{$branchcode} ) {
375             $report->{branched}->{$branchcode} = {
376                 code  => $branchcode,
377                 name  => $branch->branchname,
378                 email => $stagebranch->branchreplyto
379                   ? $stagebranch->branchreplyto
380                   : $stagebranch->branchemail,
381                 phone => $branch->branchphone,
382                 items => [],
383                 log => [],
384             };
385         }
386         push @{$report->{branched}->{$branchcode}->{items}}, $ireport;
387     }
388
389     ## Per rota indexes
390     ### Per rota indexes are item reports pushed into the index for the
391     ### current rota.  We don't know where that index is yet as we don't know
392     ### about the current rota.  To resolve this we assign our items and log
393     ### to tmp indexes.  They will be merged into the proper rota index at the
394     ### rota level.
395     push @{$report->{tmp_items}}, @{$items_report->{items}};
396     push @{$report->{tmp_log}}, @{$items_report->{log}};
397
398     ## Collection of items
399     ### Finally we just add our collection of items to the full item index.
400     push @{$report->{items}}, @{$items_report->{items}};
401
402     ## Assemble counters
403     $report->{actionable} += $items_report->{actionable};
404     $report->{indemand} += scalar @{$items_report->{indemand_items}};
405     $report->{advanceable} += scalar @{$items_report->{advanceable_items}};
406     $report->{initiable} += scalar @{$items_report->{initiable_items}};
407     $report->{repatriable} += scalar @{$items_report->{repatriable_items}};
408     $report->{stationary} += scalar @{$items_report->{log}};
409
410     return $report;
411 }
412
413 1;
414
415 =head1 AUTHOR
416
417 Alex Sassmannshausen <alex.sassmannshausen@ptfs-europe.com>
418
419 =cut