Net/IRC3/Connection.pm

package Net::IRC3::Connection;
use strict;
use AnyEvent;
use IO::Socket::INET;
use Net::IRC3::Util qw/mk_msg parse_irc_msg/;

=head1 NAME

Net::IRC3::Connection - An IRC connection abstraction

=head1 SYNOPSIS

   #...
   $con->send_msg (undef, "PRIVMSG", "Hello there!", "yournick");
   #...

=head1 DESCRIPTION

The connection class. Here the actual interesting stuff can be done,
such as sending and receiving IRC messages.

=head2 METHODS

=over 4

=cut

package Net::IRC3::Connection;

use strict;
use AnyEvent;
use IO::Socket::INET;
use Net::IRC3 qw/parse_irc_msg mk_msg/;

sub new
{
  my $this = shift;
  my $class = ref($this) || $this;

  my $self = {
     pirc => $_[0],
     s => $_[1],
     h => $_[2],
     p => $_[3],
     cbs => {},
     heap => {}
  };

  bless $self, $class;

  return $self;
}

=item B<disconnect ($reason)>

Unregisters the connection in the main Net::IRC3 object, closes
the sockets and send a 'disconnect' event with C<$reason> as argument.

=cut

sub disconnect {
   my ($self, $reason) = @_;

   $self->event (disconnect => $reason);

   delete $self->{rw};
   delete $self->{ww};
   delete $self->{pirc}->{connections}->{$self->{h} . ":" . $self->{p}};
   delete $self->{pirc};

   eval { $self->{s}->close }
}

=item B<heap ()>

Returns a hash reference that is local to this connection object
that lets you store any information you want.

=cut

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

=item B<send_msg (@ircmsg)>

This function sends a message to the server. C<@ircmsg> is the argumentlist
for C<mk_msg>.

=cut

sub send_msg {
   my ($self, @msg) = @_;
   my $data = mk_msg (@msg);

   my ($host, $port) = ($self->{h}, $self->{p});
   $self->{outbuf} .= $data;

   unless (defined $self->{ww}) {
      my $sock = $self->{s};
      $self->{ww} =
         AnyEvent->io (poll => 'w', fh => $sock, cb => sub {
            my $l = syswrite $sock, $self->{outbuf};

            substr $self->{outbuf}, 0, $l, "";

            if (length ($self->{outbuf}) == 0) { delete $self->{ww} }

            unless ($l) {
               # XXX: is this behaviour correct or ok?
               $self->disconnect ("Error while writing to IRC server '$host:$port': $!");
               return;
            }
         });
   }
}

=item B<reg_cb ($cmd, $cb)> or B<reg_cb ($cmd1, $cb1, $cmd2, $cb2, ..., $cmdN, $cbN)>

This registers a callback in the connection class.
These callbacks will be called by internal events and
by IRC protocol commands. You can also specify multiple callback registrations.

The first argument to the callbacks is always the connection object
itself.

If a callback returns a false value, it will be unregistered.

NOTE: I<A callback has to return true to stay alive>

If C<$cmd> starts with 'irc_' the callback C<$cb> will be registered
for a IRC protocol command. The command is the suffix of C<$cmd> then.
The second argument to the callback is the message hash reference
that has the layout that is returned by C<parse_irc_msg>.

With the special C<$cmd> 'irc_*' the callback will be called on I<any>
IRC command that is received.

EXAMPLE:

   $con->reg_cb (irc_privmsg => \&privmsg_handler);
   # privmsg_handler will be called if an IRC message
   # with the command 'PRIVMSG' arrives.

If C<$cmd> is not prefixed with a 'irc_' it will be called when an event
with the name C<$cmd> is emitted. The arguments to the callback depend
on the event that is emitted (but remember: the first argument will always be the
connection object)

Following events are emitted by this module and shouldn't be emitted
from a module user call to C<event>.

=over 4

=item B<disconnect $reason>

This event will be generated if the connection is somehow terminated.
It will also be emitted when C<disconnect> is called.
The second argument to the callback is C<$reason>, a string that contains
a clue about why the connection terminated.

After this event the connection will be invalid and shouldn't be used any further.
If you want to reestablish a connection, call C<connect> on the manage object (C<Net::IRC3>)
again.

=back

=cut

sub reg_cb {
   my ($self, %regs) = @_;

   for my $cmd (keys %regs) {
      my $cb = $regs{$cmd};

      if ($cmd =~ m/^irc_(\S+)/i) {
         push @{$self->{cbs}->{lc $1}}, $cb;

      } else {
         push @{$self->{events}->{$cmd}}, $cb;
      }
   }

   1;
}

=item B<event ($event, @args)>

This function emits an event with the name C<$event> and the arguments C<@args>.
The registerd callback that has been registered with C<reg_cb> will be called
with the first argument being the connection object and the rest of the arguments
being C<@args>.

