From: Matt S Trout <mst@shadowcat.co.uk>
Date: Tue, 25 Jan 2011 03:51:45 +0000 (+0000)
Subject: towers are constructable
X-Git-Url: http://git.shadowcat.co.uk/gitweb/gitweb.cgi?a=commitdiff_plain;h=21a188635ffc74827f2860bab517cbd829c5ccd6;p=scpubgit%2FClifton.git

towers are constructable
---

diff --git a/lib/App/Clifton/Chain.pm b/lib/App/Clifton/Chain.pm
new file mode 100644
index 0000000..400ee9b
--- /dev/null
+++ b/lib/App/Clifton/Chain.pm
@@ -0,0 +1,8 @@
+package App::Clifton::Chain;
+
+use Moo;
+
+has jabber_user => (is => 'ro', required => 1);
+has irc_channel => (is => 'ro', required => 1);
+
+1;
diff --git a/lib/App/Clifton/ChainSetByIRCChannel.pm b/lib/App/Clifton/ChainSetByIRCChannel.pm
new file mode 100644
index 0000000..43005d1
--- /dev/null
+++ b/lib/App/Clifton/ChainSetByIRCChannel.pm
@@ -0,0 +1,11 @@
+package App::Clifton::ChainSetByIRCChannel;
+
+use aliased 'App::Clifton::Chain';
+use Moo;
+
+with 'App::Clifton::Set';
+
+sub _set_of_class { Chain }
+sub _set_over { 'irc_channel' }
+
+1;
diff --git a/lib/App/Clifton/ChainSetByJabberUser.pm b/lib/App/Clifton/ChainSetByJabberUser.pm
new file mode 100644
index 0000000..138e51f
--- /dev/null
+++ b/lib/App/Clifton/ChainSetByJabberUser.pm
@@ -0,0 +1,11 @@
+package App::Clifton::ChainSetByJabberUser;
+
+use aliased 'App::Clifton::Chain';
+use Moo;
+
+with 'App::Clifton::Set';
+
+sub _set_of_class { Chain }
+sub _set_over { 'jabber_user' }
+
+1;
diff --git a/lib/App/Clifton/Component.pm b/lib/App/Clifton/Component.pm
index 7b153f0..7f80acd 100644
--- a/lib/App/Clifton/Component.pm
+++ b/lib/App/Clifton/Component.pm
@@ -35,9 +35,29 @@ sub _new_child {
   }
 }
 
