IRC3/Client/Connection.pm

package Net::IRC3::Client::Connection;
use base "Net::IRC3::Connection";
use Net::IRC3::Util qw/prefix_nick/;
use strict;

our $DEBUG;

=head1 NAME

Net::IRC3::Client::Connection - A highlevel IRC connection

=head1 SYNOPSIS

   use AnyEvent;
   use Net::IRC3::Client::Connection;

   my $c = AnyEvent->condvar;

   my $timer;
   my $con = new Net::IRC3::Client::Connection;

   $con->reg_cb (registered => sub { print "I'm in!\n"; 0 });
   $con->reg_cb (disconnect => sub { print "I'm out!\n"; 0 });
   $con->reg_cb (
      sent => sub {
         if ($_[2] eq 'PRIVMSG') {
            print "Sent message!\n";
            $timer = AnyEvent->timer (after => 1, cb => sub { $c->broadcast });
         }
         1
      }
   );

   $con->send_srv (PRIVMSG => "Hello there i'm the cool Net::IRC3 test script!", 'elmex');

   $con->connect ("localhost", 6667);
   $con->register (qw/testbot testbot testbot/);

   $c->wait;
   undef $timer;

   $con->disconnect;

=head1 DESCRIPTION

L<Net::IRC3::Client::Connection> is a highlevel client connection,
that manages all the stuff that noone wants to implement again and again
when handling with IRC. For example it PONGs the server or keeps track
of the users on a channel.

=head2 A NOTE TO CASE MANAGEMENT

The case insensitivity of channelnames and nicknames can lead to headaches
when dealing with IRC in an automated client which tracks channels and nicknames.

I tried to preserve the case in all channel and nicknames
Net::IRC3::Client::Connection passes to his user. But in the internal
structures i'm using lower case for the channel names.

The returned hash from C<channel_list> for example has the lower case of the
joined channels as keys.

But i tried to preserve the case in all events that are emitted.
Please keep this in mind when handling the events.

For example a user might joins #TeSt and parts #test later.

=head1 EVENTS

The following events are emitted by L<Net::IRC3::Client::Connection>.
Use C<reg_cb> as described in L<Net::IRC3::Connection> to register to such an
event.

=over 4

=item B<registered>

Emitted when the connection got successfully registered.

=item B<channel_add $channel @nicks>

Emitted when C<@nicks> are added to the channel C<$channel>,
this happens for example when someone JOINs a channel or when you
get a RPL_NAMREPLY (see RFC2812).

=item B<channel_remove $channel @nicks>

Emitted when C<@nicks> are removed from the channel C<$channel>,
happens for example when they PART, QUIT or get KICKed.

=item B<channel_change $channel $old_nick $new_nick $is_myself>

Emitted when a nickname on a channel changes. This is emitted when a NICK
change occurs from C<$old_nick> to C<$new_nick> give the application a chance
to quickly analyze what channels were affected.  C<$is_myself> is true when
youself was the one who changed the nick.

=item B<join $nick $channel $is_myself>

Emitted when C<$nick> enters the channel C<$channel> by JOINing.
C<$is_myself> is true if youself are the one who JOINs.

=item B<part $nick $channel $is_myself $msg>

Emitted when C<$nick> PARTs the channel C<$channel>.
C<$is_myself> is true if youself are the one who PARTs.
C<$msg> is the PART message.

=item B<nick_change $old_nick $new_nick $is_myself>

Emitted when C<$old_nick> is renamed to C<$new_nick>.
C<$is_myself> is true when youself was the one who changed the nick.

=item B<quit $nick $msg>

Emitted when the nickname C<$nick> QUITs with the message C<$msg>.

=item B<publicmsg $channel $ircmsg>

Emitted for NOTICE and PRIVMSG where the target C<$channel> is a channel.
C<$ircmsg> is the original IRC message hash like it is returned by C<parse_irc_msg>.

=item B<privatemsg $nick $ircmsg>

Emitted for NOTICE and PRIVMSG where the target C<$nick> (most of the time you) is a nick.
C<$ircmsg> is the original IRC message hash like it is returned by C<parse_irc_msg>.

=item B<error $code $message @params>

Emitted when any error occurs. C<$code> is the 3 digit error id string from RFC
2812 and C<$message> is a description of the error. C<@params> is the complete
parameter list of the error command, including the C<$message> at the end of
C<@params>.

You may use Net::IRC3::Util::rfc_code_to_name to convert C<$code> to the error
name from the RFC 2812. eg.:

   rfc_code_to_name ('471') => 'ERR_CHANNELISFULL'

=back

=head1 METHODS

=over 4

=cut

