view release on metacpan or  search on metacpan

lib/Proc/ProcessTable/piddler.pm  view on Meta::CPAN

	my $self    = $_[0];
	my $holders = $_[1];
	my $key     = $_[2];
	my $pid     = $_[3];

	foreach my $direction ( 'w', 'r' ) {
		foreach my $holder_pid ( keys %{ $holders->{$key}{$direction} } ) {
			if ( $holder_pid ne $pid ) {
				return 0;
			}
		}
	}

	return 1;
} ## end sub _pipeIsSelfOnly

#
# Returns true if the file from _lsof is a unix socket.
#
sub _isUnix {
	my $self = $_[0];
	my $file = $_[1];

	if ( !defined($file) ) {
		return 0;
	}

	if ( $file->{type} =~ /^[Uu][Nn][Ii][Xx]$/ ) {
		return 1;
	}

	return 0;
} ## end sub _isUnix

#
# Renders the SIZE/OFF column for a file from _lsof. Only a size is worth
# making readable, a offset being a position rather than a amount, and
# lsof marks those out by printing them as 0t<decimal> or 0x<hex>.
#
sub _sizeString {
	my $self = $_[0];
	my $file = $_[1];

	if (   ( $self->{human_size} )
		&& ( $file->{size} =~ /^[0-9]+$/ ) )
	{
		return $self->memString( $file->{size}, 'size' );
	}

	return color( $self->{file_colors}[3] ) . $file->{size_off} . color('reset');
} ## end sub _sizeString

#
# Renders a UID as the user it belongs to with the number after it,
# falling back to just the number for any that can't be looked up.
#
sub _userString {
	my $self = $_[0];
	my $uid  = $_[1];

	my $user = getpwuid($uid);
	if ( !defined($user) ) {
		return color( $self->{idColors}[0] ) . $uid . color('reset');
	}

	return
		  color( $self->{idColors}[0] )
		. $user
		. color( $self->{idColors}[1] ) . '('
		. color( $self->{idColors}[2] )
		. $uid
		. color( $self->{idColors}[1] ) . ')'
		. color('reset');
} ## end sub _userString

#
# The same as _userString, for a GID and the group it belongs to.
#
sub _groupString {
	my $self = $_[0];
	my $gid  = $_[1];

	my $group = getgrgid($gid);
	if ( !defined($group) ) {
		return color( $self->{idColors}[0] ) . $gid . color('reset');
	}

	return
		  color( $self->{idColors}[0] )
		. $group
		. color( $self->{idColors}[1] ) . '('
		. color( $self->{idColors}[2] )
		. $gid
		. color( $self->{idColors}[1] ) . ')'
		. color('reset');
} ## end sub _groupString

#
# Returns a hash ref of the parameters jls reports for a JID, which is
# cached for the duration of the run as any number of processes may be
# in the same jail. Undef is returned for the host, anything that is not
# FreeBSD, and any jail that could not be looked up.
#
sub _jailInfo {
	my $self = $_[0];
	my $jid  = $_[1];

	if (   ( $^O !~ /freebsd/ )
		|| ( !defined($jid) )
		|| ( $jid !~ /^[0-9]+$/ )
		|| ( $jid == 0 ) )
	{
		return undef;
	}

	if ( exists( $self->{jails}{$jid} ) ) {
		return $self->{jails}{$jid};
	}
	# noted as looked up either way, so a jail that is not there is not
	# asked after over and over
	$self->{jails}{$jid} = undef;