ViewVC Help
View File | Revision Log | Show Annotations | Download File
/cvs/Net-IRC3/lib/Net/IRC3/Util.pm
(Generate patch)

Comparing Net-IRC3/lib/Net/IRC3/Util.pm (file contents):
Revision 1.5 by elmex, Mon Jul 17 18:44:08 2006 UTC vs.
Revision 1.6 by elmex, Tue Jul 18 11:12:09 2006 UTC

2use strict; 2use strict;
3use Exporter; 3use Exporter;
4our @ISA = qw/Exporter/; 4our @ISA = qw/Exporter/;
5our @EXPORT_OK = 5our @EXPORT_OK =
6 qw(mk_msg parse_irc_msg split_prefix prefix_nick 6 qw(mk_msg parse_irc_msg split_prefix prefix_nick
7 decode_ctcp prefix_user prefix_host); 7 decode_ctcp filter_ctcp_text_attr prefix_user prefix_host);
8 8
9=head1 NAME 9=head1 NAME
10 10
11Net::IRC3::Util - Common utilities that help with IRC protocol handling 11Net::IRC3::Util - Common utilities that help with IRC protocol handling
12 12
135 135
136 return $msg; 136 return $msg;
137} 137}
138 138
139 139
140=item B<decode_ctcp ($ircmsg)> or B<decode_ctcp ($line)> 140=item B<decode_ctcp_req ($line)>
141 141
142=cut 142=cut
143 143
144sub decode_ctcp { 144sub decode_ctcp {
145 my ($self, $msg) = @_; 145 my ($line) = @_;
146 my $line = ref $msg ? $msg->{trailing} : $msg;
147 my $msg = ref $msg ? $msg : { };
148 146
149 if ($line =~ m/^\001(.*?)\001$/) { 147 while ($line =~ /\G\001([^\001]*)\001/g) {
150 my $ctcpdata = $1; 148 my $req = $1;
151
152 # XXX: implement!
153
154 } else {
155 return { trailing => $line };
156 } 149 }
157 150
151 $line =~ s/\001[^\001]*\001//g;
158 152
159 return $msg; 153 return $line;
154}
155
156# implemented after the below CTCP spec, but
157# doesnt seem to be used by anyone... so it's untested.
158sub filter_ctcp_text_attr {
159 my ($line, $cb) = @_;
160 $cb ||= sub { '' };
161 $line =~ s/\006([BVUSI])/{warn "FIL\n"; my $c = $cb->($1); defined $c ? $c : "\006$1"}/ieg;
162 $line =~ s/\006CA((?:I[0-9A-F]|#[0-9A-F]{3}){2})/{my $c = $cb->($1); defined $c ? $c : "\006CA$1"}/ieg;
163 $line =~ s/\006C([FB])(I[0-9A-F]|#[0-9A-F]{3})/{my $c = $cb->($1, $2); defined $c ? $c : "\006C$1$2"}/ieg;
164 $line =~ s/\006CX([AFB])/{my $c = $cb->($1); defined $c ? $c : "\006CX$1"}/ieg;
165 return $line;
160} 166}
161 167
162=item B<split_prefix ($prefix)> 168=item B<split_prefix ($prefix)>
163 169
164This function splits an IRC user prefix as described by RFC 2817 170This function splits an IRC user prefix as described by RFC 2817
225 231
226Robin Redeker, C<< <elmex@ta-sa.org> >> 232Robin Redeker, C<< <elmex@ta-sa.org> >>
227 233
228=head1 SEE ALSO 234=head1 SEE ALSO
229 235
236Internet Relay Chat Client To Client Protocol from February 2, 1997
237http://www.invlogic.com/irc/ctcp.html
238
230RFC 2812 - Internet Relay Chat: Client Protocol 239RFC 2812 - Internet Relay Chat: Client Protocol
231 240
232=head1 COPYRIGHT & LICENSE 241=head1 COPYRIGHT & LICENSE
233 242
234Copyright 2006 Robin Redeker, all rights reserved. 243Copyright 2006 Robin Redeker, all rights reserved.

Diff Legend

Removed lines
+ Added lines
< Changed lines
> Changed lines