File Coverage

blib/lib/HPC/Runner/Command/execute_job/Utils/Log.pm
Criterion Covered Total %
statement 33 167 19.7
branch 0 52 0.0
condition 0 19 0.0
subroutine 11 18 61.1
pod 2 6 33.3
total 46 262 17.5


line stmt bran cond sub pod time code
1             package HPC::Runner::Command::execute_job::Utils::Log;
2              
3 1     1   1065 use MooseX::App::Role;
  1         3  
  1         9  
4 1     1   6071 use namespace::autoclean;
  1         2  
  1         6  
5              
6 1     1   57 use MooseX::Types::Path::Tiny qw/Path Paths AbsPath AbsFile/;
  1         3  
  1         8  
7              
8 1     1   2788 use IPC::Open3;
  1         2  
  1         76  
9 1     1   6 use IPC::Cmd qw[can_run];
  1         1  
  1         44  
10 1     1   6 use IO::Select;
  1         2  
  1         27  
11 1     1   126 use Symbol;
  1         3  
  1         50  
12 1     1   5 use Try::Tiny;
  1         2  
  1         38  
13 1     1   5 use Path::Tiny;
  1         2  
  1         36  
14 1     1   5 use File::Path qw(make_path remove_tree);
  1         2  
  1         42  
15 1     1   6 use File::Slurp;
  1         2  
  1         1362  
