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 )