sub new {
   my $this = shift;
   my $class = ref($this) || $this;
   my $self = $class->SUPER::new (@_);
   $self->reg_cb (irc_001     => \&welcome_cb);
   $self->reg_cb (irc_join    => \&join_cb);
   $self->reg_cb (irc_nick    => \&nick_cb);
   $self->reg_cb (irc_part    => \&part_cb);
   $self->reg_cb (irc_kick    => \&kick_cb);
   $self->reg_cb (irc_quit    => \&quit_cb);
   $self->reg_cb (irc_353     => \&namereply_cb);
   $self->reg_cb (irc_366     => \&endofnames_cb);
   $self->reg_cb (irc_ping    => \&ping_cb);

   $self->reg_cb (irc_privmsg => \&privmsg_cb);
   $self->reg_cb (irc_notice  => \&privmsg_cb);

   $self->reg_cb ('irc_*'     => \&debug_cb)
      if $DEBUG;
   $self->reg_cb ('irc_*'     => \&anymsg_cb);

   $self->reg_cb (channel_remove => \&channel_remove_event);
   $self->reg_cb (channel_add    => \&channel_add_event);

   $self->reg_cb (irc_437     => \&change_nick_login);
   $self->reg_cb (irc_433     => \&change_nick_login);

   $self->{nick_change} = sub {
      my ($old_nick) = @_;
      "${old_nick}_"
   };

   return $self;
}

=item B<register ($nick, $user, $real)>

Sends the IRC registration commands NICK and USER.

=cut

sub register {
   my ($self, $nick, $user, $real) = @_;

   $self->{nick} = $nick;
   $self->{user} = $user;
   $self->{real} = $real;

   $self->send_msg (undef, "NICK", undef, $nick);
   $self->send_msg (undef, "USER", $real || $nick, $user || $nick, "*", "0");
}

=item B<set_nick_change_cb $callback>

This method lets you modify the nickname renaming mechanism when registering
the connection. C<$callback> is called with the current nickname as first
argument when a ERR_NICKNAMEINUSE or ERR_UNAVAILRESOURCE error occurs on login.
The returnvalue of C<$callback> will then be used to change the nickname.

The default callback appends '_' to the end of the nickname supplied in the
C<register> routine.

If the callback returns the same nickname that was given it the connection
will be terminated.

=cut

sub set_nick_change_cb {
   my ($self, $cb) = @_;
   $self->{nick_change} = $cb;
}

=item B<nick ()>

Returns the current nickname, under which this connection
is registered at the IRC server. It might be different from the
one that was passed to C<register> as a nick-collision might happened
on login.

=cut

sub nick { $_[0]->{nick} }

=item B<connected ()>

Returns a true value when the connection has been registered successfull and
you can send commands.

=cut

sub connected { $_[0]->{connected} }

=item B<channel_list ()>

This returns a hash reference. The keys are the currently joined channels in lower case.
The values are hash references which contain the joined nicks as key.

NOTE: Future versions might preserve the case from the JOIN command to the channels.

=cut

sub channel_list {
   my ($self) = @_;
   return $self->{channel_list} || {};
}

=item B<send_srv ($command, $trailing, @params)>

This function sends an IRC message that is constructed by C<mk_msg (undef, $command, $trailing, @params)> (see L<Net::IRC3::Util>).
If the connection isn't yet registered (for example if the connection is slow) and hasn't got a
welcome (IRC command 001) from the server yet, the IRC message is queued until it gets a welcome.

=cut

sub send_srv {
   my ($self, @msg) = @_;

   if ($self->{connected}) {
      $self->send_msg (undef, @msg);

   } else {
      push @{$self->{con_queue}}, \@msg;
   }
}

=item B<clear_srv_queue>

Clears the server send queue.

=cut

sub clear_srv_queue {
   my ($self) = @_;
   $self->{con_queue} = [];
}


=item B<send_chan ($channel, $command, $trailing, @params))>

