AnyEvent-IRC
view release on metacpan or search on metacpan
lib/AnyEvent/IRC/Client.pm view on Meta::CPAN
});
$dcc->{connect} = tcp_connect $dcc->{ip}, $dcc->{port}, sub {
my ($fh) = @_;
return unless $dcc && $self;
delete $dcc->{timeout};
delete $dcc->{connect};
unless ($fh) {
$self->dcc_disconnect ($id, "CONNECT ERROR: $!");
return;
}
$dcc->{handle} = AnyEvent::Handle->new (
fh => $fh,
on_eof => sub {
delete $dcc->{handle};
$self->dcc_disconnect ($id, "EOF");
},
on_error => sub {
delete $dcc->{handle};
$self->dcc_disconnect ($id, "ERROR: $!");
}
);
$self->event (dcc_connected => $id, $dcc->{type}, $dcc->{handle});
};
$id
}
sub dcc_handle {
my ($self, $id) = @_;
if (my $dcc = $self->{dcc}->{$id}) {
return $dcc->{handle}
}
return;
}
sub send_dcc_chat {
my ($self, $id, $msg) = @_;
if (my $dcc = $self->{dcc}->{$id}) {
if ($dcc->{handle}) {
$dcc->{handle}->push_write ("$msg\015\012");
}
}
}
################################################################################
# Private utility functions
################################################################################
sub _was_me {
my ($self, $msg) = @_;
$self->lower_case (prefix_nick ($msg)) eq $self->lower_case ($self->nick ())
}
sub update_ident {
my ($self, $ident) = @_;
my ($n, $u, $h) = split_prefix ($ident);
my $old = $self->{idents}->{$self->lower_case ($n)};
$self->{idents}->{$self->lower_case ($n)} = $ident;
if ($old ne $ident) {
$self->event (ident_change => $n, $ident);
}
#d# warn "IDENTS:\n".(join "\n", map { "\t$_\t=>\t$self->{idents}->{$_}" } keys %{$self->{idents}})."\n";
}
################################################################################
# Channel utility functions
################################################################################
sub channel_remove {
my ($self, $msg, $chan, $nicks) = @_;
for my $nick (@$nicks) {
if ($self->lower_case ($nick) eq $self->lower_case ($self->nick ())) {
delete $self->{chan_queue}->{$self->lower_case ($chan)};
delete $self->{channel_list}->{$self->lower_case ($chan)};
last;
} else {
delete $self->{channel_list}->{$self->lower_case ($chan)}->{$nick};
}
}
}
sub channel_add {
my ($self, $msg, $chan, $nicks, $modes) = @_;
my @mods = @$modes;
for my $nick (@$nicks) {
my $mode = shift @mods;
if ($self->is_my_nick ($nick)) {
for (@{$self->{chan_queue}->{$self->lower_case ($chan)}}) {
$self->send_msg (@$_);
}
$self->clear_chan_queue ($chan);
}
my $ch = $self->{channel_list}->{$self->lower_case ($chan)} ||= { };
if (defined $mode) {
$ch->{$nick} = $mode;
$self->event (channel_nickmode_update => $chan, $nick);
} else {
$ch->{$nick} = { } unless defined $ch->{$nick};
}
}
}
sub channel_mode_change {
my ($self, $chan, $op, $mode, $nick) = @_;
my $nickmode = $self->nick_modes ($chan, $nick);
defined $nickmode or return;
lib/AnyEvent/IRC/Client.pm view on Meta::CPAN
delete $self->{away_status};
} else { # away
$self->{away_status} = 1;
}
$self->event (away_status_change => $self->{away_status});
}
sub debug_cb {
my ($self, $msg) = @_;
$self->event (debug_recv => $msg);
}
sub change_nick_login_cb {
my ($self, $msg) = @_;
if ($self->registered) {
delete $self->{change_nick_cb_guard};
} else {
my $newnick = $self->{nick_change}->($self->nick);
if ($self->lower_case ($newnick) eq $self->lower_case ($self->{nick})) {
$self->disconnect ("couldn't change nick to non-conflicting one");
return 0;
}
$self->{nick} = $newnick;
$self->send_msg ("NICK", $newnick);
}
}
sub disconnect_cb {
my ($self) = @_;
for (keys %{$self->{channel_list}}) {
$self->channel_remove (undef, $_, [$self->nick]);
$self->event (channel_remove => undef, $_, $self->nick)
}
$self->cleanup;
}
sub rpl_topic_cb {
my ($self, $msg) = @_;
my $chan = $msg->{params}->[1];
my $topic = $msg->{params}->[-1];
$self->event (channel_topic => $chan, $topic);
}
sub topic_change_cb {
my ($self, $msg) = @_;
my $who = prefix_nick ($msg);
my $chan = $msg->{params}->[0];
my $topic = $msg->{params}->[-1];
$self->event (channel_topic => $chan, $topic, $who);
}
sub update_ident_cb {
my ($self, $msg) = @_;
if (is_nick_prefix ($msg->{prefix})) {
$self->update_ident ($msg->{prefix});
}
}
sub update_ident_nick_change_cb {
my ($self, $old, $new) = @_;
my $oldid = $self->nick_ident ($old);
return unless defined $oldid;
my ($n, $u, $h) = split_prefix ($oldid);
$self->update_ident (join_prefix ($new, $u, $h));
}
sub ctcp_auto_reply_cb {
my ($self, $src, $targ, $tag, $msg, $type) = @_;
return if $type ne 'PRIVMSG';
my $ctcprepl = $self->{ctcp_auto_replies}->{$tag}
or return;
if (ref ($ctcprepl->[0]) eq 'CODE') {
$ctcprepl = [$ctcprepl->[0]->($self, $src, $targ, $tag, $msg, $type)]
}
$self->send_msg (NOTICE => $src, encode_ctcp (@$ctcprepl));
}
=back
=head1 EXAMPLES
See samples/anyeventirccl and other samples in samples/ for some examples on how to use AnyEvent::IRC::Client.
=head1 AUTHOR
Robin Redeker, C<< <elmex@ta-sa.org> >>
=head1 SEE ALSO
L<AnyEvent::IRC::Connection>
RFC 1459 - Internet Relay Chat: Client Protocol
=head1 COPYRIGHT & LICENSE
Copyright 2006-2009 Robin Redeker, all rights reserved.
This program is free software; you can redistribute it and/or modify it
under the same terms as Perl itself.
=cut
1;
( run in 0.307 second using v1.01-cache-2.11-cpan-eab888a1d7d )