view release on metacpan or  search on metacpan

lib/App/Alice/IRC.pm  view on Meta::CPAN

    after => 1,
    cb => sub {
      delete $self->{disconnect_timer};
      $self->cl->disconnect($msg);
    }
  );
}

sub remove {
  my $self = shift;
  $self->removed(1);
  $self->disconnect;
}

sub publicmsg {
  my ($self, $cl, $channel, $msg) = @_;
  utf8::decode($channel);
  if (my $window = $self->find_window($channel)) {
    my $nick = (split '!', $msg->{prefix})[0];
    return if $self->app->is_ignore($nick);
    my $text = $msg->{params}[1];
    utf8::decode($_) for ($text, $nick);
    $self->app->store(nick => $nick, channel => $channel, body => $text);
    $self->broadcast($window->format_message($nick, $text)); 
  }
}

sub privatemsg {
  my ($self, $cl, $nick, $msg) = @_;
  my $text = $msg->{params}[1];
  utf8::decode($_) for ($nick, $text);
  if ($msg->{command} eq "PRIVMSG") {
    my $from = (split /!/, $msg->{prefix})[0];
    utf8::decode($from);
    return if $self->app->is_ignore($from);
    my $window = $self->window($from);
    $self->app->store(nick => $from, channel => $from, body => $text);
    $self->broadcast($window->format_message($from, $text)); 
    $self->send_srv(WHO => $from) unless $self->includes_nick($from);
  }
  elsif ($msg->{command} eq "NOTICE") {
    $self->log(debug => $text);
  }
}

sub ctcp_action {
  my ($self, $cl, $nick, $channel, $msg, $type) = @_;
  utf8::decode($_) for ($nick, $msg, $channel);
  return if $self->app->is_ignore($nick);
  if (my $window = $self->find_window($channel)) {
    my $text = "• $msg";
    $self->app->store(nick => $nick, channel => $channel, body => $text);
    $self->broadcast($window->format_message($nick, $text));
  }
}

sub nick_change {
  my ($self, $cl, $old_nick, $new_nick, $is_self) = @_;
  utf8::decode($_) for ($old_nick, $new_nick);
  $self->nick_cached($new_nick) if $is_self;
  $self->rename_nick($old_nick, $new_nick);
  $self->broadcast(
    map  {$_->format_event("nick", $old_nick, $new_nick)}
    $self->nick_windows($new_nick)
  );
}

sub _join {
  my ($self, $cl, $nick, $channel, $is_self) = @_;
  utf8::decode($_) for ($nick, $channel);
  if (!$self->includes_nick($nick)) {
    $self->add_nick({nick => $nick, real => "", channels => {$channel => ''}}); 
  }
  else {
    $self->get_nick_info($nick)->{channels}{$channel} = '';
  }
  if ($is_self) {

    # self->window uses find_or_create, so we don't create
    # duplicate windows here
    my $window = $self->window($channel);

    $self->broadcast($window->join_action);

    # client library only sends WHO if the server doesn't
    # send hostnames with NAMES list (UHNAMES), we to WHO always
    $self->send_srv("WHO" => $channel) if $cl->isupport("UHNAMES");
  }
  elsif (my $window = $self->find_window($channel)) {
    $self->send_srv("WHO" => $nick);
    $self->broadcast($window->format_event("joined", $nick));
  }
}

sub channel_add {
  my ($self, $cl, $msg, $channel, @nicks) = @_;
  utf8::decode($_) for (@nicks, $channel);
  if (my $window = $self->find_window($channel)) {
    for (@nicks) {
      if (!$self->includes_nick($_)) {
        $self->add_nick({nick => $_, real => "", channels => {$channel => ''}}); 
      }
      else {
        $self->get_nick_info($_)->{channels}{$channel} = '';
      }
    } 
  }
}

