Net/IRC3/Connection.pm

package Net::IRC3::Connection;
use strict;
use AnyEvent;
use IO::Socket::INET;
use Net::IRC3 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)>

This registers a callback in the connection class.
These callbacks will be called by internal events and
by IRC protocol commands.

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, $cmd, $cb) = @_;

   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.2
Committed:	Sun Jul 16 11:11:17 2006 UTC (20 years, 3 months ago) by elmex
Branch:	MAIN
Changes since 1.1:	+9 -4 lines
Log Message:	version 0.2. added documentation and refactored code a bit.
#	User	Rev	Content
1	elmex	1.1	package Net::IRC3::Connection;
2			use strict;
3			use AnyEvent;
4			use IO::Socket::INET;
5			use Net::IRC3 qw/mk_msg parse_irc_msg/;
6
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			=item B<reg_cb ($cmd, $cb)>
120
121			This registers a callback in the connection class.
122			These callbacks will be called by internal events and
123			by IRC protocol commands.
124
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			my ($self, $cmd, $cb) = @_;
173
174			if ($cmd =~ m/^irc_(\S+)/i) {
175			push @{$self->{cbs}->{lc $1}}, $cb;
176
177			} else {
178			push @{$self->{events}->{$cmd}}, $cb;
179			}
180
181			1;
182			}
183
184			=item B<event ($event, @args)>
185
186			This function emits an event with the name C<$event> and the arguments C<@args>.
187			The registerd callback that has been registered with C<reg_cb> will be called
188			with the first argument being the connection object and the rest of the arguments
189			being C<@args>.
190
191			EXAMPLE
192
193			$con->reg_cb (test_event => sub { print "Yay, i love $_[1]!!\n");
194			$con->event (test_event => "IRC");
195
196			# will print "Yay, i love IRC!!\n"
197
198			=cut
199
200			sub event {
201			my ($self, $ev, @arg) = @_;
202
203			my $nxt = [];
204
205			for (@{$self->{events}->{lc $ev}}) {
206			$_->($self, @arg) and push @$nxt, $_;
207			}
208
209			$self->{events}->{lc $ev} = $nxt;
210			}
211
212			# internal function, called by the read callbacks above.
213			sub feed_irc_data {
214			my ($self, $data) = @_;
215
216			$self->{buffer} .= $data;
217
218			my @msg;
219			while ($self->{buffer} =~ s/^([^\015\012]*)\015?\012//) {
220			push @msg, $1;
221			}
222
223			for (@msg) {
224			my $m = parse_irc_msg ($_);
225
226			my $nxt = [];
227
228			for (@{$self->{cbs}->{lc $m->{command}}}) {
229			$_->($self, $m) and push @$nxt, $_;
230			}
231
232			$self->{cbs}->{lc $m->{command}} = $nxt;
233
234			$nxt = [];
235
236			for (@{$self->{cbs}->{'*'}}) {
237			$_->($self, $m) and push @$nxt, $_;
238			}
239
240			$self->{cbs}->{'*'} = $nxt;
241			}
242			}
243
244
245			=back
246
247			=head1 AUTHOR
248
249			Robin Redeker, C<< <elmex@ta-sa.org> >>
250
251			=head1 SEE ALSO
252
253			L<Net::IRC3>
254
255			=head1 COPYRIGHT & LICENSE
256
257			Copyright 2006 Robin Redker, all rights reserved.
258
259			This program is free software; you can redistribute it and/or modify it
260			under the same terms as Perl itself.
261
262			=cut
263
264			1;