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