File Coverage

blib/lib/WWW/Slides/Talk.pm

Criterion	Covered	Total	%
statement	54	227	23.7
branch	0	54	0.0
condition	0	5	0.0
subroutine	18	42	42.8
pod	0	21	0.0
total	72	349	20.6

package WWW::Slides::Talk;
{
   use warnings;

   #   use diagnostics;
   use strict;
   use Carp;
   use version; our $VERSION = qv('0.0.5');
   use Object::InsideOut;
   use IO::Socket;
   use IO::Select;
   use English qw( -no_match_vars );

   use WWW::Slides::Attendee;
   use WWW::Slides::SlideTracker;

   # Other recommended modules (uncomment to use):
   #  use IO::Prompt;
   #  use Perl6::Export;
   #  use Perl6::Slurp;
   #  use Perl6::Say;
   #  use Regexp::Autoflags;
   #  use Readonly;

   #--------------------------------------------------------------------
   #
   # Member variables and initialisation
   #
   my @controller : Field    # Entry point for talk control
     : Std(Name => 'controller')
     : Arg(Name => 'controller', Mandatory => 1);

   my @door : Field          # Entry point for talk "listening"
     : Std(Name => 'door', Private => 1);
   my @port : Field          # Port used for talk TCP socket
     : Std(Name => 'port', Private => 1)
     : Arg(Name => 'port', Mandatory => 1);
   my @attendees : Field     # List of registered attendees
     : Std(Name => 'attendees', Private => 1);
   my @must_book : Field     # Should attendee book before entering?
     : Std(Name => 'must_book', Private => 1) : Get(Name => 'must_book')
     : Arg(Name => 'must_book', Default => 0);
   my @booked : Field        # Track expected attendees
     : Std(Name => 'booked', Private => 1)
     : Get(Name => 'booked', Private => 1);
   my @accepts_detaches : Field    # Attendees can detach
     : Std(Name => 'accepts_detaches', Private => 1)
     : Get(Name => 'accepts_detaches')
     : Arg(Name => 'accepts_detaches', Default => 1);

   my @slide_show : Field          # Where we're getting the slides from
     : Std(Name => 'slide_show', Private => 1)
     : Get(Name => 'slide_show', Private => 1)
     : Arg(Name => 'slide_show', Mandatory => 1);
   my @tracker : Field             # Track current slide
     : Std(Name => 'tracker', Private => 1)
     : Get(Name => 'tracker', Private => 1);

   my @ping_interval : Field       # Anti-timeout
     : Std(Name => 'ping_interval')
     : Arg(Name => 'ping_interval', Default => 60);
   my @alive : Field               # Is this talk still alive?
     : Std(Name => 'alive', Private => 1)
     : Get(Name => 'is_alive', Private => 1);
   my @selector : Field            # For select() operations
     : Std(Name => 'selector', Private => 1);

   my @logger : Field              # Where to send any log message
     : Std(Name => 'logger', Private => 1) : Get(Name => 'logger')
     : Arg(Name => 'logger');

   sub _init : Init {
      my $self = shift;
      my ($args) = @_;

      # Ensure there's a logger, even a fake one
      if (! $self->logger()) {
         require WWW::Slides::BasicLogger;
         $self->set_logger(WWW::Slides::BasicLogger->new(fake => 1));
      }

      my $door = IO::Socket::INET->new(
         Proto     => 'tcp',
         LocalPort => $self->get_port(),
         ReuseAddr => 1,
         Listen    => 3,
        )
        or croak "could not create door socket on port ",
        $self->get_port();
      $self->set_door($door);

      my $selector = IO::Select->new($door);
      $self->set_selector($selector);

      my $controller = $self->get_controller();
      $controller->set_selector($selector);

      $self->set_attendees({});    # Empty talk at the beginning
      $self->set_booked({}) if $self->must_book();

      $self->set_tracker(          # Auto-places on the first slide
         WWW::Slides::SlideTracker->new(
            slide_show => $self->get_slide_show()
         )
      );

      $self->set_alive(1);


      return;
   } ## end sub _init :
     #---------------------------------------------------------------------

   sub run {    # main loop function
      my $self       = shift;
      my $door       = $self->get_door();
      my $selector   = $self->get_selector();
      my $controller = $self->get_controller();

      $self->logger()->info('run(): entering main loop');
      while ($self->is_alive() && $controller->is_alive()) {
         my @ready = $selector->can_read($self->get_ping_interval());
         $self->ping();

         for my $fh (@ready) {    # Do all the work
            if ($controller->owns($fh)) {
               $self->execute_commands($fh);
            }
            elsif ($fh == $door) {
               $self->welcome_attendee();
            }
            else {
               $self->check_attendee($self->get_attendee($fh));
            }
         } ## end for my $fh (@ready)
      } ## end while ($self->is_alive() ...

      $self->logger()->info('run() exited from loop, talk ',
         ($self->is_alive() ? 'alive' : 'dead'),
         ', controller ',
         ($controller->is_alive() ? 'alive' : 'dead')
      );
      $self->cleanup();

      return;
   } ## end sub run

   sub cleanup : Private {
      my $self = shift;
      $self->logger()->debug('cleanup()');
      $self->remove_attendee($_) for $self->get_all_attendees();
      return;
   }

   # Attendees selection
   sub get_attached_attendees {
      my $self = shift;
      return grep { $_->is_attached() } $self->get_all_attendees();
   }

   sub get_all_attendees {
      my $self = shift;
      return values %{$self->get_attendees()};
   }

   sub resolve_attendees {
      my $self = shift;
      return map { ref $_ ? $_ : $self->get_attendee($_) } @_;
   }

   sub get_attendee {
      my $self = shift;
      my ($id) = @_;

      my $attendees = $self->get_attendees();
      if (ref $id) {    # It's a filehandle
         die "unexpected attendee's filehandle [$id]"
           unless exists $attendees->{$id};
         return $attendees->{$id};
      }

      # It's an external identifier
      for my $attendee (values %$attendees) {
         return $attendee if $attendee->id() eq $id;
      }
      die "could not find id $id";
   } ## end sub get_attendee

   # Content sending management
   sub broadcast : Private {
      my $self      = shift;
      my $command   = shift;
      my @attendees = @_
        ? $self->resolve_attendees(@_)
        : $self->get_all_attendees();

      # Ensure that $command is a reference to a sub
      if ((ref($command) || '') ne 'CODE') {    # Auto-define sub
         my ($cmd, @args) = ref $command ? @$command : $command;
         $command = sub {
            my $attendee = shift;
            my $method   = $attendee->can($cmd);
            $attendee->$method(@args) if $method;
            return;
         };
      } ## end if ((ref($command) || ...

      return map { $command->($_) } @attendees;
   } ## end sub broadcast :

   sub ping {    # Remind them all to remain awake
      return shift->broadcast('ping');
   }

   sub get_show_attendees {
      my $self = shift;
      return @_ if @_;
      return $self->get_attached_attendees();
   }

   # Transition commands, default to attached attendees
   sub show {    # Set specific slide
      my $self     = shift;
      my $slide_no = shift;

      if (! $self->slide_show()->validate_slide_id($slide_no)) {
         $self->logger()->error("show(): invalid slide $slide_no");
         return;
      }

      if (@_) {
         $self->logger()->debug("show(): going to slide $slide_no "
            . 'for some attendees only');
      }
      else {
         $self->logger()->debug("show(): going to slide $slide_no");
         $self->tracker()->goto($slide_no);
      }

      if (my @attendees = $self->get_show_attendees(@_)) {
         return $self->broadcast(['show', $slide_no], @attendees);
      }
      $self->logger()->debug('show(): no attendee found');
      return;
   } ## end sub show

   sub constrained_show : Private { # Factorised transition
      my $self = shift;
      my $bare = shift;
      my $method = 'show_' . $bare;

      if (@_) {
         $self->logger()->debug($method . '() for some attendees');
      }
      else {
         my $tracker = $self->tracker();
         $tracker->can('goto_' . $bare)->($tracker); # Call method OO-style
         $self->logger()->debug($method . '()');
      }

      if (my @attendees = $self->get_show_attendees(@_)) {
         return $self->broadcast($method, @attendees);
      }
      $self->logger()->debug($method . '(): no attendee found');
      return;
   }

   sub show_first {
      my $self = shift;
      return $self->constrained_show('first', @_);
   } ## end sub show_first

   sub show_last {
      my $self = shift;
      return $self->constrained_show('last', @_);
   } ## end sub show_last

   sub show_next {
      my $self = shift;
      return $self->constrained_show('next', @_);
   } ## end sub show_next

   sub show_previous {
      my $self = shift;
      return $self->constrained_show('previous', @_);
   } ## end sub show_previous

   # Command execution
   sub execute_commands : Private {
      my ($self, $fh) = @_;
      $self->get_controller()->execute_commands($fh, $self);
      return;
   }

   sub welcome_attendee : Private {
      my $self = shift;
      my $logger = $self->logger();

      $logger->debug('welcome_attendee(): accept()-ing new attendee');
      my $handle = $self->get_door()->accept()
        or croak("accept(): $OS_ERROR");
      $logger->debug("welcome_attendee(): $handle");

      # This also serves the first slide to the connected user
      $logger->debug('welcome_attendee(): creating object for new attendee');
      my $attendee = WWW::Slides::Attendee->new(
         handle        => $handle,
         slide_show    => scalar $self->get_slide_show(),
         current_slide => scalar $self->tracker->current(),
         check_booking => $self->must_book(),
      );

      # Register attendee
      $self->get_attendees()->{$handle} = $attendee;
      $self->get_selector()->add($handle);

      return;
   } ## end sub welcome_attendee :

   sub remove_attendee : Private {
      my $self       = shift;
      my ($attendee) = @_;
      my $handle     = $attendee->get_handle();

      $self->logger()->debug('removing attendee');
      $self->get_selector()->remove($handle);
      delete $self->get_attendees()->{$handle};

      $attendee->shut_down();
      return;
   } ## end sub remove_attendee :

   sub check_attendee : Private {
      my $self = shift;
      my ($attendee) = @_;

      my $is_alive;
      if ($attendee->must_check_booking()) {
         my $code = $attendee->booking_code();
         $is_alive = delete($self->booked()->{$code}) if defined $code;
         $attendee->book_ok() if $is_alive;
      }
      else {
         $is_alive = $attendee->handle_input();
      }

      $self->remove_attendee($attendee) unless $is_alive;
      return;
   } ## end sub check_attendee :

   sub book {
      my $self = shift;
      my ($code) = @_;
      $self->logger()->debug("book(): booking with code $code");
      $self->booked()->{$code} = 1;
      return;
   } ## end sub book

   sub quit {
      my $self = shift;
      $self->logger()->debug("quit() requested");
      $self->set_alive(0);
      return;
   }

   sub attach {
      my $self    = shift;
      my $current = $self->tracker()->current();
      $self->logger()->debug("attach()");
      return $self->broadcast(
         sub {
            my $attendee = shift;
            $attendee->attach();
            $attendee->show($current);
            return;
         },
         @_
      );

      return;
   } ## end sub attach

   sub detach {
      my $self = shift;
      return unless $self->accepts_detaches();
      $self->logger()->debug("detach()");
      return $self->broadcast(
         sub {
            shift->detach();
            return;
         },
         @_
      );
   } ## end sub detach

   sub clamp {
      my $self = shift;
      $self->logger()->debug("clamp()");
      $self->set_accepts_detaches(0);
      $self->attach();
      return;
   } ## end sub clamp

   sub loose {
      my $self = shift;
      $self->logger()->debug("loose()");
      $self->set_accepts_detaches(1);
      return;
   }

   sub get_current { return shift->tracker()->current(); }
   sub get_total   { return shift->slide_show()->id_last(); }

   sub get_attendees_details {
      my $self = shift;
      return $self->broadcast(
         sub {
            my $attendee = shift;
            return {
               is_attached   => $attendee->is_attached(),
               id            => $attendee->id(),
               current_slide => $attendee->tracker()->current(),
               peer_address  => $attendee->peer_address(),
            };
         },
         @_
      );
   } ## end sub get_attendees_details
}

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