--- /dev/null
+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 'IO::Async::Notifier';
+
+sub BUILD {
+ my ($self, $args) = @_;
+ log_debug {
+ "Constructing "._debug_self($self, $args);
+ };
+ if (my $parent = $args->{parent_component}) {
+ $parent->add_child($self);
+ }
+}
+
+sub configure {
+ # If we called the superclass method, any ->new params that were populated
+ # into attributes would cause a croak. While the loss of error checking is
+ # annoying I've got other things to fix right now.
+}
+
+sub _new_child {
+ my ($self, $class, $args) = @_;
+ $class->new(%{$args||{}}, parent_component => $self);
+}
+
+sub _schedule {
+ my ($self, $code) = @_;
+ $self->get_loop->later($code);
+}
+
+sub DESTROY {
+ my ($self) = @_;
+ log_debug { "Destroying "._debug_self($self, $self) };
+}
+
+1;
--- /dev/null
+package App::Clifton::ConsoleService;
+
+use Moo;
+
+extends 'App::Clifton::Service';
+
+1;
--- /dev/null
+package App::Clifton::IRCService;
+
+use Moo;
+
+extends 'App::Clifton::Service';
+
+1;
--- /dev/null
+package App::Clifton::JabberService;
+
+use Moo;
+
+extends 'App::Clifton::Service';
+
+1;
--- /dev/null
+package App::Clifton::Launcher;
+
+use IO::Async::Loop;
+use Log::Contextual qw(set_logger :log);
+use Log::Contextual::SimpleLogger;
+use aliased 'App::Clifton::Server';
+use Moo;
+
+has config_file => (is => 'ro', required => 1);
+
+sub run {
+ my ($self) = @_;
+ set_logger(Log::Contextual::SimpleLogger->new({ levels => [ qw(
+ info warn debug
+ ) ] }));
+ my $loop = IO::Async::Loop->new;
+ my $server = Server->new(
+ config_file => $self->config_file,
+ loop => $loop,
+ );
+ $loop->later(sub {
+ $server->reload_config->on_finished(sub {
+ log_info { "Server startup complete" };
+ });
+ });
+ $loop->loop_forever;
+}
+
+1;
--- /dev/null
+package App::Clifton::Server;
+
+use aliased 'App::Clifton::ServiceContainer';
+use aliased 'App::Clifton::ConfigLoader';
+use Moo;
+
+extends 'App::Clifton::Service';
+
+sub BUILD {
+ my ($self, $args) = @_;
+ $args->{loop}->add($self);
+ $self->$_ for qw(services);
+}
+
+has config_file => (is => 'ro', required => 1);
+
+has config_loader => (is => 'lazy');
+
+sub _build_config_loader { ConfigLoader->new }
+
+has services => (is => 'lazy');
+
+sub _build_services {
+ shift->_new_child(ServiceContainer, {});
+}
+
+sub reload_config { shift->_do(reload_config => @_) }
+sub shutdown { shift->_do(shutdown => @_) }
+
+sub _body_for_reload_config {
+ my ($self, $args) = @_;
+ $args->{on_finished}->();
+}
+
+1;
--- /dev/null
+package App::Clifton::Service;
+
+use aliased 'App::Clifton::Task';
+use Moo;
+
+extends 'App::Clifton::Component';
+
+sub _do {
+ my ($self, $do, @args) = @_;
+ my $body = do {
+ my $body_call = $self->_capture_weakself("_body_for_${do}");
+ sub { $body_call->(@args, @_) }
+ };
+ my $deps = {};
+ if (my $dep_call = $self->can("_dependencies_for_${do}")) {
+ $deps = $self->$dep_call(@args);
+ }
+ $self->_new_child(Task, {
+ name => $do, body => $body, dependencies => $deps
+ });
+}
+
+1;
--- /dev/null
+package App::Clifton::ServiceContainer;
+
+use aliased 'App::Clifton::JabberService';
+use aliased 'App::Clifton::IRCService';
+use aliased 'App::Clifton::ConsoleService';
+use Log::Contextual qw(:log);
+use Moo;
+
+extends 'App::Clifton::Component';
+
+has jabber => (is => 'lazy');
+has irc => (is => 'lazy');
+has console => (is => 'lazy');
+
+sub BUILD {
+ my ($self) = @_;
+ $self->$_ for qw(console irc jabber);
+}
+
+sub _build_jabber {
+ my ($self) = @_;
+ log_debug { "Spawning jabber service" };
+ $self->_new_child(JabberService, { irc_service => $self->irc });
+}
+
+sub _build_irc {
+ my ($self) = @_;
+ log_debug { "Spawning IRC service" };
+ $self->_new_child(IRCService, {});
+}
+
+sub _build_console {
+ my ($self) = @_;
+ log_debug { "Spawning console service" };
+ $self->_new_child(ConsoleService, {});
+}
+
+1;
--- /dev/null
+package App::Clifton::Task;
+
+use Log::Contextual qw(:log);
+use Async::MergePoint;
+use Moo;
+
+extends 'App::Clifton::Component';
+
+has on_finished => (is => 'rw');
+
+has name => (is => 'ro', required => 1);
+
+has body => (is => 'ro', required => 1);
+
+has dependencies => (is => 'ro', default => sub { {} });
+
+has merge_point => (is => 'lazy');
+
+sub _build_merge_point { Async::MergePoint->new }
+
+sub BUILD {
+ my ($self) = @_;
+ my $deps = $self->dependencies;
+ if (my @needs = keys %$deps) {
+ my $mp = $self->merge_point;
+ $mp->needs(@needs);
+ foreach my $key (@needs) {
+ $deps->{$key}->on_finished(sub { $mp->done($key => $_[0]) });
+ }
+ $mp->close(on_finished => $self->_capture_weakself('_schedule_body'));
+ } else {
+ $self->_schedule_body;
+ }
+}
+
+sub _schedule_body {
+ my ($self, %args) = @_;
+ my $fire_body = $self->_capture_weakself('_fire_body');
+ $args{on_finished} = $self->_finished_callback;
+ $self->_schedule(sub { $fire_body->(\%args); });
+}
+
+sub _fire_body {
+ my $self = shift;
+ $self->body->(@_);
+}
+
+sub _finished_callback {
+ my ($self) = @_;
+ $self->_capture_weakself('_schedule_finished');
+}
+
+sub _schedule_finished {
+ my ($self, @args) = @_;
+ if (my $on_finished = $self->on_finished) {
+ $self->_schedule(sub { $on_finished->(@args) });
+ }
+ $self->parent->remove_child($self);
+#$self->$::Dwarn;
+#warn Devel::FindRef::track $self;
+}
+
+1;
projects / scpubgit/Clifton.git / commitdiff