+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($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 {
diff --git a/lib/App/Clifton/ConsoleService.pm b/lib/App/Clifton/ConsoleService.pm
index 4ca0e73..7e13f01 100644
--- a/lib/App/Clifton/ConsoleService.pm
+++ b/lib/App/Clifton/ConsoleService.pm
@@ -4,7 +4,6 @@ use Log::Contextual qw(:log);
 use aliased 'App::Clifton::ConsoleService::Session';
 use IO::Async::Listener;
 use IO::Socket::UNIX;
-use Scalar::Util qw(weaken);
 use Moo;
 
 extends 'App::Clifton::Service';
@@ -13,6 +12,8 @@ has socket_location => (is => 'ro', default => sub { 'clifton.sock' });
 
 has $_ => (is => 'lazy') for qw(listener session socket);
 
+has server => (is => 'ro', required => 1, weak_ref => 1);
+
 sub _build_socket {
   my ($self) = @_;
   my $location = $self->socket_location;
@@ -35,8 +36,8 @@ sub _build_session {
   my ($self) = @_;
   Session->new->${\sub {
     my ($session) = @_;
-    $session->lex_env->lexicals->{'$_SERVICE'} = \$self;
-    weaken(${$session->lex_env->{'$_SERVICE'}});
+    # no need to weaken this since server is already weak
+    $session->lex_env->lexicals->{'$_SERVER'} = \$self->server;
     $session;
   }};
 }
diff --git a/lib/App/Clifton/JabberService.pm b/lib/App/Clifton/JabberService.pm
deleted file mode 100644
index 73002ba..0000000
--- a/lib/App/Clifton/JabberService.pm
+++ /dev/null
@@ -1,7 +0,0 @@
-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
index ba8356f..1015edc 100644
--- a/lib/App/Clifton/Launcher.pm
+++ b/lib/App/Clifton/Launcher.pm
@@ -11,7 +11,7 @@ has config_file => (is => 'ro', required => 1);
 sub run {
   my ($self) = @_;
   set_logger(Log::Contextual::SimpleLogger->new({ levels => [ qw(
-    info warn debug
+    info warn debug error
   ) ] }));
   my $loop = IO::Async::Loop->new;
   my $server = Server->new(
@@ -23,7 +23,13 @@ sub run {
       log_info { "Server startup complete" };
     });
   });
-  $loop->loop_forever;
+  while (1) {
+    local $@;
+    last if eval { $loop->loop_forever; 1 };
+    my $error = $@;
+    log_error { "Server exception: ${error}" };
+  }
+  log_info { "Server shut down cleanly" };
 }
 
 1;
diff --git a/lib/App/Clifton/Server.pm b/lib/App/Clifton/Server.pm
index c39b983..c154786 100644
--- a/lib/App/Clifton/Server.pm
+++ b/lib/App/Clifton/Server.pm
@@ -1,6 +1,6 @@
 package App::Clifton::Server;
 
-use aliased 'App::Clifton::ServiceContainer';
+use aliased 'App::Clifton::ConsoleService';
 use aliased 'App::Clifton::ConfigLoader';
 use Moo;
 
@@ -9,7 +9,7 @@ extends 'App::Clifton::Service';
 sub BUILD {
   my ($self, $args) = @_;
   $args->{loop}->add($self);
-  $self->$_ for qw(services);
+  $self->$_ for qw(console_service);
 }
 
 has config_file => (is => 'ro', required => 1);
@@ -20,10 +20,11 @@ has current_config => (is => 'rw');
 
 sub _build_config_loader { ConfigLoader->new }
 
-has services => (is => 'lazy');
+has console_service => (is => 'lazy');
 
-sub _build_services {
-  shift->_new_child(ServiceContainer, {});
+sub _build_console_service {
+  my ($self) = @_;
+  $self->_new_child(ConsoleService, { server => $self });
 }
 
 sub reload_config { shift->_do(reload_config => @_) }
diff --git a/lib/App/Clifton/ServiceContainer.pm b/lib/App/Clifton/ServiceContainer.pm
deleted file mode 100644
index a426a01..0000000
--- a/lib/App/Clifton/ServiceContainer.pm
+++ /dev/null
@@ -1,38 +0,0 @@
-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/Tower/Jabber.pm b/lib/App/Clifton/Tower/Jabber.pm
new file mode 100644
index 0000000..381695f
--- /dev/null
+++ b/lib/App/Clifton/Tower/Jabber.pm
@@ -0,0 +1,106 @@
+package App::Clifton::Tower::Jabber;
+
+use aliased 'App::Clifton::UserConfigSet';
+use aliased 'App::Clifton::ChainSetByJabberUser' => 'ChainSet';
+use aliased 'Net::Async::XMPP::Client' => 'XMPP_Client';
+use Log::Contextual qw(:log);
+use Moo;
+
+extends 'App::Clifton::Component';
+
+has xmpp_client => (is => 'lazy');
+
+sub xmpp_active { shift->xmpp_client->xmpp->is_loggedin }
+
+has $_ => (is => 'ro', required => 1)
+  for qw(bridge_name server jabber_config);
+
+has userconfig_set => (
+  is => 'ro', # Moobug init_arg => undef,
+  default => sub { UserConfigSet->new }
+);
+
+has chain_set => (
+  is => 'ro', # Moobug init_arg => undef,
+  default => sub { ChainSet->new }
+);
+
+sub _build_xmpp_client {
+  my ($self) = @_;
+  $self->_login_xmpp_client($self->_new_child(XMPP_Client, { }));
+}
+
+sub _login_xmpp_client {
+  my ($self, $xmpp) = @_;
+  my $conf = $self->jabber_config;
+  $xmpp->login(
+    jid => $conf->user, host => $conf->server, password => $conf->pass,
+  );
+  $xmpp;
+}
+
+sub handle_message {
+  my ($self, $msg) = @_;
+
+  my $me = $self->jabber_config->user;
+
+  return log_debug {
+    "Received message for ${\$msg->to} instead of $me - ignoring"
+  } unless $msg->to eq $me;
+
+  (my $from = $msg->from) =~ s/\/.*//;
+
+  return log_debug {
+    "Received message from me ($me) - ignoring"
+  } if $from eq $me;
+
+  return log_debug {
+    "Received message from user ${from} not in my config"
+  } unless my $user = $self->userconfig_set->get({ name => $from });
+
+  if (my $chain = $self->chain_set->get({ jabber_user => $from })) {
+    $chain->handle_xmpp_message($msg);
+  } else {
+    if ($msg->body =~ m{^\s*/start\s*$}) {
+      $self->send_xmpp_message({
+        to => $from, body => 'Connecting ...'
+      });
+      $self->start_chain_for($user)->on_finished(
+        $self->_capture_weakself(sub {
+          my ($self, $result) = @_;
+          $self->send_xmpp_message({
+            to => $from, body => 'Connection result: '.$result
+          });
+        })
+      );
+    } else {
+      $self->send_xmpp_message({
+        to => $from,
+        body => 'Not currently connected - send /start to connect'
+      });
+    }
+  }
+}
+
+sub send_xmpp_message {
+  my ($self, $args) = @_;
+  $self->xmpp_client->compose(%$args)->send;
+}
+
+1;
+
+# and later
+
+# package App::Clifton::Tower::IRC;
+
+# has irc_client
+
+# has irc_server_name
+
+# has user_config
+
+# has chain_set
+
+# package App::Clifton::Chain
+
+#