lib/App/Clifton/Component.pm

   1 package App::Clifton::Component;
   2
   3 # define this up here to avoid uninitialised warnings
   4 sub _debug_self {
   5   my ($self, $args) = @_;
   6   "${self}: ".join ', ', map "$_ => ".$args->{$_}, keys %$args;
   7 }
   8
   9 use Try::Tiny;
  10 use Log::Contextual qw(:log);
  11 use Moo;
  12
  13 extends 'Moo::Object', 'IO::Async::Notifier';
  14
  15 # we're replacing Notifier's constructor so need to set up its default
  16 has children => (is => 'bare', default => sub { [] });
  17
  18 sub BUILD {
  19   my ($self, $args) = @_;
  20   log_debug {
  21     "Constructing "._debug_self($self, $args);
  22   };
  23   if (my $parent = $args->{parent_component}) {
  24     $parent->add_child($self);
  25   }
  26 }
  27
  28 sub _new_child {
  29   my ($self, $class, $args) = @_;
  30   if ($class->isa('App::Clifton::Component')) {
  31     $class->new(%{$args||{}}, parent_component => $self);
  32   } else {
  33     my $new = $class->new(%{$args||{}});
  34     $self->add_child($new);
  35     $new;
  36   }
  37 }
  38
  39 around _replace_weakself => sub {
  40   my ($orig, $self) = (shift, shift);
  41   $self->_eval_cb($self->$orig(@_));
  42 };
  43
  44 around _capture_weakself => sub {
  45   my ($orig, $self) = (shift, shift);
  46   $self->_eval_cb($self->$orig(@_));
  47 };
  48
  49 sub _schedule {
  50   my ($self, $code) = @_;
  51   $self->get_loop->later($self->_eval_cb($code));
  52 }
  53
  54 sub _eval_cb {
  55   my ($self, $code) = @_;
  56   my $str = "$self";
  57   sub {
  58     my @args = @_;
  59     try { $code->(@args) } catch { log_error { "Exception from ${self}: $_" } }
  60   };
  61 }
  62
  63 sub DESTROY {
  64   my ($self) = @_;
  65   log_debug { "Destroying "._debug_self($self, $self) };
  66 }
  67
  68 1;