EXAMPLE

   $con->reg_cb (test_event => sub { print "Yay, i love $_[1]!!\n");
   $con->event (test_event => "IRC");

   # will print "Yay, i love IRC!!\n"

=cut

sub event {
   my ($self, $ev, @arg) = @_;

   my $nxt = [];

   for (@{$self->{events}->{lc $ev}}) {
      $_->($self, @arg) and push @$nxt, $_;
   }

   $self->{events}->{lc $ev} = $nxt;
}

# internal function, called by the read callbacks above.
sub feed_irc_data {
   my ($self, $data) = @_;

   $self->{buffer} .= $data;

   my @msg;
   while ($self->{buffer} =~ s/^([^\015\012]*)\015?\012//) {
      push @msg, $1;
   }

   for (@msg) {
      my $m = parse_irc_msg ($_);

      my $nxt = [];

      for (@{$self->{cbs}->{lc $m->{command}}}) {
         $_->($self, $m) and push @$nxt, $_;
      }

      $self->{cbs}->{lc $m->{command}} = $nxt;

      $nxt = [];

      for (@{$self->{cbs}->{'*'}}) {
         $_->($self, $m) and push @$nxt, $_;
      }

      $self->{cbs}->{'*'} = $nxt;
   }
}


=back

=head1 AUTHOR

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

=head1 SEE ALSO

L<Net::IRC3>

=head1 COPYRIGHT & LICENSE

Copyright 2006 Robin Redker, 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.4
Committed:	Sun Jul 16 19:44:50 2006 UTC (20 years, 3 months ago) by elmex
Branch:	MAIN
Changes since 1.3:	+1 -1 lines
Log Message:	moved utilitys to Util.pm and fixed a bug in nick chasing
#	User	Rev	Content
1	elmex	1.1	package Net::IRC3::Connection;
2			use strict;
3			use AnyEvent;
4			use IO::Socket::INET;
5	elmex	1.4	use Net::IRC3::Util qw/mk_msg parse_irc_msg/;
6	elmex	1.1
7			=head1 NAME
8
9			Net::IRC3::Connection - An IRC connection abstraction
10
11			=head1 SYNOPSIS
12
13			#...
14			$con->send_msg (undef, "PRIVMSG", "Hello there!", "yournick");
15			#...
16
17			=head1 DESCRIPTION
18
19			The connection class. Here the actual interesting stuff can be done,
20			such as sending and receiving IRC messages.
21
22			=head2 METHODS
23
24			=over 4
25
26			=cut
27
28			package Net::IRC3::Connection;
29
30			use strict;
31			use AnyEvent;
32			use IO::Socket::INET;
33			use Net::IRC3 qw/parse_irc_msg mk_msg/;
34
35			sub new
36			{
37			my $this = shift;
38			my $class = ref($this) \|\| $this;
39
40			my $self = {
41			pirc => $_[0],
42			s => $_[1],
43			h => $_[2],
44			p => $_[3],
45			cbs => {},
46			heap => {}
47			};
48
49			bless $self, $class;
50
51			return $self;
52			}
53
54	elmex	1.2	=item B<disconnect ($reason)>
55	elmex	1.1
56			Unregisters the connection in the main Net::IRC3 object, closes
57			the sockets and send a 'disconnect' event with C<$reason> as argument.
58
59			=cut
60
61	elmex	1.2	sub disconnect {
62	elmex	1.1	my ($self, $reason) = @_;
63
64			$self->event (disconnect => $reason);
65
66			delete $self->{rw};
67			delete $self->{ww};
68			delete $self->{pirc}->{connections}->{$self->{h} . ":" . $self->{p}};
69	elmex	1.2	delete $self->{pirc};
70	elmex	1.1
71			eval { $self->{s}->close }
72			}
73
74			=item B<heap ()>
75
76			Returns a hash reference that is local to this connection object
77			that lets you store any information you want.
78
79			=cut
80
81			sub heap {
82			my ($self) = @_;
83			return $self->{heap};
84			}
85
86			=item B<send_msg (@ircmsg)>
87
88			This function sends a message to the server. C<@ircmsg> is the argumentlist
89			for C<mk_msg>.
90
91			=cut
92
93			sub send_msg {
94			my ($self, @msg) = @_;
95			my $data = mk_msg (@msg);
96
97			my ($host, $port) = ($self->{h}, $self->{p});
98			$self->{outbuf} .= $data;
99
100			unless (defined $self->{ww}) {
101			my $sock = $self->{s};
102			$self->{ww} =
103			AnyEvent->io (poll => 'w', fh => $sock, cb => sub {
104			my $l = syswrite $sock, $self->{outbuf};
105
106			substr $self->{outbuf}, 0, $l, "";
107
108			if (length ($self->{outbuf}) == 0) { delete $self->{ww} }
109
110			unless ($l) {
111			# XXX: is this behaviour correct or ok?
112	elmex	1.2	$self->disconnect ("Error while writing to IRC server '$host:$port': $!");
113	elmex	1.1	return;
114			}
115			});
116			}
117			}
118
119	elmex	1.3	=item B<reg_cb ($cmd, $cb)> or B<reg_cb ($cmd1, $cb1, $cmd2, $cb2, ..., $cmdN, $cbN)>
120	elmex	1.1
121			This registers a callback in the connection class.
122			These callbacks will be called by internal events and
123	elmex	1.3	by IRC protocol commands. You can also specify multiple callback registrations.
124	elmex	1.1
125			The first argument to the callbacks is always the connection object
126			itself.
127
128			If a callback returns a false value, it will be unregistered.
129
130			NOTE: I<A callback has to return true to stay alive>
131
132			If C<$cmd> starts with 'irc_' the callback C<$cb> will be registered
133			for a IRC protocol command. The command is the suffix of C<$cmd> then.
134			The second argument to the callback is the message hash reference
135			that has the layout that is returned by C<parse_irc_msg>.
136
137			With the special C<$cmd> 'irc_*' the callback will be called on I<any>
138			IRC command that is received.
139
140			EXAMPLE:
141
142			$con->reg_cb (irc_privmsg => \&privmsg_handler);
143			# privmsg_handler will be called if an IRC message
144			# with the command 'PRIVMSG' arrives.
145
146			If C<$cmd> is not prefixed with a 'irc_' it will be called when an event
147			with the name C<$cmd> is emitted. The arguments to the callback depend
148			on the event that is emitted (but remember: the first argument will always be the
149			connection object)
150
151			Following events are emitted by this module and shouldn't be emitted
152			from a module user call to C<event>.
153
154			=over 4
155
156			=item B<disconnect $reason>
157
158			This event will be generated if the connection is somehow terminated.
159	elmex	1.2	It will also be emitted when C<disconnect> is called.
160	elmex	1.1	The second argument to the callback is C<$reason>, a string that contains
161			a clue about why the connection terminated.
162
163	elmex	1.2	After this event the connection will be invalid and shouldn't be used any further.
164			If you want to reestablish a connection, call C<connect> on the manage object (C<Net::IRC3>)
165			again.
166
167	elmex	1.1	=back
168
169			=cut
170
171			sub reg_cb {
172	elmex	1.3	my ($self, %regs) = @_;
173	elmex	1.1
174	elmex	1.3	for my $cmd (keys %regs) {
175			my $cb = $regs{$cmd};
176	elmex	1.1
177	elmex	1.3	if ($cmd =~ m/^irc_(\S+)/i) {
178			push @{$self->{cbs}->{lc $1}}, $cb;
179
180			} else {
181			push @{$self->{events}->{$cmd}}, $cb;
182			}
183	elmex	1.1	}
184
185			1;
186			}
187
188			=item B<event ($event, @args)>
189
190			This function emits an event with the name C<$event> and the arguments C<@args>.
191			The registerd callback that has been registered with C<reg_cb> will be called
192			with the first argument being the connection object and the rest of the arguments
193			being C<@args>.
194
195			EXAMPLE
196
197			$con->reg_cb (test_event => sub { print "Yay, i love $_[1]!!\n");
198			$con->event (test_event => "IRC");
199
200			# will print "Yay, i love IRC!!\n"
201
202			=cut
203
204			sub event {
205			my ($self, $ev, @arg) = @_;
206
207			my $nxt = [];
208
209			for (@{$self->{events}->{lc $ev}}) {
210			$_->($self, @arg) and push @$nxt, $_;
211			}
212
213			$self->{events}->{lc $ev} = $nxt;
214			}
215
216			# internal function, called by the read callbacks above.
217			sub feed_irc_data {
218			my ($self, $data) = @_;
219
220			$self->{buffer} .= $data;
221
222			my @msg;
223			while ($self->{buffer} =~ s/^([^\015\012]*)\015?\012//) {
224			push @msg, $1;
225			}
226
227			for (@msg) {
228			my $m = parse_irc_msg ($_);
229
230			my $nxt = [];
231
232			for (@{$self->{cbs}->{lc $m->{command}}}) {
233			$_->($self, $m) and push @$nxt, $_;
234			}
235
236			$self->{cbs}->{lc $m->{command}} = $nxt;
237
238			$nxt = [];
239
240			for (@{$self->{cbs}->{'*'}}) {
241			$_->($self, $m) and push @$nxt, $_;
242			}
243
244			$self->{cbs}->{'*'} = $nxt;
245			}
246			}
247
248
249			=back
250
251			=head1 AUTHOR
252
253			Robin Redeker, C<< <elmex@ta-sa.org> >>
254
255			=head1 SEE ALSO
256
257			L<Net::IRC3>
258
259			=head1 COPYRIGHT & LICENSE
260
261			Copyright 2006 Robin Redker, all rights reserved.
262
263			This program is free software; you can redistribute it and/or modify it
264			under the same terms as Perl itself.
265
266			=cut
267
268			1;