16              
17             with 'HPC::Runner::Command::Utils::Log';
18             with 'HPC::Runner::Command::execute_job::Utils::MemProfile';
19              
20             ##Command Log
21             has 'command_log' => ( is => 'rw', );
22              
23             #TODO This should be changed to execute_jobs Logging
24             #We also have task_tags as an ArrayRef for JobDeps
25              
26             has 'task_tags' => (
27             traits => ['Hash'],
28             is => 'rw',
29             isa => 'HashRef',
30             default => sub { {} },
31             handles => {
32             set_task_tag => 'set',
33             get_task_tag => 'get',
34             has_no_task_tags => 'is_empty',
35             num_task_tags => 'count',
36             delete_task_tag => 'delete',
37             task_tag_pairs => 'kv',
38             },
39             );
40              
41             =head3 table_data
42              
43             Each time we make an update to the table throw it in here
44              
45             =cut
46              
47             has 'table_data' => (
48             traits => ['Hash'],
49             is => 'rw',
50             isa => 'HashRef',
51             default => sub { {} },
52             handles => {
53             set_table_data => 'set',
54             get_table_data => 'get',
55             delete_table_data => 'delete',
56             has_no_table_data => 'is_empty',
57             num_table_data => 'count',
58             table_data_pairs => 'kv',
59             clear_table_data => 'clear',
60             },
61             );
62              
63             #TODO Move this to App/execute_job/Log ... something to mark that this logs the
64             #individual processes that are executed
65              
66             =head3 _log_commands
67              
68             Log the commands run them. Cat stdout/err with IO::Select so we hopefully don't break things.
69              
70             This example was just about 100% from the following perlmonks discussions.
71              
72             http://www.perlmonks.org/?node_id=151886
73              
74             You can use the script at the top to test the runner. Just download it, make it executable, and put it in the infile as
75              
76             perl command.pl 1
77             perl command.pl 2
78             #so on and so forth
79              
80             =cut
81              
82             sub _log_commands {
83 0     0     my $self = shift;
84 0           my $pid = shift;
85              
86 0           my $dt1 = DateTime->now( time_zone => 'local' );
87 0           $self->task_start_time($dt1);
88              
89             #$DB::single = 2;
90 0           my $ymd = $dt1->ymd();
91 0           my $hms = $dt1->hms();
92              
93 0           $self->clear_table_data;
94 0           $self->set_table_data( start_time => "$dt1" );
95 0           $self->set_table_data( start_time_dt => $dt1 );
96              
97 0           my ( $cmdpid, $exitcode ) = $self->log_job;
98              
99 0 0         return unless defined $cmdpid;
100 0 0         return unless defined $exitcode;
101              
102             #TODO Make table data its own class and return it
103 0           $self->set_table_data( cmdpid => $cmdpid );
104              
105 0           my $meta = $self->pop_note_meta;
106 0 0         $self->set_task_tag( $cmdpid => $meta ) if $meta;
107              
108 0           $self->log_cmd_messages( "info",
109             "Finishing job " . $self->counter . " with ExitCode $exitcode",
110             $cmdpid );
111              
112 0           my $dt2 = DateTime->now( time_zone => 'local' );
113 0           my $duration = $dt2 - $dt1;
114 0           my $format =
115             DateTime::Format::Duration->new(
116             pattern => ' %e days, %H hours, %M minutes, %S seconds' );
117              
118 0           $self->log_cmd_messages( "info",
119             "Total execution time " . $format->format_duration($duration),
120             $cmdpid );
121              
122 0           $self->log_table( $cmdpid, $exitcode, $format->format_duration($duration) );
123              
124 0           $self->update_json_task;
125              
126 0           return $exitcode;
127             }
128              
129             =head3 name_log
130              
131             Default is dt, jobname, counter
132              
133             =cut
134              
135             #TODO move to execute_jobs
136              
137             sub name_log {
138 0     0 1   my $self = shift;
139 0           my $cmdpid = shift;
140              
141 0           my $counter = $self->counter;
142              
143 0           $self->logfile( $self->set_logfile );
144 0           $counter = sprintf( "%03d", $counter );
145 0           $self->append_logfile( "-CMD_" . $counter . "-$cmdpid.md" );
146              
147 0           $self->set_task_tag( "$counter" => $cmdpid );
148             }
149              
150             #TODO move to execute_jobs
151              
152             sub log_table {
153 0     0 0   my $self = shift;
154 0           my $cmdpid = shift;
155 0           my $exitcode = shift;
156 0           my $duration = shift;
157              
158 0           my $dt1 = DateTime->now( time_zone => 'local' );
159 0           my $ymd = $dt1->ymd();
160 0           my $hms = $dt1->hms();
161              
162 0           $self->set_table_data( exit_time => "$dt1" );
163 0           $self->set_table_data( exitcode => $exitcode );
164 0           $self->set_table_data( duration => $duration );
165 0           $self->set_table_data( task_id => $self->counter );
166              
167 0   0       my $version = $self->version || "0.0";
168 0           my $task_tags = "";
169              
170             ##TODO Update this with File::Spec
171 0           my $logfile = File::Spec->catdir( $self->logdir, $self->logfile );
172              
173 0 0         if ( $self->can('task_tags') ) {
174 0   0       my $aref = $self->get_task_tag($cmdpid) || [];
175 0   0       $task_tags = join( ", ", @{$aref} ) || "";
176              
177 0           $self->set_table_data( task_tags => $task_tags );
178             }
179              
180 0 0 0       if ( $self->can('version') && $self->has_version ) {
181 0           $version = $self->version;
182 0           $self->set_table_data( version => $version );
183             }
184              
185 0           my $text = '';
186 0 0 0       if ( $self->can('job_scheduler_id') && $self->can('jobname') ) {
187 0   0       my $schedulerid = $self->job_scheduler_id || '';
188              
189 0   0       my $jobname = $self->jobname || '';
190 0           $text = <<EOF;
191             |$version|$schedulerid|$jobname|$task_tags|$cmdpid|$exitcode|$duration|
192             EOF
193              
194 0           $self->set_table_data( schedulerid => $schedulerid );
195 0           $self->set_table_data( jobname => $jobname );
196             }
197             else {
198 0           $text = <<EOF;
199             |$cmdpid|$exitcode|$duration|
200             EOF
201             }
202              
203 0 0         write_file( $self->process_table, { append => 1 }, $text )
204             || $self->app_log->warn("Unable to write to the process table! $!");
205             }
206              
207             #TODO move to execute_jobs
208              
209             sub log_cmd_messages {
210 0     0 0   my ( $self, $level, $message, $cmdpid ) = @_;
211              
212 0 0         return unless $message;
213 0 0         return unless $level;
214              
215 0 0 0       if ( $self->show_processid && $cmdpid ) {
216 0           $self->command_log->$level("PID: $cmdpid\t$message");
217             }
218             else {
219 0           $self->command_log->$level($message);
220             }
221             }
222              
223             #TODO move to execute_jobs
224             sub log_job {
225 0     0 0   my $self = shift;
226              
227             #Start running job
228 0           my ( $infh, $outfh, $errfh, $exitcode, $stderr );
229 0           $errfh = gensym(); # if you uncomment this line, $errfh will
230 0           my $cmdpid;
231              
232 0           eval { $cmdpid = open3( $infh, $outfh, $errfh, $self->cmd ); };
  0            
233 0 0         if ($@) {
234 0           $stderr = $@;
235 0           $exitcode = $?;
236 0           $self->app_log->fatal( "Error running job "
237             . $self->counter
238             . " with ExitCode $exitcode" );
239              
240 0           $self->app_log->warn("There was an error running the command $@\n");
241 0           $cmdpid = 0;
242             }
243              
244 0           $infh->autoflush();
245              
246             # Start Command Log
247 0           $self->start_command_log($cmdpid);
248 0           $self->create_json_task($cmdpid);
249              
250             ##IF we have an exitcode the job failed with a command not found
251 0 0         return ( $cmdpid, $exitcode ) if $exitcode;
252              
253             ## Rolling back cmd_stats for now
254             # $self->get_cmd_stats($cmdpid);
255              
256 0           my $sel = new IO::Select; # create a select object
257 0           $sel->add( $outfh, $errfh ); # and add the fhs
258              
259             # while (1) {
260             # last unless $sel->can_read;
261 0           while ( my @ready = $sel->can_read ) {
262              
263 0           foreach my $fh (@ready) { # loop through them
264 0           my $line;
265 0           my $len = sysread $fh, $line, 4096;
266 0 0         next unless defined $len;
267 0 0         if ( $len == 0 ) {
268 0           $sel->remove($fh);
269 0           close($fh);
270             }
271             else { # we read data alright
272 0 0         if ( $fh == $outfh ) {
    0          
273 0           $self->log_cmd_messages( "info", $line, $cmdpid );
274             }
275             elsif ( $fh == $errfh ) {
276 0           $self->log_cmd_messages( "error", $line, $cmdpid );
277             }
278             else {
279 0           $self->log_cmd_messages( 'fatal', "Shouldn't be here!\n" );
280             }
281             }
282             }
283              
284             }
285              
286             # $self->get_cmd_stats($cmdpid);
287             # sleep( $self->poll_time );
288             # }
289              
290 0           waitpid( $cmdpid, 1 );
291 0 0         $exitcode = $? unless $exitcode;
292              
293 0           return ( $cmdpid, $exitcode );
294             }
295              
296             =head3 start_command_log
297              
298             Initialize the command log
299              
300             Print out command info - schedulerId, taskId, cmdPID, etc.
301              
302             =cut
303              
304             sub start_command_log {
305 0     0 1   my $self = shift;
306 0           my $cmdpid = shift;
307              
308 0 0         if ( $self->single_node ) {
    0          
309 0           $self->name_log( "PID_" . $cmdpid );
310             }
311             elsif ( $self->job_scheduler_id ) {
312 0           $self->name_log(
313             "_SID_" . $self->job_scheduler_id . "_PID_" . $cmdpid );
314             }
315             else {
316 0           $self->name_log( "PID_" . $cmdpid );
317             }
318              
319 0           $self->command_log( $self->init_log );
320              
321             #$DB::single = 2;
322 0           my $log_array_msg = "";
323 0 0         if ( $self->can('task_id') ) {
324 0           $log_array_msg = "\nArray ID:\t" . $self->task_id . "\n";
325             }
326             else {
327 0           $log_array_msg = "\nTask ID:\t" . $self->counter . "\n";
328             }
329              
330 0           $self->log_cmd_messages(
331             "info",
332             "Starting Job:\n"
333             . "================================================"
334             . "\nJobID:\t"
335             . $self->job_scheduler_id
336             . " \nCmdPID:\t"
337             . $cmdpid
338             . "\nHostname:\t"
339             . $self->hostname
340             . "\nJob Scheduler ID:\t"
341             . $self->job_scheduler_id
342             . "$log_array_msg\n",
343             $cmdpid
344             );
345              
346             #TODO counter is not terribly applicable with task ids
347 0           $self->log_cmd_messages(
348             "info",
349             "Starting execution: "
350             . $self->counter
351             . "\n\nCOMMAND:\n\n"
352             . $self->cmd . "\n\n",
353             $cmdpid
354             );
355             }
356              
357             sub pop_note_meta {
358 0     0 0   my $self = shift;
359              
360 0           my $lines = $self->cmd;
361 0 0         return unless $lines;
362 0           my @lines = split( "\n", $lines );
363 0           my @ts = ();
364              
365 0           foreach my $line (@lines) {
366 0 0         next unless $line;
367 0 0         next unless $line =~ m/^#TASK/;
368              
369 0           my ( @match, $t1, $t2 );
370 0           @match = $line =~ m/TASK (\w+)=(.+)$/;
371 0           ( $t1, $t2 ) = ( $match[0], $match[1] );
372              
373             #$DB::single = 2;
374 0 0         if ($t1) {
375 0 0         if ( $t1 eq "tags" ) {
    0          
376 0           my @tmp = split( ",", $t2 );
377 0           map { push( @ts, $_ ) } @tmp;
  0            
378             }
379             elsif ( $t1 eq "deps" ) {
380 0           my @tmp = split( ",", $t2 );
381 0           map { push( @ts, $_ ) } @tmp;
  0            
382             }
383             else {
384             #We should give a warning here
385 0           $self->$t1($t2);
386 0           $self->log_main_messages( 'debug',
387             "Command:\n\t"
388             . $self->cmd
389             . "\nHas invalid #TASK attribute. Should be #TASK tags=thing1,thing2 or #TASK deps=thing1,thing2"
390             );
391             }
392             }
393             }
394 0           return \@ts;
395             }
396              
397             1;