File Coverage

blib/lib/WWW/Slides/Client/Base.pm

Criterion	Covered	Total	%
statement	95	97	97.9
branch	9	16	56.2
condition			n/a
subroutine	27	28	96.4
pod	1	18	5.5
total	132	159	83.0

package WWW::Slides::Client::Base;
{

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

   use warnings;
   use strict;
   use Carp;
   use English qw( -no_match_vars );
   use IO::Select;
   use IO::Handle;

   use Object::InsideOut;

   # Module implementation here
   my @in_handle : Field    # controller handle, answers
     : Std(Name => 'in_handle', Private => 1)
     : Arg(Name => 'in_handle', Mandatory => 1);
   my @out_handle : Field    # controller handle, commands
     : Std(Name => 'out_handle', Private => 1)
     : Arg(Name => 'out_handle', Mandatory => 1);
   my @timeout : Field      # Timeout for receiving data
     : Std(Name => 'timeout') : Get(Name => 'timeout')
     : Arg(Name => 'timeout', Default => 10);

   sub raw_send {
      my $self = shift;
      $self->get_out_handle()->print(@_);
   }
   sub receive {
      my $self = shift;

      my $timeout  = $self->timeout();
      my $response = '';
      my $in       = $self->get_in_handle();
      my $sel      = IO::Select->new($in);
      while ($sel->can_read($timeout)) {
         $in->sysread(my $data, 1024);
         if (!length $data) {
            $self->shut_down();
            last;
         }
         $response .= $data;
         $timeout = 0.1; # lower timeout for following data
      } ## end while ($sel->can_read($timeout...

      return $response;
   }

   sub send_command {
      my $self = shift;
      my ($command) = @_;
      $command .= "\n" unless substr($command, -1) eq "\n";
      $self->raw_send($command);
      return $self->receive();
   } ## end sub send_command

   #-------------- COMMAND EXECUTION FRAMEWORK -------------------------
   sub _targetted : Private {
      my $self         = shift;
      my $base_command = shift;
      my $target       = ' target=' . join ',', @_;
      return $self->send_command($base_command . $target);
   } ## end sub _targetted :

   sub next {
      my $self = shift;
      return $self->_targetted('command=next ', @_);
   }

   sub previous {
      my $self = shift;
      return $self->_targetted('command=previous ', @_);
   }

   sub first {
      my $self = shift;
      return $self->_targetted('command=first ', @_);
   }

   sub last {
      my $self = shift;
      return $self->_targetted('command=last ', @_);
   }

   sub show {
      my $self     = shift;
      my $slide_no = shift;
      return $self->_targetted("command=show slide=$slide_no ", @_);
   } ## end sub show

   sub attach {
      my $self = shift;
      return $self->_targetted('command=attach ', @_);
   }

   sub detach {
      my $self = shift;
      return $self->_targetted('command=detach ', @_);
   }

   sub book {
      my $self = shift;
      my $code = shift;
      return $self->send_command("command=book code=$code");
   } ## end sub book

   sub clamp {
      return shift->send_command('command=clamp');
   }

   sub loose {
      return shift->send_command('command=loose');
   }

   sub get_current {
      my $self = shift;
      my $res  = $self->send_command('command=get_current');
      return unless defined $res;
      my ($slide_no, $total) =
         $res =~ m{200 \s+ OK \s+ current=(\d+) ; total=(\d+) \s* \z}mxs;
      return $slide_no unless wantarray;
      return ($slide_no, $total);
   } ## end sub get_current

   sub get_attendees {
      my $self = shift;
      my $res  = $self->send_command('command=get_attendees');
      return unless defined $res;
      my @attendees = split /\n/, $res;
      shift @attendees;    # status line

      for my $attendee (@attendees) {
         my %data = map { split /=/ } split /;/, $attendee;
         $attendee = \%data;
      } ## end for my $attendee (@att)

      return @attendees if wantarray;
      return \@attendees;
   } ## end sub get_attendees

   sub quit {
      return shift->send_command('command=quit');
   }

   sub shut_down {
      my $self = shift;
      $self->get_in_handle()->close() if $self->get_in_handle();
      $self->set_in_handle(undef);
      $self->get_out_handle()->close() if $self->get_out_handle();
      $self->set_out_handle(undef);
      return;
   } ## end sub shut_down

   sub is_alive {
      my $self = shift;
      return defined($self->get_in_handle());
   }
}

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