File Coverage

blib/lib/WWW/Slides/Controller/TCP.pm

Criterion	Covered	Total	%
statement	50	50	100.0
branch	4	4	100.0
condition	2	3	66.6
subroutine	13	13	100.0
pod	4	4	100.0
total	73	74	98.6

package WWW::Slides::Controller::TCP;
{

   use version; our $VERSION = qv('0.0.9');

   use warnings;
   use strict;
   use Carp;
   use English qw( -no_match_vars );

   use Object::InsideOut qw( WWW::Slides::Controller::Multiple );
   use WWW::Slides::Controller::Single;
   use IO::Socket;

   # Module implementation here
   my @port : Field   # Port to listen to
     : Std(Name => 'port', Private => 1) : Get(Name => 'port')
     : Arg(Name => 'port', Mandatory => 1);
   my @door : Field   # to accept connections
     : Std(Name => 'door', Private => 1);

   sub _init : Init {
      my $self = shift;
      my $sock = IO::Socket::INET->new(
         Proto => 'tcp',
         LocalPort => $self->port(),
         Listen => 3,
         ReuseAddr => 1,
      ) or croak "cannot create socket: $OS_ERROR";
      $self->set_door($sock);
      return;
   }

   sub set_selector {
      my $self = shift;
      my ($selector) = @_;
      $selector->add($self->get_door());
      $self->SUPER::set_selector($selector);
      return;
   }

   sub release_selector {
      my $self = shift;
      $self->SUPER::release_selector();
      $self->selector()->remove($self->get_door());
      return;
   }

   sub owns {
      my $self = shift;
      my ($fh) = @_;
      return ($fh == $self->get_door()) || $self->SUPER::owns($fh);
   }

   sub execute_commands { # A command on the door is actually a connection
      my $self = shift;
      my ($fh, $talk) = @_;
      if ($fh == $self->get_door()) {
         my $newcomer = $fh->accept();
         $self->add(WWW::Slides::Controller::Single->new(
            in_handle => $newcomer,
            out_handle => $newcomer,
         ));
         return;
      }
      return $self->SUPER::execute_commands($fh, $talk);
   } ## end sub get_commands

}
1;    # Magic true value required at end of module
__END__