| 
      
            Line 0
          
      
      
        Link Here
      
     | 
  
          
            
              | 0 | 
              -   | 
              1 | 
              #!/usr/bin/perl  | 
            
            
               | 
               | 
              2 | 
               | 
            
            
              | 3 | 
              # Copyright 2016 PTFS Europe  | 
            
            
              | 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 | 
              =head1 NAME  | 
            
            
              | 21 | 
               | 
            
            
              | 22 | 
              stockrotation.pl  | 
            
            
              | 23 | 
               | 
            
            
              | 24 | 
              =head1 SYNOPSIS  | 
            
            
              | 25 | 
               | 
            
            
              | 26 | 
                  --[a]dmin-email    An address to which email reports should also be sent  | 
            
            
              | 27 | 
                  --[b]ranchcode     Select branch to report on for 'email' reports (default: all)  | 
            
            
              | 28 | 
                  --e[x]ecute        Actually perform stockrotation housekeeping  | 
            
            
              | 29 | 
                  --[r]eport         Select either 'full' or 'email'  | 
            
            
              | 30 | 
                  --[S]end-all       Send email reports even if the report body is empty  | 
            
            
              | 31 | 
                  --[s]end-email     Send reports by email  | 
            
            
              | 32 | 
                  --[h]elp           Display this help message  | 
            
            
              | 33 | 
               | 
            
            
              | 34 | 
              Cron script implementing scheduled stockrotation functionality.  | 
            
            
              | 35 | 
               | 
            
            
              | 36 | 
              By default this script merely reports on the current status of the  | 
            
            
              | 37 | 
              stockrotation subsystem.  In order to actually place items in transit, the  | 
            
            
              | 38 | 
              script must be run with the `execute` argument.  | 
            
            
              | 39 | 
               | 
            
            
              | 40 | 
              `report` allows you to select the type of report that will be emitted. It's  | 
            
            
              | 41 | 
              set to 'full' by default.  If the `email` report is selected, you can use the  | 
            
            
              | 42 | 
              `branchcode` parameter to specify which branch's report you would like to see.  | 
            
            
              | 43 | 
              The default is 'all'.  | 
            
            
              | 44 | 
               | 
            
            
              | 45 | 
              `admin-email` is an additional email address to which we will send all email  | 
            
            
              | 46 | 
              reports in addition to sending them to branch email addresses.  | 
            
            
              | 47 | 
               | 
            
            
              | 48 | 
              `send-email` will cause the script to send reports by email, and `send-all`  | 
            
            
              | 49 | 
              will cause even reports with an empty body to be sent.  | 
            
            
              | 50 | 
               | 
            
            
              | 51 | 
              =head1 DESCRIPTION  | 
            
            
              | 52 | 
               | 
            
            
              | 53 | 
              This script is used to move items from one stockrotationstage to the next,  | 
            
            
              | 54 | 
              if they are elible for processing.  | 
            
            
              | 55 | 
               | 
            
            
              | 56 | 
              it should be run from cron like:  | 
            
            
              | 57 | 
               | 
            
            
              | 58 | 
                 stockrotation.pl  | 
            
            
              | 59 | 
                 -OR-  | 
            
            
              | 60 | 
                 stockrotation.pl -h  | 
            
            
              | 61 | 
               | 
            
            
              | 62 | 
              =cut  | 
            
            
              | 63 | 
               | 
            
            
              | 64 | 
              use Modern::Perl;  | 
            
            
              | 65 | 
              use Getopt::Long qw/HelpMessage :config gnu_getopt/;  | 
            
            
              | 66 | 
              use Mail::Sendmail;  | 
            
            
              | 67 | 
              use C4::Context;  | 
            
            
              | 68 | 
              use Koha::Email;  | 
            
            
              | 69 | 
              use Koha::Stockrotationrotas;  | 
            
            
              | 70 | 
               | 
            
            
              | 71 | 
              my $admin_email = '';  | 
            
            
              | 72 | 
              my $branch = 0;  | 
            
            
              | 73 | 
              my $execute = 0;  | 
            
            
              | 74 | 
              my $report = 'full';  | 
            
            
              | 75 | 
              my $send_all = 0;  | 
            
            
              | 76 | 
              my $send_email = 0;  | 
            
            
              | 77 | 
               | 
            
            
              | 78 | 
              my $ok = GetOptions(  | 
            
            
              | 79 | 
                  'admin-email|a=s' => \$admin_email,  | 
            
            
              | 80 | 
                  'branchcode|b=s' => sub { | 
            
            
              | 81 | 
                      my ($opt_name, $opt_value) = @_;  | 
            
            
              | 82 | 
                      my $branches = Koha::Libraries->search(  | 
            
            
              | 83 | 
                          {}, { order_by => { -asc => 'branchname'} } | 
            
            
              | 84 | 
                      );  | 
            
            
              | 85 | 
                      my $brnch = $branches->find($opt_value);  | 
            
            
              | 86 | 
                      if ( $brnch ) { | 
            
            
              | 87 | 
                          $branch = $brnch;  | 
            
            
              | 88 | 
                          return $brnch;  | 
            
            
              | 89 | 
                      } else { | 
            
            
              | 90 | 
                          printf("Option $opt_name should be one of (name -> code):\n"); | 
            
            
              | 91 | 
                          while ( my $candidate = $branches->next ) { | 
            
            
              | 92 | 
                              printf(  | 
            
            
              | 93 | 
                                  "  %-40s  ->  %s\n", $candidate->branchname,  | 
            
            
              | 94 | 
                                  $candidate->branchcode  | 
            
            
              | 95 | 
                              );  | 
            
            
              | 96 | 
                          }  | 
            
            
              | 97 | 
                          exit 1  | 
            
            
              | 98 | 
                      }  | 
            
            
              | 99 | 
                  },  | 
            
            
              | 100 | 
                  'execute|x' => \$execute,  | 
            
            
              | 101 | 
                  'report|r=s' => sub { | 
            
            
              | 102 | 
                      my ($opt_name, $opt_value) = @_;  | 
            
            
              | 103 | 
                      if ( $opt_value eq 'full' || $opt_value eq 'email' ) { | 
            
            
              | 104 | 
                          $report = $opt_value;  | 
            
            
              | 105 | 
                      } else { | 
            
            
              | 106 | 
                          printf("Option $opt_name should be either 'email' or 'full'.\n"); | 
            
            
              | 107 | 
                          exit 1;  | 
            
            
              | 108 | 
                      }  | 
            
            
              | 109 | 
                  },  | 
            
            
              | 110 | 
                  'send-all|S' => \$send_all,  | 
            
            
              | 111 | 
                  'send-email|s' => \$send_email,  | 
            
            
              | 112 | 
                  'help|h|?' => sub { HelpMessage } | 
            
            
              | 113 | 
              );  | 
            
            
              | 114 | 
              exit 1 unless ( $ok );  | 
            
            
              | 115 | 
               | 
            
            
              | 116 | 
              $send_email++ if ( $send_all ); # if we send all, then we must want emails.  | 
            
            
              | 117 | 
               | 
            
            
              | 118 | 
              =head2 Helpers  | 
            
            
              | 119 | 
               | 
            
            
              | 120 | 
              =head3 investigate  | 
            
            
              | 121 | 
               | 
            
            
              | 122 | 
                my $report = investigate($rotas);  | 
            
            
              | 123 | 
               | 
            
            
              | 124 | 
              Return a datastructure which contains a wealth of information about the  | 
            
            
              | 125 | 
              current state of the stockrotation submodule, and which can be used by  | 
            
            
              | 126 | 
              `report_full`, `report_email` and `execute` to either emit reports or perform  | 
            
            
              | 127 | 
              database updates.  | 
            
            
              | 128 | 
               | 
            
            
              | 129 | 
              $ROTAS should be an iterable set of Koha::Stockrotationrotas.  | 
            
            
              | 130 | 
               | 
            
            
              | 131 | 
              No data in the database is manipulated by this procedure.  | 
            
            
              | 132 | 
               | 
            
            
              | 133 | 
              =cut  | 
            
            
              | 134 | 
               | 
            
            
              | 135 | 
              sub investigate { | 
            
            
              | 136 | 
                  my ( $rotas ) = @_;  | 
            
            
              | 137 | 
                  # Initiate return variables.  | 
            
            
              | 138 | 
                  my $all_relevant_items = [];  | 
            
            
              | 139 | 
                  my $all_relevant_rotas = [];  | 
            
            
              | 140 | 
                  my $branched = {}; | 
            
            
              | 141 | 
                  my $rotas_active = 0;  | 
            
            
              | 142 | 
                  my $rotas_inactive = 0;  | 
            
            
              | 143 | 
                  my $sum_items = 0;  | 
            
            
              | 144 | 
                  my $items_inactive = 0;  | 
            
            
              | 145 | 
                  my $stationary = 0;  | 
            
            
              | 146 | 
                  my $advanceable = 0;  | 
            
            
              | 147 | 
                  my $expulseable = 0;  | 
            
            
              | 148 | 
                  my $repatriable = 0;  | 
            
            
              | 149 | 
                  my $initiable = 0;  | 
            
            
              | 150 | 
                  my $actionable = 0;  | 
            
            
              | 151 | 
               | 
            
            
              | 152 | 
                  # Each 'rota' entry in `rotas` will contain an `items` section with items  | 
            
            
              | 153 | 
                  # to be moved, and a `logs` section, with items that will not be moved,  | 
            
            
              | 154 | 
                  # with a reason for not moving it.  | 
            
            
              | 155 | 
                  while ( my $rota = $rotas->next ) { | 
            
            
              | 156 | 
                      if ( $rota->active ) { | 
            
            
              | 157 | 
                          $rotas_active++;  | 
            
            
              | 158 | 
                          my $items = [];  | 
            
            
              | 159 | 
                          my $log = [];  | 
            
            
              | 160 | 
                          my $stages = $rota->stockrotationstages;  | 
            
            
              | 161 | 
                          while ( my $stage = $stages->next) { | 
            
            
              | 162 | 
                              my $old_stage = $stage;  | 
            
            
              | 163 | 
                              my $new_stage = $stage->next_sibling;  | 
            
            
              | 164 | 
                              my $duration = $stage->duration;  | 
            
            
              | 165 | 
                              my $branch = $old_stage->_result->branchcode;  | 
            
            
              | 166 | 
                              my $branchcode = $branch->branchcode;  | 
            
            
              | 167 | 
                              $branched->{$branchcode} = { | 
            
            
              | 168 | 
                                  code  => $branchcode,  | 
            
            
              | 169 | 
                                  name  => $branch->branchname,  | 
            
            
              | 170 | 
                                  email => $branch->branchemail,  | 
            
            
              | 171 | 
                                  phone => $branch->branchphone,  | 
            
            
              | 172 | 
                                  items => [],  | 
            
            
              | 173 | 
                              };  | 
            
            
              | 174 | 
                              my $stage_items = $stage->stockrotationitems;  | 
            
            
              | 175 | 
                              while ( my $item = $stage_items->next ) { | 
            
            
              | 176 | 
                                  $sum_items++;  | 
            
            
              | 177 | 
                                  # Generate item details  | 
            
            
              | 178 | 
                                  my $item_report = { | 
            
            
              | 179 | 
                                      title      => $item->itemnumber->_result->biblioitem  | 
            
            
              | 180 | 
                                          ->biblionumber->title,  | 
            
            
              | 181 | 
                                      author     => $item->itemnumber->_result->biblioitem  | 
            
            
              | 182 | 
                                          ->biblionumber->author,  | 
            
            
              | 183 | 
                                      callnumber => $item->itemnumber->itemcallnumber,  | 
            
            
              | 184 | 
                                      location   => $item->itemnumber->location,  | 
            
            
              | 185 | 
                                      onloan     => $item->itemnumber->onloan,  | 
            
            
              | 186 | 
                                      barcode    => $item->itemnumber->barcode,  | 
            
            
              | 187 | 
                                      itemnumber => $item->itemnumber_id,  | 
            
            
              | 188 | 
                                      old_stage  => $old_stage,  | 
            
            
              | 189 | 
                                      new_stage  => $new_stage,  | 
            
            
              | 190 | 
                                      object     => $item,  | 
            
            
              | 191 | 
                                  };  | 
            
            
              | 192 | 
               | 
            
            
              | 193 | 
                                  # Test whether we need to perform an action on item.  | 
            
            
              | 194 | 
                                  my $flag = 0;  | 
            
            
              | 195 | 
                                  if ( $item->needs_initiating ) { | 
            
            
              | 196 | 
                                      $flag++;  | 
            
            
              | 197 | 
                                      $initiable++;  | 
            
            
              | 198 | 
                                      $actionable++;  | 
            
            
              | 199 | 
                                      $item_report->{reason} = 'initiation'; | 
            
            
              | 200 | 
                                  } elsif ( $item->needs_repatriating ) { | 
            
            
              | 201 | 
                                      $flag++;  | 
            
            
              | 202 | 
                                      $repatriable++;  | 
            
            
              | 203 | 
                                      $actionable++;  | 
            
            
              | 204 | 
                                      $item_report->{reason} = 'repatriation'; | 
            
            
              | 205 | 
                                  } elsif ( $item->needs_advancing ) { | 
            
            
              | 206 | 
                                      $flag++;  | 
            
            
              | 207 | 
                                      $actionable++;  | 
            
            
              | 208 | 
                                      if ( !$new_stage ) { | 
            
            
              | 209 | 
                                          $expulseable++;  | 
            
            
              | 210 | 
                                      } else { | 
            
            
              | 211 | 
                                          $advanceable++;  | 
            
            
              | 212 | 
                                      }  | 
            
            
              | 213 | 
                                      $item_report->{reason} = | 
            
            
              | 214 | 
                                          ( $item->indemand ) ? 'in-demand' : 'advancement';  | 
            
            
              | 215 | 
                                  }  | 
            
            
              | 216 | 
               | 
            
            
              | 217 | 
                                  if ( $flag ) { # Item will be moved. | 
            
            
              | 218 | 
                                      push @{$items}, $item_report; | 
            
            
              | 219 | 
                                      push @{$all_relevant_items}, $item_report; | 
            
            
              | 220 | 
                                      push @{$branched->{$branchcode}->{items}}, $item_report; | 
            
            
              | 221 | 
                                  } else {       # Item not ready to be moved. | 
            
            
              | 222 | 
                                      $stationary++;  | 
            
            
              | 223 | 
                                      $item_report->{reason} = 'not-ready'; | 
            
            
              | 224 | 
                                      push @{$log}, $item_report; | 
            
            
              | 225 | 
                                  }  | 
            
            
              | 226 | 
                              }  | 
            
            
              | 227 | 
                          }  | 
            
            
              | 228 | 
                          # Add our rota report to the full report.  | 
            
            
              | 229 | 
                          push @{$all_relevant_rotas}, { | 
            
            
              | 230 | 
                              name  => $rota->title,  | 
            
            
              | 231 | 
                              id    => $rota->rota_id,  | 
            
            
              | 232 | 
                              items => $items,  | 
            
            
              | 233 | 
                              log   => $log,  | 
            
            
              | 234 | 
                          };  | 
            
            
              | 235 | 
                      } else {                # Rota is not active. | 
            
            
              | 236 | 
                          $rotas_inactive++;  | 
            
            
              | 237 | 
                          $sum_items += $rota->stockrotationitems->count;  | 
            
            
              | 238 | 
                          $items_inactive += $rota->stockrotationitems->count;  | 
            
            
              | 239 | 
                      }  | 
            
            
              | 240 | 
                  }  | 
            
            
              | 241 | 
               | 
            
            
              | 242 | 
                  return { | 
            
            
              | 243 | 
                      sum_rotas          => $rotas->count,  | 
            
            
              | 244 | 
                      rotas_inactive     => $rotas_inactive,  | 
            
            
              | 245 | 
                      rotas_active       => $rotas_active,  | 
            
            
              | 246 | 
                      sum_items          => $sum_items,  | 
            
            
              | 247 | 
                      items_inactive     => $items_inactive,  | 
            
            
              | 248 | 
                      stationary         => $stationary,  | 
            
            
              | 249 | 
                      actionable         => $actionable,  | 
            
            
              | 250 | 
                      initiable          => $initiable,  | 
            
            
              | 251 | 
                      repatriable        => $repatriable,  | 
            
            
              | 252 | 
                      advanceable        => $advanceable,  | 
            
            
              | 253 | 
                      expulseable        => $expulseable,  | 
            
            
              | 254 | 
                      rotas              => $all_relevant_rotas,  | 
            
            
              | 255 | 
                      items              => $all_relevant_items,  | 
            
            
              | 256 | 
                      branched           => $branched,  | 
            
            
              | 257 | 
                  }  | 
            
            
              | 258 | 
              }  | 
            
            
              | 259 | 
               | 
            
            
              | 260 | 
              =head3 execute  | 
            
            
              | 261 | 
               | 
            
            
              | 262 | 
                undef = execute($report);  | 
            
            
              | 263 | 
               | 
            
            
              | 264 | 
              Perform the database updates, within a transaction, that are reported as  | 
            
            
              | 265 | 
              needing to be performed by $REPORT.  | 
            
            
              | 266 | 
               | 
            
            
              | 267 | 
              $REPORT should be the return value of an invocation of `investigate`.  | 
            
            
              | 268 | 
               | 
            
            
              | 269 | 
              This procedure WILL mess with your database.  | 
            
            
              | 270 | 
               | 
            
            
              | 271 | 
              =cut  | 
            
            
              | 272 | 
               | 
            
            
              | 273 | 
              sub execute { | 
            
            
              | 274 | 
                  my ( $data ) = @_;  | 
            
            
              | 275 | 
               | 
            
            
              | 276 | 
                  # Begin transaction  | 
            
            
              | 277 | 
                  my $schema = Koha::Database->new->schema;  | 
            
            
              | 278 | 
                  $schema->storage->txn_begin;  | 
            
            
              | 279 | 
               | 
            
            
              | 280 | 
                  # Carry out db updates  | 
            
            
              | 281 | 
                  foreach my $item (@{$data->{items}}) { | 
            
            
              | 282 | 
                      my $reason = $item->{reason}; | 
            
            
              | 283 | 
                      if ( $reason eq 'initiation' ) { | 
            
            
              | 284 | 
                          $item->{object}->initiate; | 
            
            
              | 285 | 
                      } elsif ( $reason eq 'repatriation' ) { | 
            
            
              | 286 | 
                          $item->{object}->repatriate; | 
            
            
              | 287 | 
                      } elsif ( $reason eq 'in-demand' || $reason eq 'advancement' ) { | 
            
            
              | 288 | 
                          $item->{object}->advance; | 
            
            
              | 289 | 
                      }  | 
            
            
              | 290 | 
                  }  | 
            
            
              | 291 | 
               | 
            
            
              | 292 | 
                  # End transaction  | 
            
            
              | 293 | 
                  $schema->storage->txn_commit;  | 
            
            
              | 294 | 
              }  | 
            
            
              | 295 | 
               | 
            
            
              | 296 | 
              =head3 report_full  | 
            
            
              | 297 | 
               | 
            
            
              | 298 | 
                my $full_report = report_full($report);  | 
            
            
              | 299 | 
               | 
            
            
              | 300 | 
              Return an arrayref containing a string containing a detailed report about the  | 
            
            
              | 301 | 
              current state of the stockrotation subsystem.  | 
            
            
              | 302 | 
               | 
            
            
              | 303 | 
              $REPORT should be the return value of `investigate`.  | 
            
            
              | 304 | 
               | 
            
            
              | 305 | 
              No data in the database is manipulated by this procedure.  | 
            
            
              | 306 | 
               | 
            
            
              | 307 | 
              =cut  | 
            
            
              | 308 | 
               | 
            
            
              | 309 | 
              sub report_full { | 
            
            
              | 310 | 
                  my ( $data ) = @_;  | 
            
            
              | 311 | 
               | 
            
            
              | 312 | 
                  my $header = "";  | 
            
            
              | 313 | 
                  my $body = "";  | 
            
            
              | 314 | 
                  # Summary  | 
            
            
              | 315 | 
                  $header .= sprintf "  | 
            
            
              | 316 | 
              STOCKROTATION REPORT  | 
            
            
              | 317 | 
              --------------------  | 
            
            
              | 318 | 
                Total number of rotas:         %5u  | 
            
            
              | 319 | 
                  Inactive rotas:              %5u  | 
            
            
              | 320 | 
                  Active rotas:                %5u  | 
            
            
              | 321 | 
                Total number of items:         %5u  | 
            
            
              | 322 | 
                  Inactive items:              %5u  | 
            
            
              | 323 | 
                  Stationary items:            %5u  | 
            
            
              | 324 | 
                  Actionable items:            %5u  | 
            
            
              | 325 | 
                Total items to be initiated:   %5u  | 
            
            
              | 326 | 
                Total items to be repatriated: %5u  | 
            
            
              | 327 | 
                Total items to be advanced:    %5u  | 
            
            
              | 328 | 
                Total items to be expulsed:    %5u\n\n",  | 
            
            
              | 329 | 
                    $data->{sum_rotas}, $data->{rotas_inactive}, $data->{rotas_active}, | 
            
            
              | 330 | 
                    $data->{sum_items}, $data->{items_inactive}, | 
            
            
              | 331 | 
                    $data->{stationary}, $data->{actionable}, | 
            
            
              | 332 | 
                    $data->{initiable}, $data->{repatriable}, | 
            
            
              | 333 | 
                    $data->{advanceable}, $data->{expulseable}; | 
            
            
              | 334 | 
               | 
            
            
              | 335 | 
                  if (@{$data->{rotas}}) {    # Per Rota details | 
            
            
              | 336 | 
                      $body .= sprintf "ROTAS DETAIL\n------------\n\n";  | 
            
            
              | 337 | 
                      foreach my $rota (@{$data->{rotas}}) { | 
            
            
              | 338 | 
                          $body .= sprintf "Details for %s [%s]:\n",  | 
            
            
              | 339 | 
                              $rota->{name}, $rota->{id}; | 
            
            
              | 340 | 
                          $body .= sprintf "\n  Items:"; # Rota item details  | 
            
            
              | 341 | 
                          if (@{$rota->{items}}) { | 
            
            
              | 342 | 
                              $body .= join("", map { _print_item($_) } @{$rota->{items}}); | 
            
            
              | 343 | 
                          } else { | 
            
            
              | 344 | 
                              $body .= sprintf  | 
            
            
              | 345 | 
                                  "\n    No items to be processed for this rota.\n";  | 
            
            
              | 346 | 
                          }  | 
            
            
              | 347 | 
                          $body .= sprintf "\n  Log:";  # Rota log details  | 
            
            
              | 348 | 
                          if (@{$rota->{log}}) { | 
            
            
              | 349 | 
                              $body .= join("", map { _print_item($_) } @{$rota->{log}}); | 
            
            
              | 350 | 
                          } else { | 
            
            
              | 351 | 
                              $body .= sprintf "\n    No items in log for this rota.\n\n";  | 
            
            
              | 352 | 
                          }  | 
            
            
              | 353 | 
                      }  | 
            
            
              | 354 | 
                  }  | 
            
            
              | 355 | 
                  return [ $header, { | 
            
            
              | 356 | 
                      body            => $body, # The body of the report  | 
            
            
              | 357 | 
                      status          => 1,     # We have a meaningful report  | 
            
            
              | 358 | 
                      no_branch_email => 1,     # We don't expect branch email in report  | 
            
            
              | 359 | 
                  } ];  | 
            
            
              | 360 | 
              }  | 
            
            
              | 361 | 
               | 
            
            
              | 362 | 
              =head3 report_email  | 
            
            
              | 363 | 
               | 
            
            
              | 364 | 
                my $email_report = report_email($report);  | 
            
            
              | 365 | 
               | 
            
            
              | 366 | 
              Returns an arrayref containing a header string, with basic report information,  | 
            
            
              | 367 | 
              and any number of 'per_branch' strings, containing a detailed report about the  | 
            
            
              | 368 | 
              current state of the stockrotation subsystem, from the perspective of those  | 
            
            
              | 369 | 
              individual branches.  | 
            
            
              | 370 | 
               | 
            
            
              | 371 | 
              $REPORT should be the return value of `investigate`, and $BRANCH should be  | 
            
            
              | 372 | 
              either 0 (to indicate 'all'), or a specific Koha::Library object.  | 
            
            
              | 373 | 
               | 
            
            
              | 374 | 
              No data in the database is manipulated by this procedure.  | 
            
            
              | 375 | 
               | 
            
            
              | 376 | 
              =cut  | 
            
            
              | 377 | 
               | 
            
            
              | 378 | 
              sub report_email { | 
            
            
              | 379 | 
                  my ( $data, $branch ) = @_;  | 
            
            
              | 380 | 
               | 
            
            
              | 381 | 
                  my $out = [];  | 
            
            
              | 382 | 
                  my $header = "";  | 
            
            
              | 383 | 
                  # Summary  | 
            
            
              | 384 | 
                  my $branched = $data->{branched}; | 
            
            
              | 385 | 
                  my $flag = 0;  | 
            
            
              | 386 | 
               | 
            
            
              | 387 | 
                  $header .= sprintf "  | 
            
            
              | 388 | 
              BRANCH-BASED STOCKROTATION REPORT  | 
            
            
              | 389 | 
              ---------------------------------\n";  | 
            
            
              | 390 | 
                  push @{$out}, $header; | 
            
            
              | 391 | 
               | 
            
            
              | 392 | 
                  if ( $branch ) {                      # Branch limited report | 
            
            
              | 393 | 
                      push @{$out}, _report_per_branch( | 
            
            
              | 394 | 
                          $branched->{$branch->branchcode}, $branch->branchcode, | 
            
            
              | 395 | 
                          $branch->branchname  | 
            
            
              | 396 | 
                      );  | 
            
            
              | 397 | 
                  } elsif ( $data->{actionable} ) {     # Full email report | 
            
            
              | 398 | 
                      while ( my ($branchcode_id, $details) = each %{$branched} ) { | 
            
            
              | 399 | 
                          push @{$out}, _report_per_branch( | 
            
            
              | 400 | 
                              $details, $details->{code}, $details->{name} | 
            
            
              | 401 | 
                          ) if ( @{$details->{items}} ); | 
            
            
              | 402 | 
                      }  | 
            
            
              | 403 | 
                  } else { | 
            
            
              | 404 | 
                      push @{$out}, { | 
            
            
              | 405 | 
                          body            => sprintf "  | 
            
            
              | 406 | 
              No actionable items at any libraries.\n\n", # The body of the report  | 
            
            
              | 407 | 
                          no_branch_email => 1, # We don't expect branch email in report  | 
            
            
              | 408 | 
                      };  | 
            
            
              | 409 | 
                  }  | 
            
            
              | 410 | 
                  return $out;  | 
            
            
              | 411 | 
              }  | 
            
            
              | 412 | 
               | 
            
            
              | 413 | 
              =head3 _report_per_branch  | 
            
            
              | 414 | 
               | 
            
            
              | 415 | 
                my $branch_string = _report_per_branch($branch_details, $branchcode, $branchname);  | 
            
            
              | 416 | 
               | 
            
            
              | 417 | 
              return a string containing details about the stockrotation items and their  | 
            
            
              | 418 | 
              status for the branch identified by $BRANCHCODE.  | 
            
            
              | 419 | 
               | 
            
            
              | 420 | 
              This helper procedure is only used from within `report_email`.  | 
            
            
              | 421 | 
               | 
            
            
              | 422 | 
              No data in the database is manipulated by this procedure.  | 
            
            
              | 423 | 
               | 
            
            
              | 424 | 
              =cut  | 
            
            
              | 425 | 
               | 
            
            
              | 426 | 
              sub _report_per_branch { | 
            
            
              | 427 | 
                  my ( $per_branch, $branchcode, $branchname ) = @_;  | 
            
            
              | 428 | 
               | 
            
            
              | 429 | 
                  my $out = "";  | 
            
            
              | 430 | 
                  my $status = 0;  | 
            
            
              | 431 | 
               | 
            
            
              | 432 | 
                  $out .= sprintf "\nStockrotation report for '%s' [%s]:\n",  | 
            
            
              | 433 | 
                      $branchname || "N/A", $branchcode || "N/A";  | 
            
            
              | 434 | 
                  if ( $per_branch && @{$per_branch->{items}} ) { | 
            
            
              | 435 | 
                      $out .= sprintf "  | 
            
            
              | 436 | 
                Email: %s  | 
            
            
              | 437 | 
                Phone: %s  | 
            
            
              | 438 | 
                Items:",  | 
            
            
              | 439 | 
                      $per_branch->{email} || "N/A", $per_branch->{phone} || "N/A"; | 
            
            
              | 440 | 
                      $status++;  | 
            
            
              | 441 | 
                  } else { | 
            
            
              | 442 | 
                      $out .= sprintf "No items to be processed for this branch.\n\n";  | 
            
            
              | 443 | 
                  }  | 
            
            
              | 444 | 
                  $out .= join("", map { _print_item($_) } @{$per_branch->{items}}); | 
            
            
              | 445 | 
                  return { | 
            
            
              | 446 | 
                      body          => $out,                 # The body of the report  | 
            
            
              | 447 | 
                      email_address => $per_branch->{email}, # The branch email address | 
            
            
              | 448 | 
                      status        => $status,              # We may have empty report...  | 
            
            
              | 449 | 
                  };  | 
            
            
              | 450 | 
              }  | 
            
            
              | 451 | 
               | 
            
            
              | 452 | 
              =head3 _print_item  | 
            
            
              | 453 | 
               | 
            
            
              | 454 | 
                my $string = _print_item($item_section);  | 
            
            
              | 455 | 
               | 
            
            
              | 456 | 
              Return a string containing an overview about $ITEM_SECTION.  | 
            
            
              | 457 | 
               | 
            
            
              | 458 | 
              This helper procedure is only used from within `report_email` and  | 
            
            
              | 459 | 
              `report_full`.  | 
            
            
              | 460 | 
               | 
            
            
              | 461 | 
              No data in the database is manipulated by this procedure.  | 
            
            
              | 462 | 
               | 
            
            
              | 463 | 
              =cut  | 
            
            
              | 464 | 
               | 
            
            
              | 465 | 
              sub _print_item { | 
            
            
              | 466 | 
                  my ( $item ) = @_;  | 
            
            
              | 467 | 
                  return sprintf "  | 
            
            
              | 468 | 
                  Title:      %s  | 
            
            
              | 469 | 
                  Author:     %s  | 
            
            
              | 470 | 
                  Callnumber: %s  | 
            
            
              | 471 | 
                  Location:   %s  | 
            
            
              | 472 | 
                  Barcode:    %s  | 
            
            
              | 473 | 
                  On loan?:   %s  | 
            
            
              | 474 | 
                  Status:     %s\n\n",  | 
            
            
              | 475 | 
                        $item->{title} || "N/A", $item->{author} || "N/A", | 
            
            
              | 476 | 
                        $item->{callnumber} || "N/A", $item->{location} || "N/A", | 
            
            
              | 477 | 
                        $item->{barcode} || "N/A", $item->{onloan} ?  'Yes' : 'No', | 
            
            
              | 478 | 
                        $item->{reason} || "N/A"; | 
            
            
              | 479 | 
              }  | 
            
            
              | 480 | 
               | 
            
            
              | 481 | 
              =head3 emit  | 
            
            
              | 482 | 
               | 
            
            
              | 483 | 
                undef = emit($params);  | 
            
            
              | 484 | 
               | 
            
            
              | 485 | 
              $PARAMS should be a hashref of the following format:  | 
            
            
              | 486 | 
                admin_email: the address to which a copy of all reports should be sent.  | 
            
            
              | 487 | 
                execute: the flag indicating whether we performed db updates  | 
            
            
              | 488 | 
                send_all: the flag indicating whether we should send even empty reports  | 
            
            
              | 489 | 
                send_email: the flag indicating whether we want to emit to stdout or email  | 
            
            
              | 490 | 
                report: the data structure returned from one of the report procedures  | 
            
            
              | 491 | 
               | 
            
            
              | 492 | 
              No data in the database is manipulated by this procedure.  | 
            
            
              | 493 | 
               | 
            
            
              | 494 | 
              The return value is unspecified: we simply emit a message as a side-effect or  | 
            
            
              | 495 | 
              die.  | 
            
            
              | 496 | 
               | 
            
            
              | 497 | 
              =cut  | 
            
            
              | 498 | 
               | 
            
            
              | 499 | 
              sub emit { | 
            
            
              | 500 | 
                  my ( $params ) = @_;  | 
            
          
            
              | 501 | 
               | 
            
            
              | 502 | 
                  # REPORT is an arrayref of at least 2 elements:  | 
            
            
              | 503 | 
                  #   - The header for the report, which will be repeated for each part  | 
            
            
              | 504 | 
                  #   - a "part" for each report we want to emit  | 
            
            
              | 505 | 
                  # PARTS are hashrefs:  | 
            
            
              | 506 | 
                  #   - part->{body}: the body of the report | 
            
            
              | 507 | 
                  #   - part->{email_address}: the email address to send the report to | 
            
            
              | 508 | 
                  my $report = $params->{report}; | 
            
            
              | 509 | 
                  my $header = shift @{$report}; | 
            
            
              | 510 | 
                  my $parts = $report;  | 
            
            
              | 511 | 
               | 
            
            
              | 512 | 
                  foreach my $part (@{$parts}) { | 
            
            
              | 513 | 
                      # The final message is the header + body of this part.  | 
            
            
              | 514 | 
                      my $msg = $header . $part->{body}; | 
            
            
              | 515 | 
                      $msg .= "No database updates have been performed.\n\n"  | 
            
            
              | 516 | 
                          unless ( $params->{execute} ); | 
            
            
              | 517 | 
               | 
            
            
              | 518 | 
                      if ( $params->{send_email} ) { # Only email if emails requested | 
            
            
              | 519 | 
                          if ( $part->{status} || $params->{send_all} ) { | 
            
            
              | 520 | 
                              # We have a report to send, or we want to send even empty  | 
            
            
              | 521 | 
                              # reports.  | 
            
            
              | 522 | 
                              my $message = Koha::Email->new;  | 
            
            
              | 523 | 
               | 
            
            
              | 524 | 
                              # Collate 'to' addresses  | 
            
            
              | 525 | 
                              my @to = ();  | 
            
            
              | 526 | 
                              if ( $part->{email_address} ) { | 
            
            
              | 527 | 
                                  push @to, $part->{email_address}; | 
            
            
              | 528 | 
                              } elsif ( !$part->{no_branch_email} ) { | 
            
            
              | 529 | 
                                  $msg = "***We tried to send a branch report, but we have no email address for this branch.***\n\n" . $msg;  | 
            
            
              | 530 | 
                                  push @to, C4::Context->preference('KohaAdminEmailAddress') | 
            
            
              | 531 | 
                                      if ( C4::Context->preference('KohaAdminEmailAddress') ); | 
            
            
              | 532 | 
                              }  | 
            
            
              | 533 | 
                              push @to, $params->{admin_email} if $params->{admin_email}; | 
            
            
              | 534 | 
               | 
            
            
              | 535 | 
                              # Create email data.  | 
            
            
              | 536 | 
                              my %mail = $message->create_message_headers(  | 
            
            
              | 537 | 
                                  { | 
            
            
              | 538 | 
                                      to          => join("; ", @to), | 
            
            
              | 539 | 
                                      subject     => "Stockrotation Email Report",  | 
            
            
              | 540 | 
                                      message     => Encode::encode("utf8", $msg), | 
            
            
              | 541 | 
                                      contenttype => 'text/plain; charset="utf8"',  | 
            
            
              | 542 | 
                                  }  | 
            
            
              | 543 | 
                              );  | 
            
            
              | 544 | 
               | 
            
            
              | 545 | 
                              # Send or die.  | 
            
            
              | 546 | 
                              die($Mail::Sendmail::error)  | 
            
            
              | 547 | 
                                  unless Mail::Sendmail::sendmail(%mail);  | 
            
            
              | 548 | 
                          }  | 
            
            
              | 549 | 
               | 
            
            
              | 550 | 
                      } else {                       #  Else emit to stdout. | 
            
            
              | 551 | 
                          printf $msg;  | 
            
            
              | 552 | 
                      }  | 
            
            
              | 553 | 
                  }  | 
            
            
              | 554 | 
              }  | 
            
            
              | 555 | 
               | 
            
            
              | 556 | 
              #### Main Code  | 
            
            
              | 557 | 
               | 
            
            
              | 558 | 
              # Compile Stockrotation Report data  | 
            
            
              | 559 | 
              my $rotas = Koha::Stockrotationrotas->search;  | 
            
            
              | 560 | 
              my $data = investigate($rotas);  | 
            
            
              | 561 | 
               | 
            
            
              | 562 | 
              # Perform db updates if requested  | 
            
            
              | 563 | 
              execute($data) if ( $execute );  | 
            
            
              | 564 | 
               | 
            
            
              | 565 | 
              # Emit Reports  | 
            
            
              | 566 | 
              my $out_report = {}; | 
            
            
              | 567 | 
              $out_report = report_email($data, $branch) if $report eq 'email';  | 
            
            
              | 568 | 
              $out_report = report_full($data, $branch) if $report eq 'full';  | 
            
            
              | 569 | 
              emit({ | 
            
            
              | 570 | 
                  admin_email => $admin_email,  | 
            
            
              | 571 | 
                  execute     => $execute,  | 
            
            
              | 572 | 
                  report      => $out_report,  | 
            
            
              | 573 | 
                  send_all    => $send_all,  | 
            
            
              | 574 | 
                  send_email  => $send_email,  | 
            
            
              | 575 | 
              });  | 
            
            
              | 576 | 
               | 
            
            
              | 577 | 
              =head1 AUTHOR  | 
            
            
              | 578 | 
               | 
            
            
              | 579 | 
              Alex Sassmannshausen <alex.sassmannshausen@ptfs-europe.com>  | 
            
            
              | 580 | 
               | 
            
            
              | 581 | 
              =cut  |