sub part {
  my ($self, $cl, $nick, $channel, $is_self, $msg) = @_;
  utf8::decode($_) for ($channel, $nick, $msg);
  if ($is_self and my $window = $self->find_window($channel)) {
    $self->log(debug => "leaving $channel");
    $self->app->close_window($window);
    for ($self->all_nick_info) {
      delete $_->{channels}{$channel} if exists $_->{channels}{$channel};
    }
  }
}

lib/App/Alice/IRC.pm  view on Meta::CPAN

  return;
}

sub irc_352 {
  my ($self, $cl, $msg) = @_;
  
  # ignore the first param if it is our own nick, some servers include it
  shift @{$msg->{params}} if $msg->{params}[0] eq $self->nick;
  my ($channel, $user, $ip, $server, $nick, $flags, @real) = @{$msg->{params}};
  my $real = join " ", @real;
  return unless $nick;
  $real =~ s/^\d // if $real;
  utf8::decode($_) for ($channel, $user, $nick, $real);
  my $info = {
    IP       => $ip     || "",
    user     => $user || "",
    server   => $server || "",
    real     => $real   || "",
    channels => {$channel => $flags},
    nick     => $nick,
  };
  
  if ($self->includes_nick($nick)) {
    my $prev_info = $self->get_nick_info($nick);
    $info->{channels} = {
      %{$prev_info->{channels}},
      %{$info->{channels}},
    };

    if ($info->{real} ne $prev_info->{real}) {
      for (grep {$_->previous_nick eq $nick} $self->windows) {
        $_->reset_previous_nick;
      }
    }
  }
  
  $self->set_nick_info($nick, $info);

  if ($self->whois_cbs->{$nick}) {
    $self->whois_cbs->{$nick}->();
    delete $self->whois_cbs->{$nick};
  }
}

sub irc_366 {
  my ($self, $cl, $msg) = @_;
  utf8::decode($msg->{params}[1]);
  if (my $window = $self->find_window($msg->{params}[1])) {
    $self->broadcast($window->nicks_action);
  }
}

sub irc_401 {
  my ($self, $cl, $msg) = @_;
  utf8::decode($msg->{params}[1]);
  if (my $window = $self->find_window($msg->{params}[1])) {
    $self->broadcast($window->format_announcement("No such nick."));
  }
}

sub rename_nick {
  my ($self, $nick, $new_nick) = @_;
  return unless $self->includes_nick($nick);
  my $info = $self->get_nick_info($nick);
  $info->{nick} = $new_nick;
  $self->set_nick_info($new_nick, $info);
  $self->remove_nick($nick);
}

sub remove_nicks {
  my ($self, @nicks) = @_;
  $self->_nicks(
    grep {
      my $nick = $_;
      first {$nick eq $_} @nicks ? 0 : 1;
    } $self->nicks
  );
}

sub nick_avatar {
  my ($self, $nick) = @_;
  my $info = $self->get_nick_info($nick);
  if ($info and $info->{real}) {
    if ($info->{real} =~ /([^<\s]+@[^\s>]+\.[^\s>]+)/) {
      my $email = $1;
      return "http://www.gravatar.com/avatar/"
           . md5_hex($email) . "?s=32&amp;r=x";
    }
    elsif ($info->{real} =~ /(https?:\/\/\S+(?:jpe?g|png|gif))/) {
      return $1;
    }
    else {
      return undef;
    }
  }
}

sub whois_table {
  my ($self, $nick) = @_;
  my $info = $self->get_nick_info($nick);
  return "No info for user \"$nick\"" if !$info;
  return "real: $info->{real}\nuser: $info->{user}\n" .
         "host: $info->{IP}\nserver: $info->{server}\nchannels: " .
         join " ", keys %{$info->{channels}};
}

sub update_realname {
  my ($self, $realname) = @_;
  my $nick = $self->nick_cached;
  $self->send_srv(REALNAME => $realname);
  if (my $info = $self->get_nick_info($nick)) { 
    $info->{real} = $realname;
  }
  for (grep {$_->previous_nick eq $nick} $self->windows) {
    $_->reset_previous_nick;
  }
}

__PACKAGE__->meta->make_immutable;
1;