File Coverage

blib/lib/Linux/GetPidstat/Reader.pm
Criterion Covered Total %
statement 59 61 96.7
branch 14 14 100.0
condition 5 6 83.3
subroutine 11 12 91.6
pod 0 3 0.0
total 89 96 92.7


line stmt bran cond sub pod time code
1             package Linux::GetPidstat::Reader;
2 14     14   50509 use 5.008001;
  14         44  
3 14     14   59 use strict;
  14         27  
  14         230  
4 14     14   58 use warnings;
  14         27  
  14         255  
5              
6 14     14   89 use Carp;
  14         38  
  14         700  
7 14     14   889 use Capture::Tiny qw/capture/;
  14         36584  
  14         594  
8 14     14   1953 use Path::Tiny qw/path/;
  14         24197  
  14         6301  
9              
10             sub new {
11 53     53 0 19933 my ( $class, %opt ) = @_;
12 53         325 bless \%opt, $class;
13             }
14              
15             sub get_program_pid_mapping {
16 52     52 0 3718 my $self = shift;
17              
18 52         441 my $pid_dir = path($self->{pid_dir});
19              
20 52         1860 my @program_pid_mapping;
21 52         310 for my $pid_file ($pid_dir->children) {
22 104         11373 chomp(my $pid = $pid_file->slurp);
23 104 100       19114 unless (_is_valid_pid($pid)) {
24 26         66 next;
25             }
26              
27 78         172 my @pids;
28 78         219 push @pids, $pid;
29              
30 78 100       278 if ($self->{include_child}) {
31 76         286 my $child_pids = $self->search_child_pids($pid);
32 76         326 push @pids, @$child_pids;
33             }
34              
35 78         1077 push @program_pid_mapping, {
36             program_name => $pid_file->basename,
37             pids => \@pids,
38             };
39             }
40              
41 52         2450 return \@program_pid_mapping;
42             }
43              
44             sub search_child_pids {
45 76     76 0 241 my ($self, $pid) = @_;
46 76         393 my $command = _command_search_child_pids($pid);
47 76     76   3622 my ($stdout, $stderr, $exit) = capture { system $command };
  76         249227  
48              
49 76 100 66     66492 if (length $stderr or $exit != 0) {
50 1         6 chomp ($stderr);
51 1         130 carp "Failed a command: $command, stdout=$stdout, stderr=$stderr, exit=$exit";
52             }
53 76 100       368 unless (length $stdout) {
54 1         6 return [];
55             }
56              
57 75         248 my @child_pids;
58              
59 75         1450 my @lines = split '\n', $stdout;
60 75         275 for (@lines) {
61 1925         5358 while (/[^}]\((\d+)\)/g) {
62 260         792 my $child_pid = $1;
63 260 100       986 next if $child_pid == $pid;
64              
65             # TODO: Remove the limit.
66             ## FIXME: Replace calling pidstat with reading /proc manually
67 185         359 my $max = $self->{max_child_limit};
68 185 100 100     498 if ($max && $max <= scalar @child_pids) {
69 2         243 carp "Stop searching child pids. max_child_limit is too little. pid=$pid";
70 2         87 last;
71             }
72 183         974 push @child_pids, $child_pid;
73             }
74             }
75 75         1057 return \@child_pids;
76             }
77              
78             # for mock in tests
79             sub _command_search_child_pids {
80 0     0   0 my $pid = shift;
81 0         0 return "pstree -pn $pid";
82             }
83              
84             sub _is_valid_pid {
85 104     104   307 my $pid = shift;
86 104 100       756 unless ($pid =~ /^[0-9]+$/) {
87 26         2053 carp "invalid pid: $pid";
88 26         2213 return 0;
89             }
90 78         341 return 1;
91             }
92              
93             1;
94             __END__