File Coverage

blib/lib/X10/Server.pm

Criterion	Covered	Total	%
statement	21	98	21.4
branch	0	24	0.0
condition	0	10	0.0
subroutine	7	16	43.7
pod	0	6	0.0
total	28	154	18.1

package X10::Server;

# this is a network server object that accepts connections via a TCP
# socket and relays the 'event requests' to an
# X10::Controller-type object

use File::Basename;
use FileHandle;
use IO::Socket;
use Storable qw(thaw);

use strict;

use X10::Event;
use X10::EventList;

sub new
{
   my $type = shift;

   my $self = bless { @_ }, $type;

   return undef unless ( $self->{controller} );

   $self->{server_port} ||= 2020;
   $self->{logger} ||= sub { $self->syslog(@_) };

   $self->{logger}->('info', "Using TCP port %s", $self->{server_port})
	if $self->{debug};

   $self->{listen_socket} = new IO::Socket(
        Domain => &AF_INET,
        Proto => 'tcp',
        LocalPort => $self->{server_port},
        Listen => 5,
        Reuse => 1,
        MultiHomed => 1,
        );

   unless ($self->{listen_socket})
   {
      warn "Problem listening on socket: ", $!;
      return undef;
   }

   $self->{connected_sockets} = [];

   $self->{controller}->register_listener($self->event_callback);

   $SIG{PIPE} = sub {};		# Ignore SIGPIPE

   return $self;
}

sub select_fds
{
   my $self = shift;

   @{$self->{connected_sockets}} =
	grep {$_}
	@{$self->{connected_sockets}};

   return
	map { $_->fileno }
	($self->{listen_socket}, @{$self->{connected_sockets}});
}

sub handle_input
{
   my $self = shift;

   my $allfd = '';
   foreach ($self->select_fds) { vec($allfd, $_, 1) = 1; }

   my $reads;
   my $errors;

   my $fdcount = select($reads=$allfd, undef, $errors=$allfd, 0);

   return unless ($fdcount);

   FILEHANDLE:
   foreach (@{$self->{connected_sockets}})
   {
      # if ( ord($reads) & (1 << $_->fileno) )
      if ( vec($reads, $_->fileno, 1) )
      {
         my $size;
         my $bytes_read = $_->sysread($size, 1);

         unless ($bytes_read == 1)
         {
            $self->{logger}->('info',
		"Disconnecting socket %s", $_->fileno) if $self->{debug};
            undef $_;
            next FILEHANDLE;
         }

         $size = ord($size);

         my $packet = '';
         $bytes_read = $_->sysread($packet, $size);

         unless ($bytes_read == $size)
         {
            warn "Error reading packet on socket %s", $_->fileno;
            undef $_;
            next FILEHANDLE;
         }

         my $event = thaw($packet);

         next FILEHANDLE unless $event;

         if ($event->isa('X10::Event') || $event->isa('X10::EventList'))
         {
            $self->{logger}->('info', "From %s: %s",
		gethostbyaddr($_->peeraddr, AF_INET) || $_->peerhost,
		$event->as_string
		);
            $self->{controller}->send($event);
         }
         else
         {
            $self->{logger}->('info', "Unknown packet type: %s", ref $event);
         }
      }
   }

   if ( ord($reads) & (1 << $self->{listen_socket}->fileno) )
   {
      my $newsocket = $self->{listen_socket}->accept;
      $self->{logger}->('info', "New connection on %s", $newsocket->fileno) if $self->{debug};
      push @{$self->{connected_sockets}}, $newsocket;
   }

}

sub event_callback
{
   my $self = shift;
   return sub { $self->handle_event(shift) };
}

sub handle_event
{
   my $self = shift;
   my $event = shift;
   my $packet = $event->nfreeze;

   foreach (@{$self->{connected_sockets}})
   {
      $_->syswrite(chr(length($packet)), 1);
      $_->syswrite($packet, length($packet));
   }
}


###

sub syslog
{
   my $level = shift;
   my $format = shift;
   my $message = sprintf($format, @_);

   my $facility = "local5";
   my $tag = sprintf "%s[%s]",
        basename($0, ".pl"),
        $$,
        ;

   my $fh = new FileHandle;
   $fh->open("|/usr/bin/logger -p $facility.$level -t $tag");

   $fh->print($message);

   $fh->close;
}




1;