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 (disconnect  => \&disconnect_cb);

   $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->{channel_list}->{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->{channel_list}->{lc $chan};
         last;
      } else {
         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->{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 (@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)
         if $self->{channel_list}->{$_}->{$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
}

sub disconnect_cb {
   my ($self) = @_;

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

   1
}

=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.15
Committed:	Sat Feb 17 23:42:00 2007 UTC (19 years, 8 months ago) by elmex
Branch:	MAIN
Changes since 1.14:	+11 -0 lines
Log Message:	disconnect now also does send channel_add/remove events
#	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	elmex	1.15	$self->reg_cb (disconnect => \&disconnect_cb);
172	elmex	1.2
173	elmex	1.13	$self->reg_cb (irc_437 => \&change_nick_login);
174			$self->reg_cb (irc_433 => \&change_nick_login);
175
176			$self->{nick_change} = sub {
177			my ($old_nick) = @_;
178			"${old_nick}_"
179			};
180
181	elmex	1.2	return $self;
182			}
183
184			=item B<register ($nick, $user, $real)>
185
186			Sends the IRC registration commands NICK and USER.
187
188			=cut
189
190			sub register {
191			my ($self, $nick, $user, $real) = @_;
192
193	elmex	1.13	$self->{nick} = $nick;
194			$self->{user} = $user;
195			$self->{real} = $real;
196
197	elmex	1.1	$self->send_msg (undef, "NICK", undef, $nick);
198			$self->send_msg (undef, "USER", $real \|\| $nick, $user \|\| $nick, "*", "0");
199	elmex	1.13	}
200
201			=item B<set_nick_change_cb $callback>
202
203			This method lets you modify the nickname renaming mechanism when registering
204			the connection. C<$callback> is called with the current nickname as first
205			argument when a ERR_NICKNAMEINUSE or ERR_UNAVAILRESOURCE error occurs on login.
206			The returnvalue of C<$callback> will then be used to change the nickname.
207
208			The default callback appends '_' to the end of the nickname supplied in the
209			C<register> routine.
210
211			If the callback returns the same nickname that was given it the connection
212			will be terminated.
213	elmex	1.1
214	elmex	1.13	=cut
215
216			sub set_nick_change_cb {
217			my ($self, $cb) = @_;
218			$self->{nick_change} = $cb;
219	elmex	1.1	}
220
221			=item B<nick ()>
222
223			Returns the current nickname, under which this connection
224			is registered at the IRC server. It might be different from the
225			one that was passed to C<register> as a nick-collision might happened
226			on login.
227
228			=cut
229
230			sub nick { $_[0]->{nick} }
231
232	elmex	1.13	=item B<connected ()>
233
234			Returns a true value when the connection has been registered successfull and
235			you can send commands.
236
237			=cut
238
239			sub connected { $_[0]->{connected} }
240
241	elmex	1.1	=item B<channel_list ()>
242
243	elmex	1.13	This returns a hash reference. The keys are the currently joined channels in lower case.
244			The values are hash references which contain the joined nicks as key.
245
246			NOTE: Future versions might preserve the case from the JOIN command to the channels.
247	elmex	1.1
248			=cut
249
250			sub channel_list {
251			my ($self) = @_;
252	elmex	1.12	return $self->{channel_list} \|\| {};
253	elmex	1.1	}
254
255	elmex	1.5	=item B<send_srv ($command, $trailing, @params)>
256	elmex	1.1
257	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>).
258	elmex	1.1	If the connection isn't yet registered (for example if the connection is slow) and hasn't got a
259			welcome (IRC command 001) from the server yet, the IRC message is queued until it gets a welcome.
260
261			=cut
262
263			sub send_srv {
264			my ($self, @msg) = @_;
265
266			if ($self->{connected}) {
267			$self->send_msg (undef, @msg);
268
269			} else {
270			push @{$self->{con_queue}}, \@msg;
271			}
272			}
273
274			=item B<clear_srv_queue>
275
276			Clears the server send queue.
277
278			=cut
279
280			sub clear_srv_queue {
281			my ($self) = @_;
282			$self->{con_queue} = [];
283			}
284
285
286	elmex	1.5	=item B<send_chan ($channel, $command, $trailing, @params))>
287
288	elmex	1.13	This function sends a message (constructed by C<mk_msg (undef, $command,
289			$trailing, @params)> to the server, like C<send_srv> only that it will queue
290			the messages if it hasn't joined the channel C<$channel> yet. The queued
291			messages will be send once the connection successfully JOINed the C<$channel>.
292	elmex	1.1
293	elmex	1.12	C<$channel> will be lowercased so that any case that comes from the server matches.
294			(Yes, IRC handles upper and lower case as equal :-(
295
296			Be careful with this, there are chances you might not join the channel you
297			wanted to join. You may wanted to join #bla and the server redirects that
298			and sends you that you joined #blubb. You may use C<clear_chan_queue> to
299			remove the queue after some timeout after joining, so that you don't end up
300			with a memory leak.
301
302	elmex	1.1	=cut
303
304			sub send_chan {
305			my ($self, $chan, @msg) = @_;
306
307	elmex	1.14	if ($self->{channel_list}->{lc $chan}) {
308	elmex	1.1	$self->send_msg (undef, @msg);
309
310			} else {
311			push @{$self->{chan_queue}->{lc $chan}}, \@msg;
312			}
313			}
314
315			=item B<clear_chan_queue ($channel)>
316
317			Clears the channel queue of the channel C<$channel>.
318
319			=cut
320
321			sub clear_chan_queue {
322			my ($self, $chan) = @_;
323			$self->{chan_queue}->{lc $chan} = [];
324			}
325
326			################################################################################
327	elmex	1.2	# Private utility functions
328			################################################################################
329
330			sub _was_me {
331			my ($self, $msg) = @_;
332	elmex	1.4	lc prefix_nick ($msg) eq lc $self->nick ()
333	elmex	1.2	}
334
335			################################################################################
336	elmex	1.1	# Callbacks
337			################################################################################
338
339	elmex	1.2	sub channel_remove_event {
340			my ($self, $chan, @nicks) = @_;
341
342			for my $nick (@nicks) {
343	elmex	1.12	if (lc ($nick) eq lc ($self->nick ())) {
344			delete $self->{chan_queue}->{lc $chan};
345	elmex	1.13	delete $self->{channel_list}->{lc $chan};
346	elmex	1.2	last;
347			} else {
348	elmex	1.13	delete $self->{channel_list}->{lc $chan}->{$nick};
349	elmex	1.2	}
350			}
351
352			1;
353			}
354
355			sub channel_add_event {
356			my ($self, $chan, @nicks) = @_;
357
358			for my $nick (@nicks) {
359	elmex	1.12	if (lc ($nick) eq lc ($self->nick ())) {
360			for (@{$self->{chan_queue}->{lc $chan}}) {
361	elmex	1.2	$self->send_msg (undef, @$_);
362			}
363	elmex	1.11	$self->clear_chan_queue ($chan);
364	elmex	1.2	}
365
366	elmex	1.13	$self->{channel_list}->{lc $chan}->{$nick} = 1;
367	elmex	1.2	}
368
369			1;
370			}
371
372	elmex	1.1	sub anymsg_cb {
373			my ($self, $msg) = @_;
374
375			my $cmd = lc $msg->{command};
376
377	elmex	1.13	if ( $cmd ne "privmsg"
378	elmex	1.1	and $cmd ne "notice"
379			and $cmd ne "part"
380			and $cmd ne "join"
381	elmex	1.13	and not ($cmd >= 400 and $cmd <= 599)
382			)
383	elmex	1.1	{
384			$self->event (statmsg => $msg);
385	elmex	1.13	} elsif ($cmd >= 400 and $cmd <= 599) {
386			$self->event (error => $msg->{command}, $msg->{trailing}, @{$msg->{params}});
387	elmex	1.1	}
388
389			1;
390			}
391
392			sub privmsg_cb {
393			my ($self, $msg) = @_;
394
395	elmex	1.3	my $targ = $msg->{params}->[0];
396			if ($targ =~ m/^(?:[#+&]\|![A-Z0-9]{5})/) {
397			$self->event (publicmsg => $targ, $msg);
398	elmex	1.1
399			} else {
400	elmex	1.3	$self->event (privatemsg => $targ, $msg);
401	elmex	1.1	}
402
403			1;
404			}
405
406			sub welcome_cb {
407			my ($self, $msg) = @_;
408
409			$self->{connected} = 1;
410
411			for (@{$self->{con_queue}}) {
412			$self->send_msg (undef, @$_);
413			}
414	elmex	1.11	$self->clear_srv_queue ();
415	elmex	1.1
416	elmex	1.12	$self->event ('registered');
417
418	elmex	1.1	1;
419			}
420
421			sub ping_cb {
422			my ($self, $msg) = @_;
423	elmex	1.8	$self->send_msg (undef, "PONG", $msg->{params}->[0]);
424	elmex	1.2
425			1;
426	elmex	1.1	}
427
428	elmex	1.12	sub nick_cb {
429			my ($self, $msg) = @_;
430			my $nick = prefix_nick ($msg);
431			my $newnick = $msg->{params}->[0];
432			my $wasme = $self->_was_me ($msg);
433
434	elmex	1.13	if ($wasme) { $self->{nick} = $newnick }
435	elmex	1.12
436	elmex	1.13	my @chans;
437	elmex	1.12
438	elmex	1.13	for my $channame (keys %{$self->{channel_list}}) {
439			my $chan = $self->{channel_list}->{$channame};
440	elmex	1.12	if (exists $chan->{$nick}) {
441			delete $chan->{$nick};
442			$chan->{$newnick} = 1;
443	elmex	1.13	push @chans, $channame;
444	elmex	1.12	}
445			}
446
447	elmex	1.13	for (@chans) {
448			$self->event (channel_change => $_, $nick, $newnick, $wasme);
449			}
450	elmex	1.12	$self->event (nick_change => $nick, $newnick, $wasme);
451			}
452
453	elmex	1.1	sub namereply_cb {
454			my ($self, $msg) = @_;
455	elmex	1.2	my @nicks = split / /, $msg->{trailing};
456			push @{$self->{_tmp_namereply}}, @nicks;
457	elmex	1.10
458			1;
459	elmex	1.1	}
460
461			sub endofnames_cb {
462			my ($self, $msg) = @_;
463	elmex	1.12	my $chan = $msg->{params}->[1];
464	elmex	1.4	$self->event (channel_add => $chan, map { s/^[@\+]//; $_ } @{delete $self->{_tmp_namereply}});
465	elmex	1.10
466			1;
467	elmex	1.1	}
468
469			sub join_cb {
470			my ($self, $msg) = @_;
471	elmex	1.2	my $chan = $msg->{params}->[0];
472	elmex	1.4	my $nick = prefix_nick ($msg);
473	elmex	1.1
474	elmex	1.12	$self->event (channel_add => $chan, $nick);
475	elmex	1.2	$self->event (join => $nick, $chan, $self->_was_me ($msg));
476	elmex	1.1
477	elmex	1.2	1;
478			}
479
480			sub part_cb {
481			my ($self, $msg) = @_;
482			my $chan = $msg->{params}->[0];
483	elmex	1.4	my $nick = prefix_nick ($msg);
484	elmex	1.1
485	elmex	1.2	$self->event (part => $nick, $chan, $self->_was_me ($msg), $msg->{params}->[1]);
486			$self->event (channel_remove => $chan, $nick);
487	elmex	1.1
488	elmex	1.2	1;
489			}
490	elmex	1.1
491	elmex	1.2	sub kick_cb {
492			my ($self, $msg) = @_;
493			my $chan = $msg->{params}->[0];
494			my $kicked_nick = $msg->{params}->[1];
495	elmex	1.1
496	elmex	1.2	$self->event (channel_remove => $chan, $kicked_nick);
497	elmex	1.1
498			1;
499			}
500
501	elmex	1.2	sub quit_cb {
502	elmex	1.1	my ($self, $msg) = @_;
503	elmex	1.4	my $nick = prefix_nick ($msg);
504	elmex	1.1
505	elmex	1.2	$self->event (quit => $nick, $msg->{params}->[1]);
506	elmex	1.1
507	elmex	1.12	for (keys %{$self->{channel_list}}) {
508	elmex	1.14	$self->event (channel_remove => $_, $nick)
509			if $self->{channel_list}->{$_}->{$nick};
510	elmex	1.1	}
511	elmex	1.10
512			1;
513	elmex	1.1	}
514
515			sub debug_cb {
516			my ($self, $msg) = @_;
517			print "$self->{h}:$self->{p} > ";
518			my $par = delete $msg->{params};
519			print (join " ", map { $_ => $msg->{$_} } sort keys %$msg);
520			print " params:";
521			print (join ",", @$par);
522			print "\n";
523	elmex	1.10
524			1;
525	elmex	1.1	}
526
527	elmex	1.13	sub change_nick_login {
528			my ($self, $msg) = @_;
529
530			unless ($self->{connected}) {
531			my $newnick = $self->{nick_change}->($self->nick);
532
533			if (lc $newnick eq lc $self->{nick}) {
534			$self->disconnect;
535			return 0;
536			}
537
538			$self->{nick} = $newnick;
539			$self->send_msg (undef, "NICK", undef, $newnick);
540			}
541
542			not ($self->{connected}) # kill the cb when connected
543			}
544
545	elmex	1.15	sub disconnect_cb {
546			my ($self) = @_;
547
548			for (keys %{$self->{channel_list}}) {
549			$self->event (channel_remove => $_, $self->nick)
550			}
551
552			1
553			}
554
555	elmex	1.1	=back
556
557			=head1 EXAMPLES
558
559			See samples/netirc3cl and other samples in samples/ for some examples on how to use Net::IRC3::Client::Connection.
560
561			=head1 AUTHOR
562
563			Robin Redeker, C<< <elmex@ta-sa.org> >>
564
565			=head1 SEE ALSO
566
567	elmex	1.7	L<Net::IRC3::Connection>
568	elmex	1.1
569			RFC 2812 - Internet Relay Chat: Client Protocol
570
571			=head1 COPYRIGHT & LICENSE
572
573	elmex	1.6	Copyright 2006 Robin Redeker, all rights reserved.
574	elmex	1.1
575			This program is free software; you can redistribute it and/or modify it
576			under the same terms as Perl itself.
577
578			=cut
579
580			1;