towers are constructable

[scpubgit/Clifton.git] / lib / App / Clifton / Component.pm

package App::Clifton::Component;

# define this up here to avoid uninitialised warnings
sub _debug_self {
  my ($self, $args) = @_;
  "${self}: ".join ', ', map "$_ => ".$args->{$_}, keys %$args;
}

use Log::Contextual qw(:log);
use Moo;

extends 'Moo::Object', 'IO::Async::Notifier';

# we're replacing Notifier's constructor so need to set up its default
has children => (is => 'bare', default => sub { [] });

sub BUILD {
  my ($self, $args) = @_;
  log_debug {
    "Constructing "._debug_self($self, $args);
  };
  if (my $parent = $args->{parent_component}) {
    $parent->add_child($self);
  }
}

sub _new_child {
  my ($self, $class, $args) = @_;
  if ($class->isa('App::Clifton::Component')) {
    $class->new(%{$args||{}}, parent_component => $self);
  } else {
    my $new = $class->new(%{$args||{}});
    $self->add_child($new);
    $new;
  }
}

around _replace_weakself => sub {
  my ($orig, $self) = (shift, shift);
  $self->_eval_cb($self->$orig(@_));
};

around _capture_weakself => sub {
  my ($orig, $self) = (shift, shift);
  $self->_eval_cb($self->$orig(@_));
};

sub _schedule {
  my ($self, $code) = @_;
  $self->get_loop->later($self->_eval_cb($code));
}

sub _eval_cb {
  my ($self, $code) = @_;
  my $str = "$self";
  sub {
    local $@;
    eval { $code->(@_); 1 }
      or log_error { "Exception from ${self}: $@" };
  };
}

sub DESTROY {
  my ($self) = @_;
  log_debug { "Destroying "._debug_self($self, $self) };
}

1;