File Coverage

blib/lib/HPC/Runner/Command/execute_job/Utils/MemProfile.pm
Criterion Covered Total %
statement 24 99 24.2
branch 0 30 0.0
condition 0 3 0.0
subroutine 8 14 57.1
pod 2 4 50.0
total 34 150 22.6


line stmt bran cond sub pod time code
1             package HPC::Runner::Command::execute_job::Utils::MemProfile;
2              
3 1     1   823 use Moose::Role;
  1         3  
  1         12  
4 1     1   8518 use IPC::Cmd qw[can_run];
  1         5  
  1         90  
5 1     1   553 use Number::Bytes::Human qw(format_bytes parse_bytes);
  1         3014  
  1         96  
6 1     1   11 use Memoize;
  1         4  
  1         63  
7 1     1   9 use Path::Tiny;
  1         4  
  1         60  
8 1     1   8 use DateTime;
  1         3  
  1         29  
9 1     1   155 use Try::Tiny;
  1         6  
  1         282  
10 1     1   11 use Capture::Tiny ':all';
  1         3  
  1         1650  
11              
12             has 'task_start_time' => (
13             is => 'rw',
14             required => 0,
15             );
16              
17             has 'task_mem_data' => (
18             is => 'rw',
19             isa => 'HashRef',
20             default => sub { return {} },
21             );
22              
23             has 'can_pstree' => (
24             is => 'rw',
25             isa => 'Num',
26             default => sub {
27             return 1 if can_run('pstree');
28             return 0;
29             }
30             );
31              
32             sub get_cmd_stats {
33 0     0 0   my $self = shift;
34 0           my $cmdpid = shift;
35              
36 0 0         return unless $self->can_pstree;
37 0           my $cmd = "pstree -p $cmdpid";
38              
39 0           my $child_pids = `$cmd`;
40              
41 0           my (@cmdpids) = $child_pids =~ m/\((\d+)\)/g;
42 0           push( @cmdpids, $cmdpid );
43              
44 0           my $found_stats = 0;
45 0           my $total_stats_data = {
46             vmpeak => 0,
47             vmsize => 0,
48             vmhwm => 0,
49             vmrss => 0,
50             };
51              
52 0           foreach my $cmdpid (@cmdpids) {
53 0           my $stats_file = path("/proc/$cmdpid/status");
54              
55 0 0         next unless $stats_file->exists;
56              
57 0           my $data;
58             try {
59 0     0     $data = $stats_file->slurp_utf8;
60 0           };
61              
62 0 0         next unless $data;
63 0 0 0       if ( $data =~ m/State: R/ || $data =~ m/State.*run/ ) {
64              
65 0           my $stats = parse_proc_file_data($data);
66             ##Add up the procs of all the children
67 0           $total_stats_data = add_proc_stats( $total_stats_data, $stats );
68 0           $found_stats = 1;
69             }
70             }
71              
72 0 0         $self->compare_proc_stats($total_stats_data) if $found_stats;
73             }
74              
75             =head3 compare_proc_stats
76              
77             Compare the proc stats to the most recent
78             Only record those that are self->memory_diff different
79              
80             =cut
81              
82             sub compare_proc_stats {
83 0     0 1   my $self = shift;
84 0           my $stats_data = shift;
85 0           my @stats = ( 'vmpeak', 'vmrss', 'vmsize', 'vmhwm' );
86              
87 0           foreach my $stat (@stats) {
88 0 0         if ( !exists $self->task_mem_data->{recent}->{$stat} ) {
    0          
89 0           $self->task_mem_data->{recent}->{$stat} = $stats_data->{$stat};
90 0           $self->task_mem_data->{count}->{$stat} = 1;
91 0           $self->task_mem_data->{high}->{$stat} = $stats_data->{$stat};
92 0           $self->task_mem_data->{low}->{$stat} = $stats_data->{$stat};
93 0           $self->task_mem_data->{mean}->{$stat} = $stats_data->{$stat};
94              
95 0           $self->add_stats_to_archive( $stat, $stats_data->{$stat} );
96             }
97             elsif (
98             $self->task_mem_data->{recent}->{$stat} == $stats_data->{$stat} )
99             {
100 0           next;
101             }
102             else {
103 0           my $old = $self->task_mem_data->{recent}->{$stat};
104 0           my $new = $stats_data->{$stat};
105 0           my $diff = $new * $self->memory_diff;
106 0           my $perc_diff = ( $old - $new ) / $old;
107 0           $perc_diff = abs($perc_diff);
108 0 0         if ( $perc_diff > $self->memory_diff ) {
109 0           $self->task_mem_data->{recent}->{$stat} = $new;
110              
111 0           $self->task_mem_data->{count}->{$stat} += 1;
112             $self->task_mem_data->{high}->{$stat} = $new
113              
114 0 0         if $new > $self->task_mem_data->{high}->{$stat};
115             $self->task_mem_data->{low}->{$stat} = $new
116 0 0         if $new < $self->task_mem_data->{low}->{$stat};
117              
118             my $mean = ( $self->task_mem_data->{mean}->{$stat} + $new ) /
119 0           $self->task_mem_data->{count}->{$stat};
120 0           $self->task_mem_data->{mean}->{$stat} = $mean;
121 0           $self->add_stats_to_archive( $stat, $stats_data->{$stat} );
122             }
123             }
124             }
125              
126             }
127              
128             sub add_stats_to_archive {
129 0     0 0   my $self = shift;
130 0           my $stat_key = shift;
131 0           my $stat_value = shift;
132              
133 0           my $dt1 = $self->task_start_time;
134 0           my $dt2 = DateTime->now( time_zone => 'local' );
135 0           my $dur = $dt2->subtract_datetime_absolute($dt1);
136              
137 0           my $new_content = $dur->seconds . "\t" . $stat_value . "\n";
138              
139 0           my $basename = $self->data_tar->basename('.tar.gz');
140 0           my $file = File::Spec->catdir( $basename, $self->task_jobname,
141             $self->counter . '.' . $stat_key );
142              
143 0 0         if ( $self->archive->contains_file($file) ) {
144 0           my $content = $self->archive->get_content($file);
145 0           $content .= $new_content;
146 0           $self->archive->replace_content( $file, $content );
147             }
148             else {
149 0           $self->archive->add_data( $file, $new_content );
150             }
151              
152             capture {
153 0     0     $self->archive->write( $self->data_tar, 1 );
154 0           };
155             }
156              
157             =head3 add_proc_stats
158              
159             Sum up all the pids and child pids from the proc
160              
161             =cut
162              
163             memoize('add_proc_stats');
164              
165             sub add_proc_stats {
166             my $total_stats_data = shift;
167             my $proc_data = shift;
168              
169             $total_stats_data->{vmpeak} =
170             $total_stats_data->{vmpeak} + $proc_data->{vmpeak};
171             $total_stats_data->{vmrss} =
172             $total_stats_data->{vmrss} + $proc_data->{vmrss};
173             $total_stats_data->{vmsize} =
174             $total_stats_data->{vmsize} + $proc_data->{vmsize};
175             $total_stats_data->{vmhwm} =
176             $total_stats_data->{vmhwm} + $proc_data->{vmhwm};
177              
178             return $total_stats_data;
179             }
180              
181             =head3 parse_proc_file_data
182             Get the data from the proc file
183             If it is in a running state it might look like This
184             # VmPeak: 4491304 kB
185             # VmSize: 4491304 kB
186             ..
187             # VmHWM: 919748 kB
188             # VmRSS: 919748 kB
189             =cut
190              
191             sub parse_proc_file_data {
192 0     0 1   my $data = shift;
193              
194 0           my $human = Number::Bytes::Human->new(
195             bs => 1000,
196             round_style => 'round',
197             precision => 2
198             );
199              
200 0           my ( $vmpeak, $vmsize, $vmhwm, $vmrss ) = ( 0, 0, 0, 0 );
201 0           my ( $punit, $sunit, $hunit, $runit ) = ( '', '', '', '' );
202              
203             ##I think these are always in kb, but I am not sure
204 0           ( $vmpeak, $punit ) = $data =~ m/VmPeak:\s+(\d+)\s+(\w+)/;
205 0           ( $vmsize, $sunit ) = $data =~ m/VmSize:\s+(\d+)\s+(\w+)/;
206 0           ( $vmhwm, $hunit ) = $data =~ m/VmHWM:\s+(\d+)\s+(\w+)/;
207 0           ( $vmrss, $runit ) = $data =~ m/VmRSS:\s+(\d+)\s+(\w+)/;
208              
209 0 0         $vmpeak = parse_bytes( $vmpeak . $punit ) if $vmpeak;
210 0 0         $vmsize = parse_bytes( $vmsize . $sunit ) if $vmsize;
211 0 0         $vmhwm = parse_bytes( $vmhwm . $hunit ) if $vmhwm;
212 0 0         $vmrss = parse_bytes( $vmrss . $runit ) if $vmrss;
213              
214             return {
215 0           vmpeak => $vmpeak,
216             vmsize => $vmsize,
217             vmhwm => $vmhwm,
218             vmrss => $vmrss
219             };
220             }
221              
222             1;