File Coverage

blib/lib/Proc/Find/Parents.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

package Proc::Find::Parents;

our $DATE = '2014-12-05'; # DATE
our $VERSION = '0.62'; # VERSION

use 5.010001;
use strict;
use warnings;

require Exporter;
our @ISA       = qw(Exporter);
our @EXPORT_OK = qw(get_parent_processes);

sub get_parent_processes {
    my ($pid, $opts) = @_;
    $pid //= $$;
    $opts //= {};

    my %proc;
    if (($opts->{method} // 'proctable') eq 'pstree') {
        # things will be simpler if we use the -s option, however not all
        # versions of pstree supports it. -l is for --long (to avoid pstree to
        # cut its output at 132 cols)

        my @lines = `pstree -pAl`;
        return undef unless @lines;

        my @p;
        for (@lines) {
            my $i = 0;
            while (/(?: (\s*(?:\|-?|`-)) | (.+?)\((\d+)\) )
                    (?: -[+-]- )?/gx) {
                unless ($1) {
                    my $p = {name=>$2, pid=>$3};
                    $p[$i] = $p;
                    $p->{ppid} = $p[$i-1]{pid} if $i > 0;
                    $proc{$3} = $p;
                }
                $i++;
            }
        }
        #use Data::Dump; dd \%proc;
    } else {
        eval { require Proc::ProcessTable };
        return undef if $@;

        state $pt = Proc::ProcessTable->new;
        for my $p (@{ $pt->table }) {
            $proc{ $p->{pid} } = {
                name=>$p->{fname}, pid=>$p->{pid}, ppid=>$p->{ppid},
            };
        }
    }

    my @p = ();
    my $cur_pid = $pid;
    while (1) {
        return if !$proc{$cur_pid};
        $proc{$cur_pid}{name} = $1 if $proc{$cur_pid}{name} =~ /\A\{(.+)\}\z/;
        push @p, $proc{$cur_pid};
        $cur_pid = $proc{$cur_pid}{ppid};
        last unless $cur_pid;
    }
    shift @p; # delete cur process

    \@p;
}

# ABSTRACT: Find parents of a process (up to the root)

__END__