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 Log::Contextual qw(:log);
  10 use Moo;
  11
  12 extends 'Moo::Object', 'IO::Async::Notifier';
  13
  14 # we're replacing Notifier's constructor so need to set up its default
  15 has children => (is => 'bare', default => sub { [] });
  16
  17 sub BUILD {
  18   my ($self, $args) = @_;
  19   log_debug {
  20     "Constructing "._debug_self($self, $args);
  21   };
  22   if (my $parent = $args->{parent_component}) {
  23     $parent->add_child($self);
  24   }
  25 }
  26
  27 sub _new_child {
  28   my ($self, $class, $args) = @_;
  29   if ($class->isa('App::Clifton::Component')) {
  30     $class->new(%{$args||{}}, parent_component => $self);
  31   } else {
  32     my $new = $class->new(%{$args||{}});
  33     $self->add_child($new);
  34     $new;
  35   }
  36 }
  37
  38 around _replace_weakself => sub {
  39   my ($orig, $self) = (shift, shift);
  40   $self->_eval_cb($self->$orig(@_));
  41 };
  42
  43 around _capture_weakself => sub {
  44   my ($orig, $self) = (shift, shift);
  45   $self->_eval_cb($self->$orig(@_));
  46 };
  47
  48 sub _schedule {
  49   my ($self, $code) = @_;
  50   $self->get_loop->later($self->_eval_cb($code));
  51 }
  52
  53 sub _eval_cb {
  54   my ($self, $code) = @_;
  55   my $str = "$self";
  56   sub {
  57     local $@;
  58     eval { $code->(@_); 1 }
  59       or 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;