view release on metacpan or  search on metacpan

FDkeeper/Server.pm  view on Meta::CPAN

package File::FDkeeper::Server ;
@ISA = qw(File::FDkeeper) ;

use strict ;
use File::FDpasser ;
use File::FDkeeper ;
use Digest::MD5 qw(md5_hex) ;
use IO::Select ;
use Carp ;


sub new {
	my $class = shift ;
	my $path = shift ;
	my %args = @_ ;

	my $this = {} ;
	$this->{path} = $path ;
	$this->{timeout} = delete $args{AccessTimeout} || undef ;
	$this->{timeout_check} = delete $args{AccessTimeoutCheck} || undef ;
	bless($this, $class) ;

	while (my ($k, $v) = each %args){
		croak("Invalid attribute '$k'") ;
	}

	if (-e $path){
		croak("Can't unlink '$path': $!") unless unlink($path) ;
	}
	my $server = endp_create($path) ;
	croak("Error creating server endpoint '$path': $!") unless $server ;

	$this->{server} = $server ;
	$this->{next_fhid} = 1 ;
	$this->{locker} = {} ;

	return $this ;
}


sub DESTROY {
	my $this = shift ;

	close($this->{server}) unless ! defined($this->{server}) ;
}


sub run {
	my $this = shift ;
	my $llfh = shift ;

	my $select = new IO::Select($this->{server}) ;
	# Add the lifeline filehandle
	$select->add($llfh) if $llfh ;

	while (1){
		my @ready = $select->can_read($this->{timeout_check}) ;
		foreach my $fh (@ready){
			if (($llfh)&&($fh eq $llfh)){
				# The lifeline is broken, so we die also.
				CORE::exit(0) ;
			}
			elsif ($fh eq $this->{server}){
				my $client = serv_accept_fh($fh) ;
				next if ! defined($client) ;
				$client->autoflush(1) ;
				$select->add($client) ;
			}
			else {
				my @resp = () ;
				eval {
					my $cmd = $this->_read_command($fh) ;
					if (! defined($cmd)){
						$select->remove($fh) ;
						no warnings ;
						next ;
					}

					if ($cmd eq 'put'){
						my $recvd_fh = recv_fh($fh) or die("Error receiving filehandle: $!") ;
						my $fhid = $this->put($recvd_fh) ;
						@resp = (1, $fhid, undef) ;
					}
					elsif ($cmd eq 'get'){
						my $fhid = <$fh> ;
						chomp($fhid) ;
						my $sent_fh = $this->get($fhid) ;
						@resp = ($sent_fh ? 
							(1, '', $sent_fh) : 
							(0, "Unknown filehandle '$fhid'", undef)) ;
					}