This function sends a message (constructed by C<mk_msg (undef, $command,
$trailing, @params)> to the server, like C<send_srv> only that it will queue
the messages if it hasn't joined the channel C<$channel> yet. The queued
messages will be send once the connection successfully JOINed the C<$channel>.

C<$channel> will be lowercased so that any case that comes from the server matches.
(Yes, IRC handles upper and lower case as equal :-(

Be careful with this, there are chances you might not join the channel you
wanted to join. You may wanted to join #bla and the server redirects that
and sends you that you joined #blubb. You may use C<clear_chan_queue> to
remove the queue after some timeout after joining, so that you don't end up
with a memory leak.

=cut

sub send_chan {
   my ($self, $chan, @msg) = @_;

   if ($self->{channels}->{lc $chan}) {
      $self->send_msg (undef, @msg);

   } else {
      push @{$self->{chan_queue}->{lc $chan}}, \@msg;
   }
}

=item B<clear_chan_queue ($channel)>

Clears the channel queue of the channel C<$channel>.

=cut

sub clear_chan_queue {
   my ($self, $chan) = @_;
   $self->{chan_queue}->{lc $chan} = [];
}

################################################################################
# Private utility functions
################################################################################

sub _was_me {
   my ($self, $msg) = @_;
   lc prefix_nick ($msg) eq lc $self->nick ()
}

################################################################################
# Callbacks
################################################################################

sub channel_remove_event {
   my ($self, $chan, @nicks) = @_;

   for my $nick (@nicks) {
      if (lc ($nick) eq lc ($self->nick ())) {
         delete $self->{chan_queue}->{lc $chan};
         delete $self->{channels}->{lc $chan};
         delete $self->{channel_list}->{lc $chan};
         last;
      } else {
         delete $self->{channels}->{lc $chan}->{lc $nick};
         delete $self->{channel_list}->{lc $chan}->{$nick};
      }
   }

   1;
}

sub channel_add_event {
   my ($self, $chan, @nicks) = @_;

   for my $nick (@nicks) {
      if (lc ($nick) eq lc ($self->nick ())) {
         for (@{$self->{chan_queue}->{lc $chan}}) {
            $self->send_msg (undef, @$_);
         }
         $self->clear_chan_queue ($chan);
      }

      $self->{channels}->{lc $chan}->{lc $nick} = 1;
      $self->{channel_list}->{lc $chan}->{$nick} = 1;
   }

   1;
}

sub anymsg_cb {
   my ($self, $msg) = @_;

   my $cmd = lc $msg->{command};

   if (    $cmd ne "privmsg"
       and $cmd ne "notice"
       and $cmd ne "part"
       and $cmd ne "join"
       and not ($cmd >= 400 and $cmd <= 599)
      )
   {
      $self->event (statmsg => $msg);
   } elsif ($cmd >= 400 and $cmd <= 599) {
      $self->event (error => $msg->{command}, $msg->{trailing}, @{$msg->{params}});
   }

   1;
}

sub privmsg_cb {
   my ($self, $msg) = @_;

   my $targ = $msg->{params}->[0];
   if ($targ =~ m/^(?:[#+&]|![A-Z0-9]{5})/) {
      $self->event (publicmsg => $targ, $msg);

   } else {
      $self->event (privatemsg => $targ, $msg);
   }

   1;
}

sub welcome_cb {
   my ($self, $msg) = @_;

   $self->{connected} = 1;

   for (@{$self->{con_queue}}) {
      $self->send_msg (undef, @$_);
   }
   $self->clear_srv_queue ();

   $self->event ('registered');

   1;
}

sub ping_cb {
   my ($self, $msg) = @_;
   $self->send_msg (undef, "PONG", $msg->{params}->[0]);

   1;
}

sub nick_cb {
   my ($self, $msg) = @_;
   my $nick = prefix_nick ($msg);
   my $newnick = $msg->{params}->[0];
   my $wasme = $self->_was_me ($msg);

   if ($wasme) { $self->{nick} = $newnick }

   my @chans;

   for my $channame (keys %{$self->{channel_list}}) {
      my $chan = $self->{channel_list}->{$channame};
      if (exists $chan->{$nick}) {
         delete $chan->{$nick};
         $chan->{$newnick} = 1;
         push @chans, $channame;
      }
   }

   for my $chan (values %{$self->{channels}}) {
      if (exists $chan->{lc $nick}) {
         delete $chan->{lc $nick};
         $chan->{lc $newnick} = 1;
      }
   }

   for (@chans) {
      $self->event (channel_change => $_, $nick, $newnick, $wasme);
   }
   $self->event (nick_change => $nick, $newnick, $wasme);
}

sub namereply_cb {
   my ($self, $msg) = @_;
   my @nicks = split / /, $msg->{trailing};
   push @{$self->{_tmp_namereply}}, @nicks;

   1;
}

sub endofnames_cb {
   my ($self, $msg) = @_;
   my $chan = $msg->{params}->[1];
   $self->event (channel_add => $chan, map { s/^[@\+]//; $_ } @{delete $self->{_tmp_namereply}});

   1;
}

sub join_cb {
   my ($self, $msg) = @_;
   my $chan = $msg->{params}->[0];
   my $nick = prefix_nick ($msg);

   $self->event (channel_add => $chan, $nick);
   $self->event (join        => $nick, $chan, $self->_was_me ($msg));

   1;
}

sub part_cb {
   my ($self, $msg) = @_;
   my $chan = $msg->{params}->[0];
   my $nick = prefix_nick ($msg);

   $self->event (part           => $nick, $chan, $self->_was_me ($msg), $msg->{params}->[1]);
   $self->event (channel_remove => $chan, $nick);

   1;
}

sub kick_cb {
   my ($self, $msg) = @_;
   my $chan        = $msg->{params}->[0];
   my $kicked_nick = $msg->{params}->[1];

   $self->event (channel_remove => $chan, $kicked_nick);

   1;
}

sub quit_cb {
   my ($self, $msg) = @_;
   my $nick = prefix_nick ($msg);

   $self->event (quit => $nick, $msg->{params}->[1]);

   for (keys %{$self->{channel_list}}) {
      $self->event (channel_remove => $_, $nick);
   }

   1;
}

sub debug_cb {
   my ($self, $msg) = @_;
   print "$self->{h}:$self->{p} > ";
   my $par = delete $msg->{params};
   print (join " ", map { $_ => $msg->{$_} } sort keys %$msg);
   print " params:";
   print (join ",", @$par);
   print "\n";

   1;
}

sub change_nick_login {
   my ($self, $msg) = @_;

   unless ($self->{connected}) {
      my $newnick = $self->{nick_change}->($self->nick);

      if (lc $newnick eq lc $self->{nick}) {
         $self->disconnect;
         return 0;
      }

      $self->{nick} = $newnick;
      $self->send_msg (undef, "NICK", undef, $newnick);
   }

   not ($self->{connected}) # kill the cb when connected
}

=back

=head1 EXAMPLES

See samples/netirc3cl and other samples in samples/ for some examples on how to use Net::IRC3::Client::Connection.

=head1 AUTHOR

Robin Redeker, C<< <elmex@ta-sa.org> >>

=head1 SEE ALSO

L<Net::IRC3::Connection>

RFC 2812 - Internet Relay Chat: Client Protocol

=head1 COPYRIGHT & LICENSE

Copyright 2006 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;
Revision:	1.13
Committed:	Tue Jan 16 19:39:17 2007 UTC (19 years, 9 months ago) by elmex
Branch:	MAIN
Changes since 1.12:	+119 -18 lines
Log Message:	Net::IRC3: - fixed case handling with channels - added functionality to change the nick automatically when it is already taken when registering an IRC connection. (Net::IRC3::Client::Connection) - added reply number <=> reply name mapping to Net::IRC3::Util accessible through rfc_code_to_name - added error event to Net::IRC3::Client::Connection json chat framework: - client history - nick listing more correct - improved completion (added nick completion) - further improvement of the protocol - finally got the id handling correct - added logging to jsonsrv - many other changes i forgot.
#	User	Rev	Content
1	elmex	1.1	package Net::IRC3::Client::Connection;
2	elmex	1.4	use base "Net::IRC3::Connection";
3			use Net::IRC3::Util qw/prefix_nick/;
4	elmex	1.12	use strict;
5	elmex	1.1
6	elmex	1.4	our $DEBUG;
7	elmex	1.1
8			=head1 NAME
9
10			Net::IRC3::Client::Connection - A highlevel IRC connection
11
12			=head1 SYNOPSIS
13
14	elmex	1.5	use AnyEvent;
15			use Net::IRC3::Client::Connection;
16	elmex	1.1
17	elmex	1.5	my $c = AnyEvent->condvar;
18	elmex	1.1
19	elmex	1.5	my $timer;
20			my $con = new Net::IRC3::Client::Connection;
21	elmex	1.1
22	elmex	1.5	$con->reg_cb (registered => sub { print "I'm in!\n"; 0 });
23			$con->reg_cb (disconnect => sub { print "I'm out!\n"; 0 });
24			$con->reg_cb (
25			sent => sub {
26			if ($_[2] eq 'PRIVMSG') {
27			print "Sent message!\n";
28			$timer = AnyEvent->timer (after => 1, cb => sub { $c->broadcast });
29			}
30			1
31			}
32			);
33
34			$con->send_srv (PRIVMSG => "Hello there i'm the cool Net::IRC3 test script!", 'elmex');
35
36			$con->connect ("localhost", 6667);
37			$con->register (qw/testbot testbot testbot/);
38	elmex	1.1
39	elmex	1.5	$c->wait;
40			undef $timer;
41
42			$con->disconnect;
43	elmex	1.1
44			=head1 DESCRIPTION
45
46	elmex	1.5	L<Net::IRC3::Client::Connection> is a highlevel client connection,
47			that manages all the stuff that noone wants to implement again and again
48			when handling with IRC. For example it PONGs the server or keeps track
49			of the users on a channel.
50	elmex	1.1
51	elmex	1.13	=head2 A NOTE TO CASE MANAGEMENT
52
53			The case insensitivity of channelnames and nicknames can lead to headaches
54			when dealing with IRC in an automated client which tracks channels and nicknames.
55
56			I tried to preserve the case in all channel and nicknames
57			Net::IRC3::Client::Connection passes to his user. But in the internal
58			structures i'm using lower case for the channel names.
59
60			The returned hash from C<channel_list> for example has the lower case of the
61			joined channels as keys.
62
63			But i tried to preserve the case in all events that are emitted.
64			Please keep this in mind when handling the events.
65
66			For example a user might joins #TeSt and parts #test later.
67
68	elmex	1.2	=head1 EVENTS
69
70			The following events are emitted by L<Net::IRC3::Client::Connection>.
71			Use C<reg_cb> as described in L<Net::IRC3::Connection> to register to such an
72			event.
73	elmex	1.1
74			=over 4
75
76	elmex	1.3	=item B<registered>
77
78			Emitted when the connection got successfully registered.
79
80	elmex	1.2	=item B<channel_add $channel @nicks>
81
82			Emitted when C<@nicks> are added to the channel C<$channel>,
83			this happens for example when someone JOINs a channel or when you
84			get a RPL_NAMREPLY (see RFC2812).
85
86			=item B<channel_remove $channel @nicks>
87
88			Emitted when C<@nicks> are removed from the channel C<$channel>,
89			happens for example when they PART, QUIT or get KICKed.
90
91	elmex	1.13	=item B<channel_change $channel $old_nick $new_nick $is_myself>
92
93			Emitted when a nickname on a channel changes. This is emitted when a NICK
94			change occurs from C<$old_nick> to C<$new_nick> give the application a chance
95			to quickly analyze what channels were affected. C<$is_myself> is true when
96			youself was the one who changed the nick.
97
98	elmex	1.2	=item B<join $nick $channel $is_myself>
99
100			Emitted when C<$nick> enters the channel C<$channel> by JOINing.
101			C<$is_myself> is true if youself are the one who JOINs.
102
103			=item B<part $nick $channel $is_myself $msg>
104
105			Emitted when C<$nick> PARTs the channel C<$channel>.
106			C<$is_myself> is true if youself are the one who PARTs.
107			C<$msg> is the PART message.
108	elmex	1.1
109	elmex	1.13	=item B<nick_change $old_nick $new_nick $is_myself>
110	elmex	1.12
111			Emitted when C<$old_nick> is renamed to C<$new_nick>.
112			C<$is_myself> is true when youself was the one who changed the nick.
113
114	elmex	1.3	=item B<quit $nick $msg>
115
116			Emitted when the nickname C<$nick> QUITs with the message C<$msg>.
117
118			=item B<publicmsg $channel $ircmsg>
119
120			Emitted for NOTICE and PRIVMSG where the target C<$channel> is a channel.
121			C<$ircmsg> is the original IRC message hash like it is returned by C<parse_irc_msg>.
122
123			=item B<privatemsg $nick $ircmsg>
124
125			Emitted for NOTICE and PRIVMSG where the target C<$nick> (most of the time you) is a nick.
126			C<$ircmsg> is the original IRC message hash like it is returned by C<parse_irc_msg>.
127
128	elmex	1.13	=item B<error $code $message @params>
129
130			Emitted when any error occurs. C<$code> is the 3 digit error id string from RFC
131			2812 and C<$message> is a description of the error. C<@params> is the complete
132			parameter list of the error command, including the C<$message> at the end of
133			C<@params>.
134
135			You may use Net::IRC3::Util::rfc_code_to_name to convert C<$code> to the error
136			name from the RFC 2812. eg.:
137
138			rfc_code_to_name ('471') => 'ERR_CHANNELISFULL'
139
140	elmex	1.2	=back
141
142			=head1 METHODS
143
144			=over 4
145	elmex	1.1
146			=cut
147
148	elmex	1.2	sub new {
149			my $this = shift;
150			my $class = ref($this) \|\| $this;
151			my $self = $class->SUPER::new (@_);
152	elmex	1.1	$self->reg_cb (irc_001 => \&welcome_cb);
153			$self->reg_cb (irc_join => \&join_cb);
154	elmex	1.12	$self->reg_cb (irc_nick => \&nick_cb);
155	elmex	1.1	$self->reg_cb (irc_part => \&part_cb);
156	elmex	1.2	$self->reg_cb (irc_kick => \&kick_cb);
157			$self->reg_cb (irc_quit => \&quit_cb);
158	elmex	1.1	$self->reg_cb (irc_353 => \&namereply_cb);
159			$self->reg_cb (irc_366 => \&endofnames_cb);
160			$self->reg_cb (irc_ping => \&ping_cb);
161
162			$self->reg_cb (irc_privmsg => \&privmsg_cb);
163			$self->reg_cb (irc_notice => \&privmsg_cb);
164
165			$self->reg_cb ('irc_*' => \&debug_cb)
166			if $DEBUG;
167			$self->reg_cb ('irc_*' => \&anymsg_cb);
168
169	elmex	1.2	$self->reg_cb (channel_remove => \&channel_remove_event);
170			$self->reg_cb (channel_add => \&channel_add_event);
171
172	elmex	1.13	$self->reg_cb (irc_437 => \&change_nick_login);
173			$self->reg_cb (irc_433 => \&change_nick_login);
174
175			$self->{nick_change} = sub {
176			my ($old_nick) = @_;
177			"${old_nick}_"
178			};
179
180	elmex	1.2	return $self;
181			}
182
183			=item B<register ($nick, $user, $real)>
184
185			Sends the IRC registration commands NICK and USER.
186
187			=cut
188
189			sub register {
190			my ($self, $nick, $user, $real) = @_;
191
192	elmex	1.13	$self->{nick} = $nick;
193			$self->{user} = $user;
194			$self->{real} = $real;
195
196	elmex	1.1	$self->send_msg (undef, "NICK", undef, $nick);
197			$self->send_msg (undef, "USER", $real \|\| $nick, $user \|\| $nick, "*", "0");
198	elmex	1.13	}
199
200			=item B<set_nick_change_cb $callback>
201
202			This method lets you modify the nickname renaming mechanism when registering
203			the connection. C<$callback> is called with the current nickname as first
204			argument when a ERR_NICKNAMEINUSE or ERR_UNAVAILRESOURCE error occurs on login.
205			The returnvalue of C<$callback> will then be used to change the nickname.
206
207			The default callback appends '_' to the end of the nickname supplied in the
208			C<register> routine.
209
210			If the callback returns the same nickname that was given it the connection
211			will be terminated.
212	elmex	1.1
213	elmex	1.13	=cut
214
215			sub set_nick_change_cb {
216			my ($self, $cb) = @_;
217			$self->{nick_change} = $cb;
218	elmex	1.1	}
219
220			=item B<nick ()>
221
222			Returns the current nickname, under which this connection
223			is registered at the IRC server. It might be different from the
224			one that was passed to C<register> as a nick-collision might happened
225			on login.
226
227			=cut
228
229			sub nick { $_[0]->{nick} }
230
231	elmex	1.13	=item B<connected ()>
232
233			Returns a true value when the connection has been registered successfull and
234			you can send commands.
235
236			=cut
237
238			sub connected { $_[0]->{connected} }
239
240	elmex	1.1	=item B<channel_list ()>
241
242	elmex	1.13	This returns a hash reference. The keys are the currently joined channels in lower case.
243			The values are hash references which contain the joined nicks as key.
244
245			NOTE: Future versions might preserve the case from the JOIN command to the channels.
246	elmex	1.1
247			=cut
248
249			sub channel_list {
250			my ($self) = @_;
251	elmex	1.12	return $self->{channel_list} \|\| {};
252	elmex	1.1	}
253
254	elmex	1.5	=item B<send_srv ($command, $trailing, @params)>
255	elmex	1.1
256	elmex	1.5	This function sends an IRC message that is constructed by C<mk_msg (undef, $command, $trailing, @params)> (see L<Net::IRC3::Util>).
257	elmex	1.1	If the connection isn't yet registered (for example if the connection is slow) and hasn't got a
258			welcome (IRC command 001) from the server yet, the IRC message is queued until it gets a welcome.
259
260			=cut
261
262			sub send_srv {
263			my ($self, @msg) = @_;
264
265			if ($self->{connected}) {
266			$self->send_msg (undef, @msg);
267
268			} else {
269			push @{$self->{con_queue}}, \@msg;
270			}
271			}
272
273			=item B<clear_srv_queue>
274
275			Clears the server send queue.
276
277			=cut
278
279			sub clear_srv_queue {
280			my ($self) = @_;
281			$self->{con_queue} = [];
282			}
283
284
285	elmex	1.5	=item B<send_chan ($channel, $command, $trailing, @params))>
286
287	elmex	1.13	This function sends a message (constructed by C<mk_msg (undef, $command,
288			$trailing, @params)> to the server, like C<send_srv> only that it will queue
289			the messages if it hasn't joined the channel C<$channel> yet. The queued
290			messages will be send once the connection successfully JOINed the C<$channel>.
291	elmex	1.1
292	elmex	1.12	C<$channel> will be lowercased so that any case that comes from the server matches.
293			(Yes, IRC handles upper and lower case as equal :-(
294
295			Be careful with this, there are chances you might not join the channel you
296			wanted to join. You may wanted to join #bla and the server redirects that
297			and sends you that you joined #blubb. You may use C<clear_chan_queue> to
298			remove the queue after some timeout after joining, so that you don't end up
299			with a memory leak.
300
301	elmex	1.1	=cut
302
303			sub send_chan {
304			my ($self, $chan, @msg) = @_;
305
306	elmex	1.2	if ($self->{channels}->{lc $chan}) {
307	elmex	1.1	$self->send_msg (undef, @msg);
308
309			} else {
310			push @{$self->{chan_queue}->{lc $chan}}, \@msg;
311			}
312			}
313
314			=item B<clear_chan_queue ($channel)>
315
316			Clears the channel queue of the channel C<$channel>.
317
318			=cut
319
320			sub clear_chan_queue {
321			my ($self, $chan) = @_;
322			$self->{chan_queue}->{lc $chan} = [];
323			}
324
325			################################################################################
326	elmex	1.2	# Private utility functions
327			################################################################################
328
329			sub _was_me {
330			my ($self, $msg) = @_;
331	elmex	1.4	lc prefix_nick ($msg) eq lc $self->nick ()
332	elmex	1.2	}
333
334			################################################################################
335	elmex	1.1	# Callbacks
336			################################################################################
337
338	elmex	1.2	sub channel_remove_event {
339			my ($self, $chan, @nicks) = @_;
340
341			for my $nick (@nicks) {
342	elmex	1.12	if (lc ($nick) eq lc ($self->nick ())) {
343			delete $self->{chan_queue}->{lc $chan};
344			delete $self->{channels}->{lc $chan};
345	elmex	1.13	delete $self->{channel_list}->{lc $chan};
346	elmex	1.2	last;
347			} else {
348	elmex	1.12	delete $self->{channels}->{lc $chan}->{lc $nick};
349	elmex	1.13	delete $self->{channel_list}->{lc $chan}->{$nick};
350	elmex	1.2	}
351			}
352
353			1;
354			}
355
356			sub channel_add_event {
357			my ($self, $chan, @nicks) = @_;
358
359			for my $nick (@nicks) {
360	elmex	1.12	if (lc ($nick) eq lc ($self->nick ())) {
361			for (@{$self->{chan_queue}->{lc $chan}}) {
362	elmex	1.2	$self->send_msg (undef, @$_);
363			}
364	elmex	1.11	$self->clear_chan_queue ($chan);
365	elmex	1.2	}
366
367	elmex	1.12	$self->{channels}->{lc $chan}->{lc $nick} = 1;
368	elmex	1.13	$self->{channel_list}->{lc $chan}->{$nick} = 1;
369	elmex	1.2	}
370
371			1;
372			}
373
374	elmex	1.1	sub anymsg_cb {
375			my ($self, $msg) = @_;
376
377			my $cmd = lc $msg->{command};
378
379	elmex	1.13	if ( $cmd ne "privmsg"
380	elmex	1.1	and $cmd ne "notice"
381			and $cmd ne "part"
382			and $cmd ne "join"
383	elmex	1.13	and not ($cmd >= 400 and $cmd <= 599)
384			)
385	elmex	1.1	{
386			$self->event (statmsg => $msg);
387	elmex	1.13	} elsif ($cmd >= 400 and $cmd <= 599) {
388			$self->event (error => $msg->{command}, $msg->{trailing}, @{$msg->{params}});
389	elmex	1.1	}
390
391			1;
392			}
393
394			sub privmsg_cb {
395			my ($self, $msg) = @_;
396
397	elmex	1.3	my $targ = $msg->{params}->[0];
398			if ($targ =~ m/^(?:[#+&]\|![A-Z0-9]{5})/) {
399			$self->event (publicmsg => $targ, $msg);
400	elmex	1.1
401			} else {
402	elmex	1.3	$self->event (privatemsg => $targ, $msg);
403	elmex	1.1	}
404
405			1;
406			}
407
408			sub welcome_cb {
409			my ($self, $msg) = @_;
410
411			$self->{connected} = 1;
412
413			for (@{$self->{con_queue}}) {
414			$self->send_msg (undef, @$_);
415			}
416	elmex	1.11	$self->clear_srv_queue ();
417	elmex	1.1
418	elmex	1.12	$self->event ('registered');
419
420	elmex	1.1	1;
421			}
422
423			sub ping_cb {
424			my ($self, $msg) = @_;
425	elmex	1.8	$self->send_msg (undef, "PONG", $msg->{params}->[0]);
426	elmex	1.2
427			1;
428	elmex	1.1	}
429
430	elmex	1.12	sub nick_cb {
431			my ($self, $msg) = @_;
432			my $nick = prefix_nick ($msg);
433			my $newnick = $msg->{params}->[0];
434			my $wasme = $self->_was_me ($msg);
435
436	elmex	1.13	if ($wasme) { $self->{nick} = $newnick }
437	elmex	1.12
438	elmex	1.13	my @chans;
439	elmex	1.12
440	elmex	1.13	for my $channame (keys %{$self->{channel_list}}) {
441			my $chan = $self->{channel_list}->{$channame};
442	elmex	1.12	if (exists $chan->{$nick}) {
443			delete $chan->{$nick};
444			$chan->{$newnick} = 1;
445	elmex	1.13	push @chans, $channame;
446	elmex	1.12	}
447			}
448
449			for my $chan (values %{$self->{channels}}) {
450			if (exists $chan->{lc $nick}) {
451			delete $chan->{lc $nick};
452			$chan->{lc $newnick} = 1;
453			}
454			}
455
456	elmex	1.13	for (@chans) {
457			$self->event (channel_change => $_, $nick, $newnick, $wasme);
458			}
459	elmex	1.12	$self->event (nick_change => $nick, $newnick, $wasme);
460			}
461
462	elmex	1.1	sub namereply_cb {
463			my ($self, $msg) = @_;
464	elmex	1.2	my @nicks = split / /, $msg->{trailing};
465			push @{$self->{_tmp_namereply}}, @nicks;
466	elmex	1.10
467			1;
468	elmex	1.1	}
469
470			sub endofnames_cb {
471			my ($self, $msg) = @_;
472	elmex	1.12	my $chan = $msg->{params}->[1];
473	elmex	1.4	$self->event (channel_add => $chan, map { s/^[@\+]//; $_ } @{delete $self->{_tmp_namereply}});
474	elmex	1.10
475			1;
476	elmex	1.1	}
477
478			sub join_cb {
479			my ($self, $msg) = @_;
480	elmex	1.2	my $chan = $msg->{params}->[0];
481	elmex	1.4	my $nick = prefix_nick ($msg);
482	elmex	1.1
483	elmex	1.12	$self->event (channel_add => $chan, $nick);
484	elmex	1.2	$self->event (join => $nick, $chan, $self->_was_me ($msg));
485	elmex	1.1
486	elmex	1.2	1;
487			}
488
489			sub part_cb {
490			my ($self, $msg) = @_;
491			my $chan = $msg->{params}->[0];
492	elmex	1.4	my $nick = prefix_nick ($msg);
493	elmex	1.1
494	elmex	1.2	$self->event (part => $nick, $chan, $self->_was_me ($msg), $msg->{params}->[1]);
495			$self->event (channel_remove => $chan, $nick);
496	elmex	1.1
497	elmex	1.2	1;
498			}
499	elmex	1.1
500	elmex	1.2	sub kick_cb {
501			my ($self, $msg) = @_;
502			my $chan = $msg->{params}->[0];
503			my $kicked_nick = $msg->{params}->[1];
504	elmex	1.1
505	elmex	1.2	$self->event (channel_remove => $chan, $kicked_nick);
506	elmex	1.1
507			1;
508			}
509
510	elmex	1.2	sub quit_cb {
511	elmex	1.1	my ($self, $msg) = @_;
512	elmex	1.4	my $nick = prefix_nick ($msg);
513	elmex	1.1
514	elmex	1.2	$self->event (quit => $nick, $msg->{params}->[1]);
515	elmex	1.1
516	elmex	1.12	for (keys %{$self->{channel_list}}) {
517	elmex	1.2	$self->event (channel_remove => $_, $nick);
518	elmex	1.1	}
519	elmex	1.10
520			1;
521	elmex	1.1	}
522
523			sub debug_cb {
524			my ($self, $msg) = @_;
525			print "$self->{h}:$self->{p} > ";
526			my $par = delete $msg->{params};
527			print (join " ", map { $_ => $msg->{$_} } sort keys %$msg);
528			print " params:";
529			print (join ",", @$par);
530			print "\n";
531	elmex	1.10
532			1;
533	elmex	1.1	}
534
535	elmex	1.13	sub change_nick_login {
536			my ($self, $msg) = @_;
537
538			unless ($self->{connected}) {
539			my $newnick = $self->{nick_change}->($self->nick);
540
541			if (lc $newnick eq lc $self->{nick}) {
542			$self->disconnect;
543			return 0;
544			}
545
546			$self->{nick} = $newnick;
547			$self->send_msg (undef, "NICK", undef, $newnick);
548			}
549
550			not ($self->{connected}) # kill the cb when connected
551			}
552
553	elmex	1.1	=back
554
555			=head1 EXAMPLES
556
557			See samples/netirc3cl and other samples in samples/ for some examples on how to use Net::IRC3::Client::Connection.
558
559			=head1 AUTHOR
560
561			Robin Redeker, C<< <elmex@ta-sa.org> >>
562
563			=head1 SEE ALSO
564
565	elmex	1.7	L<Net::IRC3::Connection>
566	elmex	1.1
567			RFC 2812 - Internet Relay Chat: Client Protocol
568
569			=head1 COPYRIGHT & LICENSE
570
571	elmex	1.6	Copyright 2006 Robin Redeker, all rights reserved.
572	elmex	1.1
573			This program is free software; you can redistribute it and/or modify it
574			under the same terms as Perl itself.
575
576			=cut
577
578			1;