From: Matt S Trout <mst@shadowcat.co.uk>
Date: Sat, 8 Jan 2011 03:40:50 +0000 (+0000)
Subject: sketch out some service code
X-Git-Url: http://git.shadowcat.co.uk/gitweb/gitweb.cgi?a=commitdiff_plain;h=20038dd8dde462b3d79de150c0124c6c0d494358;p=scpubgit%2FClifton.git

sketch out some service code
---

diff --git a/lib/App/Clifton/Component.pm b/lib/App/Clifton/Component.pm
new file mode 100644
index 0000000..2a51217
--- /dev/null
+++ b/lib/App/Clifton/Component.pm
@@ -0,0 +1,45 @@
+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;
diff --git a/lib/App/Clifton/ConsoleService.pm b/lib/App/Clifton/ConsoleService.pm
new file mode 100644
index 0000000..0bb27a2
--- /dev/null
+++ b/lib/App/Clifton/ConsoleService.pm
@@ -0,0 +1,7 @@
+package App::Clifton::ConsoleService;
+
+use Moo;
+
+extends 'App::Clifton::Service';
+
+1;
diff --git a/lib/App/Clifton/IRCService.pm b/lib/App/Clifton/IRCService.pm
new file mode 100644
index 0000000..eeb7a70
--- /dev/null
+++ b/lib/App/Clifton/IRCService.pm
@@ -0,0 +1,7 @@
+package App::Clifton::IRCService;
+
+use Moo;
+
+extends 'App::Clifton::Service';
+
+1;
diff --git a/lib/App/Clifton/JabberService.pm b/lib/App/Clifton/JabberService.pm
new file mode 100644
index 0000000..73002ba
--- /dev/null
+++ b/lib/App/Clifton/JabberService.pm
@@ -0,0 +1,7 @@
+package App::Clifton::JabberService;
+
+use Moo;
+
+extends 'App::Clifton::Service';
+
+1;
diff --git a/lib/App/Clifton/Launcher.pm b/lib/App/Clifton/Launcher.pm
new file mode 100644
index 0000000..ba8356f
--- /dev/null
+++ b/lib/App/Clifton/Launcher.pm
@@ -0,0 +1,29 @@
+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;
diff --git a/lib/App/Clifton/Server.pm b/lib/App/Clifton/Server.pm
new file mode 100644
index 0000000..400b929
--- /dev/null
+++ b/lib/App/Clifton/Server.pm
@@ -0,0 +1,35 @@
+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;
diff --git a/lib/App/Clifton/Service.pm b/lib/App/Clifton/Service.pm
new file mode 100644
index 0000000..043e877
--- /dev/null
+++ b/lib/App/Clifton/Service.pm
@@ -0,0 +1,23 @@
+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;
diff --git a/lib/App/Clifton/ServiceContainer.pm b/lib/App/Clifton/ServiceContainer.pm
new file mode 100644
index 0000000..a426a01
--- /dev/null
+++ b/lib/App/Clifton/ServiceContainer.pm
@@ -0,0 +1,38 @@
+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;
diff --git a/lib/App/Clifton/Task.pm b/lib/App/Clifton/Task.pm
new file mode 100644
index 0000000..216e3c3
--- /dev/null
+++ b/lib/App/Clifton/Task.pm
@@ -0,0 +1,63 @@
+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;