IPC::PidStat::PidServer - Process ID existence server

  use IPC::PidStat::PidServer;

  IPC::PidStat::PidServer->new(port=>1234)->start_server;

  # Or more typically via the command line
  pidstatd

# See copyright, etc in below POD section.
######################################################################

package IPC::PidStat::PidServer;
require 5.004;
require Exporter;
@ISA = qw(Exporter);

use IPC::Locker;
use Socket;
use IO::Socket;

use strict;
use vars qw($VERSION $Debug $Hostname);
use Carp;

######################################################################
#### Configuration Section

# Other configurable settings.
$Debug = 0;

$VERSION = '1.488';

$Hostname = IPC::Locker::hostfqdn();

######################################################################
#### Creator

sub new {
    # Establish the server
    @_ >= 1 or croak 'usage: IPC::PidStat::PidServer->new ({options})';
    my $proto = shift;
    my $class = ref($proto) || $proto;
    my $self = {
	#Documented
	port=>$IPC::Locker::Default_PidStat_Port,
	@_,};
    bless $self, $class;
    return $self;
}

sub start_server {
    my $self = shift;

    # Open the socket
    print "Listening on $self->{port}\n" if $Debug;
    my $server = IO::Socket::INET->new( Proto     => 'udp',
					LocalPort => $self->{port},
					Reuse     => 1)
	    or die "$0: Error, socket: $!";

    while (1) {
	my $in_msg;
	next unless $server->recv($in_msg, 8192);
	print "Got msg $in_msg\n" if $Debug;
	my ($cmd,@param) = split /\s+/, $in_msg;  # We rely on the newline to terminate the split
	# We ignore unknown parameters for forward compatibility
	# PIDR (\d+) (\S+) ([0-7])	# PID request, format after 1.480
	# PIDR (\d+) (\S+)		# PID request, format after 1.461
	# PIDR (\d+)			# PID request, format before 1.461
	if ($cmd eq 'PIDR') {
	    my $pid = $param[0];
	    my $host = $param[1] || $Hostname;  # Loop the host through, as the machine may have multiple names
	    my $which = $param[2] || 3;
	    $! = undef;
	    my $exists = IPC::PidStat::local_pid_exists($pid);
	    if ($exists) {
		if ($which & 1) {
		    my $out_msg = "EXIS $pid $exists $host";  # PID response
		    print "   Send msg $out_msg\n" if $Debug;
		    $server->send($out_msg);  # or die... But we'll ignore errors
		}
	    } elsif (defined $exists) {  # Known not to exist
		if ($which & 2) {
		    my $out_msg = "EXIS $pid $exists $host";  # PID response
		    print "   Send msg $out_msg\n" if $Debug;
		    $server->send($out_msg);  # or die... But we'll ignore errors
		}
	    } else {  # Perhaps we're not running as root?
		if ($which & 4) {
		    my $out_msg = "UNKN $pid na $host";  # PID response
		    print "   Send msg $out_msg\n" if $Debug;
		    $server->send($out_msg);  # or die... But we'll ignore errors
		}
	    }
	}
    }
}

######################################################################
#### Package return
1;

######################################################################