view release on metacpan or  search on metacpan

t/01-func.t  view on Meta::CPAN

    cmp_ok( scalar(@proc), '<',  $all_procs, "rgid $bigger smaller than count of all processes" );
    cmp_ok( scalar(@proc), '<=', $biggest_rgid, "rgid $bigger smaller or equal to rgid $biggest" );
}

# process groups
SKIP: {
    skip( "not supported on FreeBSD 4.x", 6 )
        if $RUNNING_ON_FREEBSD_4;
    # count the processes in each process group
    my %pgid;
    for my $pid (@all) {
        my $proc = BSD::Process->new($pid);
        $pgid{$proc->{pgid}}++ if defined $proc->{pgid};
    }

    # now find the process groups with the most members
    my ($biggest, $bigger) = (sort {$pgid{$b} <=> $pgid{$a} || $a <=> $b} keys %pgid )[0,1];

    my @proc = BSD::Process::list( pgid => $biggest );
    cmp_ok( scalar(@proc), '<', $all_procs, "pgid $biggest smaller than count of all processes" );

    my $biggest_pgid = @proc;
    @proc = BSD::Process::list( process_group_id => $bigger );
    cmp_ok( scalar(@proc), '<',  $all_procs, "pgid $bigger smaller than count of all processes" );
    cmp_ok( scalar(@proc), '<=', $biggest_pgid, "pgid $bigger smaller or equal to pgid $biggest" );

    # process sessions
    # count the processes in each process session
    my %sid;
    for my $pid (@all) {
        my $proc = BSD::Process->new($pid);
        $sid{$proc->{sid}}++ if defined $proc->{sid};
    }

    # now find the process groups with the most members
    ($biggest, $bigger) = (sort {$sid{$b} <=> $sid{$a} || $a <=> $b} keys %sid )[0,1];

    @proc = BSD::Process::list( sid => $biggest );
    cmp_ok( scalar(@proc), '<', $all_procs, "sid $biggest smaller than count of all processes" );

    my $biggest_sid = @proc;
    @proc = BSD::Process::list( process_session_id => $bigger );
    cmp_ok( scalar(@proc), '<',  $all_procs, "sid $bigger smaller than count of all processes" );
    cmp_ok( scalar(@proc), '<=', $biggest_sid, "sid $bigger smaller or equal to sid $biggest" );
}

$info = BSD::Process::info($$);
is( $info->{pid}, $$, "system says my pid is the same ($$)" );
isnt( $info->{pid}, $info->{ppid}, 'I am not my parent' );

my $parent = BSD::Process::info($info->{ppid});
is( $parent->{pid}, $info->{ppid}, 'my parent is indeed my parent' );
isnt( $info->{pid}, $parent->{ppid}, 'I am not my grandparent' );
isnt( $parent->{pid}, $parent->{ppid}, 'and my parent is not my grandparent' );

SKIP: {
    skip( "not supported on FreeBSD 4.x", 6 )
        if $RUNNING_ON_FREEBSD_4;

    my $resolved = BSD::Process::info({resolve => 1});
    is( $resolved->{uid}, scalar(getpwuid($info->{uid})), 'resolve implicit pid' );

    $resolved = BSD::Process::info($info->{pid}, {resolve => 1});
    is( $resolved->{uid}, scalar(getpwuid($info->{uid})), 'resolve explicit pid' );

    my $root = BSD::Process::all( uid => 'root' );
    my $uid_root_count = 0;
    $root->{$_}->uid == 0 and ++$uid_root_count for keys %$root;
    is( $uid_root_count, scalar(keys %$root), q{counted all uid root's processes} );

    $root = BSD::Process::all( effective_user_id => 'root' );
    $uid_root_count = 0;
    $root->{$_}->uid == 0 and ++$uid_root_count for keys %$root;
    is( $uid_root_count, scalar(keys %$root), q{counted all effective uid root's processes} );

    $root = BSD::Process::all( ruid => 'root' );
    $uid_root_count = 0;
    for (keys %$root) {
        if ($root->{$_}->uid == 0) {
            ++$uid_root_count;
        }
        elsif ($root->{$_}->ruid == 0) {
            ++$uid_root_count;
            $ENV{PERL_AUTHOR_TESTING}
                and diag("root proc $_ has uid " . $root->{$_}->uid . "/" . $root->{$_}->ruid  );
        }
    }
    is( $uid_root_count, scalar(keys %$root), q{counted all ruid root's processes} );

    $root = BSD::Process::all( real_user_id => 'root' );
    $uid_root_count = 0;
    $root->{$_}->ruid == 0 and ++$uid_root_count for keys %$root;
    is( $uid_root_count, scalar(keys %$root), q{counted all real_user_id root's processes} );
}

SKIP: {
    skip( "not supported on FreeBSD 4.x or 5.x", 2 )
        if $RUNNING_ON_FREEBSD_4 or $RUNNING_ON_FREEBSD_5;

    my $wheel_gid = getgrnam('wheel');
    {
        my $wheel = BSD::Process::all( gid => 'wheel' );
        my $gid_wheel_count = 0;
        for my $pid (keys %$wheel) {
            my $proc = $wheel->{$pid};
            if ($proc->rgid == $wheel_gid) {
                 ++$gid_wheel_count;
            }
            else {
                my $msg = "$proc->{comm}($proc->{pid}) has rgid $proc->{rgid} not $wheel_gid";
                if ($proc->{comm} eq 'sshd') {
                    # sshd uses process separation, which throws this off
                    ++$gid_wheel_count;
                    $msg .= " (pass)";
                }
                $ENV{PERL_AUTHOR_TESTING} and diag( $msg );
            }
        }
        is( $gid_wheel_count, scalar(keys %$wheel), q{counted all gid wheel's processes} );
    }

    {
        my $wheel = BSD::Process::all( effective_group_id => 'wheel' );
        my $gid_wheel_count = 0;