File Coverage

blib/lib/SHARYANTO/Proc/Util.pm
Criterion Covered Total %
statement 31 43 72.0
branch 6 16 37.5
condition 3 7 42.8
subroutine 4 4 100.0
pod 1 1 100.0
total 45 71 63.3


line stmt bran cond sub pod time code
1             package SHARYANTO::Proc::Util;
2              
3 1     1   2619 use 5.010001;
  1         3  
  1         40  
4 1     1   5 use strict;
  1         1  
  1         27  
5 1     1   5 use warnings;
  1         1  
  1         535  
6              
7             require Exporter;
8             our @ISA = qw(Exporter);
9             our @EXPORT_OK = qw(get_parent_processes);
10              
11             our $VERSION = '0.61'; # VERSION
12              
13             sub get_parent_processes {
14 1     1 1 892 my ($pid, $opts) = @_;
15 1   33     8 $pid //= $$;
16 1   50     4 $opts //= {};
17              
18 1         2 my %proc;
19 1 50 50     8 if (($opts->{method} // 'proctable') eq 'pstree') {
20             # things will be simpler if we use the -s option, however not all
21             # versions of pstree supports it. -l is for --long (to avoid pstree to
22             # cut its output at 132 cols)
23              
24 0         0 my @lines = `pstree -pAl`;
25 0 0       0 return undef unless @lines;
26              
27 0         0 my @p;
28 0         0 for (@lines) {
29 0         0 my $i = 0;
30 0         0 while (/(?: (\s*(?:\|-?|`-)) | (.+?)\((\d+)\) )
31             (?: -[+-]- )?/gx) {
32 0 0       0 unless ($1) {
33 0         0 my $p = {name=>$2, pid=>$3};
34 0         0 $p[$i] = $p;
35 0 0       0 $p->{ppid} = $p[$i-1]{pid} if $i > 0;
36 0         0 $proc{$3} = $p;
37             }
38 0         0 $i++;
39             }
40             }
41             #use Data::Dump; dd \%proc;
42             } else {
43 1         2 eval { require Proc::ProcessTable };
  1         730  
44 1 50       9277 return undef if $@;
45              
46 1         11 state $pt = Proc::ProcessTable->new;
47 1         2535 for my $p (@{ $pt->table }) {
  1         2263  
48 10         60 $proc{ $p->{pid} } = {
49             name=>$p->{fname}, pid=>$p->{pid}, ppid=>$p->{ppid},
50             };
51             }
52             }
53              
54 1         4 my @p = ();
55 1         4 my $cur_pid = $pid;
56 1         1 while (1) {
57 10 50       24 return if !$proc{$cur_pid};
58 10 50       27 $proc{$cur_pid}{name} = $1 if $proc{$cur_pid}{name} =~ /\A\{(.+)\}\z/;
59 10         13 push @p, $proc{$cur_pid};
60 10         14 $cur_pid = $proc{$cur_pid}{ppid};
61 10 100       20 last unless $cur_pid;
62             }
63 1         2 shift @p; # delete cur process
64              
65 1         14 \@p;
66             }
67              
68             # ABSTRACT: OS-process-related routines
69              
70             __END__