lib/App/Clifton/ConsoleService.pm

   1 package App::Clifton::ConsoleService;
   2
   3 use Log::Contextual qw(:log);
   4 use aliased 'App::Clifton::ConsoleService::Session';
   5 use IO::Async::Listener;
   6 use IO::Socket::UNIX;
   7 use Scalar::Util qw(weaken);
   8 use Moo;
   9
  10 extends 'App::Clifton::Service';
  11
  12 has socket_location => (is => 'ro', default => sub { 'clifton.sock' });
  13
  14 has $_ => (is => 'lazy') for qw(listener session socket);
  15
  16 sub _build_socket {
  17   my ($self) = @_;
  18   my $location = $self->socket_location;
  19   unlink($location) if -e $location;
  20   IO::Socket::UNIX->new(
  21     Local => $location,
  22     Listen => 1,
  23   ) or die "Cannot make UNIX socket - $!\n";
  24 }
  25
  26 sub _build_listener {
  27   my ($self) = @_;
  28   $self->_new_child('IO::Async::Listener', {
  29     on_stream => $self->_replace_weakself('_open_connection'),
  30     handle => $self->socket,
  31   });
  32 }
  33
  34 sub _build_session {
  35   my ($self) = @_;
  36   Session->new->${\sub {
  37     my ($session) = @_;
  38     $session->lex_env->lexicals->{'$_SERVICE'} = \$self;
  39     weaken(${$session->lex_env->{'$_SERVICE'}});
  40     $session;
  41   }};
  42 }
  43
  44 sub BUILD {
  45   my ($self) = @_;
  46   $self->$_ for qw(listener session);
  47 }
  48
  49 sub _open_connection {
  50   my ($self, $stream) = @_;
  51   log_debug { "Connection opened" };
  52   $self->session->configure(transport => $stream);
  53   $self->add_child($self->session);
  54 }
  55
  56 1;