use Moo;
+extends 'App::Clifton::Component';
+
has jabber_user => (is => 'ro', required => 1);
has irc_channel => (is => 'ro', required => 1);
+has jabber_tower => (is => 'ro', required => 1);
+has irc_tower => (is => 'ro', required => 1, weak_ref => 1);
+
+sub handle_xmpp_message {
+ my ($self, $msg) = @_;
+ $self->irc_tower->send_irc_message({
+ to => $self->irc_channel,
+ text => $msg->body
+ });
+}
+
+sub handle_irc_message {
+ my ($self, $message, $hints) = @_;
+ $self->jabber_tower->send_xmpp_message({
+ to => $self->jabber_user,
+ body => join(': ', $hints->{prefix_name}, $hints->{text})
+ });
+}
+
1;
"${self}: ".join ', ', map "$_ => ".$args->{$_}, keys %$args;
}
+use Try::Tiny;
use Log::Contextual qw(:log);
use Moo;
my ($self, $code) = @_;
my $str = "$self";
sub {
- local $@;
- eval { $code->(@_); 1 }
- or log_error { "Exception from ${self}: $@" };
+ try { $code->(@_) } catch { log_error { "Exception from ${self}: $_" } }
};
}
use aliased 'App::Clifton::ConsoleService';
use aliased 'App::Clifton::ConfigLoader';
+use aliased 'App::Clifton::Tower::Jabber' => 'Jabber_Tower';
+use aliased 'App::Clifton::Tower::IRC' => 'IRC_Tower';
use Moo;
extends 'App::Clifton::Service';
has console_service => (is => 'lazy');
+has jabber_towers => (is => 'ro', default => sub { {} });
+
+has irc_towers => (is => 'ro', default => sub { {} });
+
sub _build_console_service {
my ($self) = @_;
$self->_new_child(ConsoleService, { server => $self });
$args->{on_finished}->($config);
}
+sub start_chain { shift->_do(start_chain => @_) }
+
+sub _dependencies_for_start_chain {
+ my ($self, $args) = @_;
+ {
+ irc_tower => $self->start_irc_tower($args->{irc_tower})
+ }
+}
+
+sub _body_for_start_chain {
+ my ($self, $args) = @_;
+ $args->{irc_tower}->start_chain($args);
+}
+
+sub start_irc_tower { shift->_do(start_irc_tower => @_) }
+
+sub _guard_for_start_irc_tower {
+ my ($self, $args) = @_;
+ if (my $tower = $self->irc_towers->{$args->{server}}{$args->{irc_nick}}) {
+ ($tower);
+ } else {
+ ();
+ }
+}
+
+sub _body_for_start_irc_tower {
+ my ($self, $args) = @_;
+ $self->_new_child(IRC_Tower, {
+ irc_server => $args->{server},
+ irc_nick => $args->{irc_nick},
+ on_setup => $args->{on_finished},
+ server => $self,
+ });
+}
+
1;
extends 'App::Clifton::Component';
sub _do {
- my ($self, $do, @args) = @_;
+ my ($self, $do, $args) = @_;
my $body = do {
my $body_call = $self->_capture_weakself("_body_for_${do}");
- sub { $body_call->(@args, @_) }
+ sub { $body_call->(@_) }
+ };
+ my @guard = do {
+ if ($self->can("_guard_for_${do}")) {
+ my $guard_call = $self->_capture_weakself("_guard_for_${do}");
+ (guard => sub { $guard_call->(@_) });
+ } else {
+ ();
+ }
};
my $deps = {};
if (my $dep_call = $self->can("_dependencies_for_${do}")) {
- $deps = $self->$dep_call(@args);
+ $deps = $self->$dep_call($args);
}
$self->_new_child(Task, {
- name => $do, body => $body, dependencies => $deps
+ name => $do, body => $body, dependencies => $deps, @guard,
+ args => $args,
});
}
has body => (is => 'ro', required => 1);
+has guard => (is => 'ro', predicate => 'has_guard');
+
+has args => (is => 'ro', required => 1);
+
has dependencies => (is => 'ro', default => sub { {} });
has merge_point => (is => 'lazy');
sub BUILD {
my ($self) = @_;
+ if (my $cb = $self->args->{on_finished}) {
+ $self->on_finished($cb);
+ }
my $deps = $self->dependencies;
if (my @needs = keys %$deps) {
my $mp = $self->merge_point;
my ($self, %args) = @_;
my $fire_body = $self->_capture_weakself('_fire_body');
$args{on_finished} = $self->_finished_callback;
+ %args = (%{$self->args}, %args);
$self->_schedule(sub { $fire_body->(\%args); });
}
sub _fire_body {
my $self = shift;
- $self->body->(@_);
+ if ($self->has_guard and my ($result) = $self->guard->(@_)) {
+ $_[0]->{on_finished}($result);
+ } else {
+ $self->body->(@_);
+ }
}
sub _finished_callback {
--- /dev/null
+package App::Clifton::Tower::IRC;
+
+use aliased 'Net::Async::IRC' => 'IRC_Client';
+use aliased 'App::Clifton::Chain';
+use Log::Contextual qw(:log);
+use Moo;
+
+extends 'App::Clifton::Component';
+
+has server => (is => 'ro', required => 1, weak_ref => 1);
+has irc_server => (is => 'ro', required => 1);
+has irc_nick => (is => 'ro', required => 1);
+has irc_client => (is => 'lazy');
+has chains => (is => 'ro', default => sub { {} });
+
+sub _build_irc_client { shift->_new_child(IRC_Client, {}) }
+
+sub BUILD {
+ my ($self, $args) = @_;
+ my $on_setup = $args->{on_setup};
+ $self->irc_client->configure(
+ on_message_text => $self->_replace_weakself('receive_irc_message')
+ );
+ $self->irc_client->login(
+ nick => $self->irc_nick, host => $self->irc_server,
+ on_login => $self->_capture_weakself(sub {
+ my $self = shift;
+ $self->server->irc_towers->{$self->irc_server}{$self->irc_nick}
+ = $self;
+ $on_setup->($self);
+ }),
+ );
+}
+
+sub start_chain {
+ my ($self, $args) = @_;
+ $self->irc_client->send_message('JOIN', undef, $args->{irc_channel});
+ my $new = $self->_new_child(Chain, {
+ %$args, irc_tower => $self,
+ });
+ $self->chains->{$args->{irc_channel}} = $new;
+ # I note here that actually we should make the Chain do
+ # setup (JOIN) and confirm that first, but oh well
+ $args->{on_finished}->({
+ chain => $new,
+ message => 'SUCCESS'
+ });
+}
+
+sub send_irc_message {
+ my ($self, $args) = @_;
+ $self->irc_client->send_message('PRIVMSG', undef, @{$args}{qw(to text)});
+}
+
+sub receive_irc_message {
+ my ($self, $message, $hints) = @_;
+ return if $hints->{prefix_is_me};
+ if (my $chain = $self->chains->{$hints->{target_name}}) {
+ $chain->handle_irc_message($message, $hints);
+ }
+}
+
+1;
sub xmpp_active { shift->xmpp_client->xmpp->is_loggedin }
has $_ => (is => 'ro', required => 1)
- for qw(bridge_name server jabber_config);
+ for qw(bridge_name jabber_config irc_config);
+
+has server => (is => 'ro', required => 1, weak_ref => 1);
has userconfig_set => (
is => 'ro', # Moobug init_arg => undef,
my $conf = $self->jabber_config;
$xmpp->login(
jid => $conf->user, host => $conf->server, password => $conf->pass,
+ on_message => $self->_replace_weakself('handle_message'),
);
$xmpp;
}
+sub BUILD { $_[0]->xmpp_client }
+
sub handle_message {
my ($self, $msg) = @_;
$self->start_chain_for($user)->on_finished(
$self->_capture_weakself(sub {
my ($self, $result) = @_;
+ if ($result->{chain}) {
+ $self->chain_set->add($result->{chain});
+ }
$self->send_xmpp_message({
- to => $from, body => 'Connection result: '.$result
+ to => $from, body => 'Connection result: '.$result->{message}
});
})
);
$self->xmpp_client->compose(%$args)->send;
}
+sub start_chain_for {
+ my ($self, $user) = @_;
+ $self->server->start_chain({
+ jabber_tower => $self,
+ jabber_user => $user->name,
+ irc_tower => {
+ server => $self->irc_config->server,
+ irc_nick => $user->irc_nick
+ },
+ irc_channel => $self->irc_config->channel,
+ });
+}
+
1;
# and later
use Moo;
+has name => (is => 'ro', required => 1);
has allow => (is => 'ro', required => 1);
has irc_nick => (is => 'ro', required => 1);
use App::Clifton::Tower::Jabber
-my $j = $_SERVER->_new_child('App::Clifton::Tower::Jabber', { server => $_SERVER, bridge_name => 'hearts', jabber_config => $_SERVER->current_config->bridges->get({ name => 'hearts' })->jabber });
+my $hearts = $_SERVER->current_config->bridges->get({ name => 'hearts' });
+my $j = $_SERVER->_new_child('App::Clifton::Tower::Jabber', { server => $_SERVER, bridge_name => 'hearts', jabber_config => $hearts->jabber, irc_config => $hearts->irc });
+$j->userconfig_set->add($_SERVER->current_config->users->get({ name => 'mst@corvina.org' });
my $xmpp = $j->xmpp_client;
$xmpp->compose(to => 'mst@corvina.org', body => 'hi')->send
$xmpp->configure(on_message => $j->_replace_weakself('handle_message'));
projects / scpubgit/Clifton.git / commitdiff