| … | |
… | |
| 2 | use strict; |
2 | use strict; |
| 3 | use Exporter; |
3 | use Exporter; |
| 4 | our @ISA = qw/Exporter/; |
4 | our @ISA = qw/Exporter/; |
| 5 | our @EXPORT_OK = |
5 | our @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 | |
| 11 | Net::IRC3::Util - Common utilities that help with IRC protocol handling |
11 | Net::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 | |
| 144 | sub decode_ctcp { |
144 | sub 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. |
|
|
158 | sub 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 | |
| 164 | This function splits an IRC user prefix as described by RFC 2817 |
170 | This function splits an IRC user prefix as described by RFC 2817 |
| … | |
… | |
| 225 | |
231 | |
| 226 | Robin Redeker, C<< <elmex@ta-sa.org> >> |
232 | Robin Redeker, C<< <elmex@ta-sa.org> >> |
| 227 | |
233 | |
| 228 | =head1 SEE ALSO |
234 | =head1 SEE ALSO |
| 229 | |
235 | |
|
|
236 | Internet Relay Chat Client To Client Protocol from February 2, 1997 |
|
|
237 | http://www.invlogic.com/irc/ctcp.html |
|
|
238 | |
| 230 | RFC 2812 - Internet Relay Chat: Client Protocol |
239 | RFC 2812 - Internet Relay Chat: Client Protocol |
| 231 | |
240 | |
| 232 | =head1 COPYRIGHT & LICENSE |
241 | =head1 COPYRIGHT & LICENSE |
| 233 | |
242 | |
| 234 | Copyright 2006 Robin Redeker, all rights reserved. |
243 | Copyright 2006 Robin Redeker, all rights reserved. |
