Alice
view release on metacpan or search on metacpan
lib/Alice.pm view on Meta::CPAN
has 'user' => (
is => 'ro',
default => $ENV{USER}
);
sub BUILDARGS {
my ($class, %options) = @_;
my $self = {};
for (qw/template user message_store/) {
if (exists $options{$_}) {
$self->{$_} = $options{$_};
delete $options{$_};
}
}
$self->{config} = Alice::Config->new(
%options,
callback => sub {$self->{config}->merge(\%options)}
);
return $self;
}
sub run {
my $self = shift;
# wait for config to finish loading
my $w; $w = AE::idle sub {
return unless $self->config->{loaded};
undef $w;
$self->init;
};
}
sub init {
my $self = shift;
$self->info_window;
$self->template;
$self->add_irc_server($_, $self->config->servers->{$_})
for keys %{$self->config->servers};
}
sub init_shutdown {
my ($self, $cb, $msg) = @_;
$self->alert("Alice server is shutting down");
$self->disconnect_irc($_->name, $msg) for $self->connected_ircs;
my ($w, $t);
my $shutdown = sub {
undef $w;
undef $t;
$self->shutdown;
$cb->() if $cb;
};
$w = AE::idle sub {$shutdown->() unless $self->connected_ircs};
$t = AE::timer 3, 0, $shutdown;
}
sub shutdown {
my $self = shift;
$self->_ircs([]);
$_->close for @{$self->streams};
$self->streams([]);
}
sub tab_order {
my ($self, $window_ids) = @_;
my $order = [];
for my $count (0 .. scalar @$window_ids - 1) {
if (my $window = $self->get_window($window_ids->[$count])) {
next unless $window->is_channel;
push @$order, $window->id;
}
}
$self->config->order($order);
$self->config->write;
}
sub window_nicks {
my ($self, $window) = @_;
return () if $window->type eq "info";
my $irc = $self->get_irc($window->network);
if ($irc and $irc->is_connected) {
if ($window->type eq "channel") {
return $irc->channel_nicks($window->title);
}
else {
return ($irc->nick, $window->title);
}
}
}
sub connect_actions {
my $self = shift;
map {
$_->join_action,
$_->nicks_action($self->window_nicks($_))
} $self->windows;
}
sub find_window {
my ($self, $title, $irc) = @_;
return $self->info_window if $title eq "info";
my $id = $self->_build_window_id($title, $irc->name);
if (my $window = $self->get_window($id)) {
return $window;
}
}
sub alert {
my ($self, $message) = @_;
return unless $message;
$self->broadcast({
type => "action",
lib/Alice.pm view on Meta::CPAN
map {$_->[1]}
sort {$a->[0] cmp $b->[0]}
map {[($o{$_->id} || $o{$_->title} || $prefix.$_->sort_name), $_]}
$self->windows;
}
sub close_window {
my ($self, $window) = @_;
AE::log debug => "sending a request to close a tab: " . $window->title;
$self->broadcast($window->close_action);
if ($window->is_channel) {
my $irc = $self->get_irc($window->network);
my $config = $self->config->servers->{$window->network};
$config->{channels} = [grep {$_ ne $window->title} @{$config->{channels}}];
$self->config->write;
}
$self->remove_window($window->id) if $window->type ne "info";
}
sub add_irc_server {
my ($self, $name, $config) = @_;
$self->config->servers->{$name} = $config;
my $irc = Alice::IRC->new(name => $name);
$self->add_irc($irc);
$self->connect_irc($name) if $config->{autoconnect};
}
sub reload_config {
my ($self, $new_config) = @_;
my %prev = map {$_ => $self->config->servers->{$_}{ircname} || ""}
keys %{ $self->config->servers };
if ($new_config) {
$self->config->merge($new_config);
$self->config->write;
}
for my $network (keys %{$self->config->servers}) {
my $config = $self->config->servers->{$network};
if (!$self->has_irc($network)) {
$self->add_irc_server($network, $config);
}
else {
my $irc = $self->get_irc($network);
$config->{ircname} ||= "";
if ($config->{ircname} ne $prev{$network}) {
$irc->update_realname($config->{ircname});
}
}
}
for my $irc ($self->ircs) {
my $name = $irc->name;
unless (exists $self->config->servers->{$name}) {
$self->send_info("config", "removing $name server");
if ($irc->is_disconnected) {
$self->cancel_reconnect($name) if $irc->reconnect_timer;
$irc->cl(undef);
$self->remove_irc($name);
}
else {
$irc->removed(1);
$self->disconnect_irc($name);
}
}
}
}
sub announce {
my ($self, $window, $body) = @_;
$self->broadcast({
type => "action",
event => "announce",
body => $body
});
}
sub send_message {
my ($self, $window, $nick, $body) = @_;
my $irc = $self->get_irc($window->network);
my @messages = $window->format_message($nick, $body,
monospaced => $self->is_monospace_nick($nick),
self => $irc->nick eq $nick,
avatar => $irc->nick_avatar($nick) || "",
highlight => $self->is_highlight($irc->nick, $body),
);
if ($messages[0]->{highlight}) {
push @messages, $self->info_window->format_message(
$nick, $body, self => 1, source => $nick);
}
$self->broadcast(@messages);
}
sub send_info {
my ($self, $network, $body, %options) = @_;
return unless $body;
my $message = $self->info_window->format_message($network, $body, %options);
$self->broadcast($message);
}
sub broadcast {
my ($self, @messages) = @_;
return if $self->no_streams or !@messages;
for my $stream (@{$self->streams}) {
$stream->send(\@messages);
}
}
sub ping {
my $self = shift;
return if $self->no_streams;
$_->ping for grep {$_->is_xhr} @{$self->streams};
}
( run in 0.923 second using v1.01-cache-2.11-cpan-817d5f8af8b )