| … | |
… | |
| 4 | use Exporter; |
4 | use Exporter; |
| 5 | our @ISA = qw/Exporter/; |
5 | our @ISA = qw/Exporter/; |
| 6 | our @EXPORT_OK = |
6 | our @EXPORT_OK = |
| 7 | qw(mk_msg parse_irc_msg split_prefix prefix_nick |
7 | qw(mk_msg parse_irc_msg split_prefix prefix_nick |
| 8 | decode_ctcp encode_ctcp filter_ctcp_text_attr prefix_user prefix_host |
8 | decode_ctcp encode_ctcp filter_ctcp_text_attr prefix_user prefix_host |
| 9 | rfc_code_to_name); |
9 | rfc_code_to_name filter_colors); |
| 10 | |
10 | |
| 11 | =head1 NAME |
11 | =head1 NAME |
| 12 | |
12 | |
| 13 | Net::IRC3::Util - Common utilities that help with IRC protocol handling |
13 | Net::IRC3::Util - Common utilities that help with IRC protocol handling |
| 14 | |
14 | |
| … | |
… | |
| 135 | $msg .= defined $trail ? " :$trail" : ""; |
135 | $msg .= defined $trail ? " :$trail" : ""; |
| 136 | $msg .= "\015\012"; |
136 | $msg .= "\015\012"; |
| 137 | |
137 | |
| 138 | return $msg; |
138 | return $msg; |
| 139 | } |
139 | } |
| 140 | |
|
|
| 141 | |
|
|
| 142 | =item B<decode_ctcp ($line)> |
|
|
| 143 | |
|
|
| 144 | TODO |
|
|
| 145 | |
|
|
| 146 | =cut |
|
|
| 147 | |
140 | |
| 148 | my @_ctcp_lowlevel_escape = ("\000", "0", "\012", "n", "\015", "r", "\020", "\020"); |
141 | my @_ctcp_lowlevel_escape = ("\000", "0", "\012", "n", "\015", "r", "\020", "\020"); |
| 149 | |
142 | |
| 150 | sub unescape_lowlevel { |
143 | sub unescape_lowlevel { |
| 151 | my ($data) = @_; |
144 | my ($data) = @_; |
| … | |
… | |
| 225 | : $_ |
218 | : $_ |
| 226 | } @args |
219 | } @args |
| 227 | ) |
220 | ) |
| 228 | } |
221 | } |
| 229 | |
222 | |
| 230 | =item B<filter_ctcp_text_attr ($line, $cb)> |
223 | =item B<filter_colors ($line)> |
| 231 | |
224 | |
| 232 | TODO |
225 | This function will filter out any mIRC colors and (most) ansi escape sequences. |
|
|
226 | Unfortunately the mIRC color coding will destroy improper colored numbers. So this |
|
|
227 | function may destroy the message in some occasions a bit. |
| 233 | |
228 | |
| 234 | =cut |
229 | =cut |
|
|
230 | |
|
|
231 | sub filter_colors { |
|
|
232 | my ($line) = @_; |
|
|
233 | $line =~ s/\x1B\[.*?[\x00-\x1F\x40-\x7E]//g; # see ECMA-48 + advice by urxvt author |
|
|
234 | $line =~ s/\x03\d\d?(?:,\d\d?)?//g; # see http://www.mirc.co.uk/help/color.txt |
|
|
235 | $line |
|
|
236 | } |
|
|
237 | |
|
|
238 | |
| 235 | # implemented after the below CTCP spec, but |
239 | # implemented after the below CTCP spec, but |
| 236 | # doesnt seem to be used by anyone... so it's untested. |
240 | # doesnt seem to be used by anyone... so it's untested. |
| 237 | sub filter_ctcp_text_attr { |
241 | sub filter_ctcp_text_attr_bogus { |
| 238 | my ($line, $cb) = @_; |
242 | my ($line, $cb) = @_; |
| 239 | return unless $cb; |
243 | return unless $cb; |
| 240 | $line =~ s/\006([BVUSI])/{warn "FIL\n"; my $c = $cb->($1); defined $c ? $c : "\006$1"}/ieg; |
244 | $line =~ s/\006([BVUSI])/{warn "FIL\n"; my $c = $cb->($1); defined $c ? $c : "\006$1"}/ieg; |
| 241 | $line =~ s/\006CA((?:I[0-9A-F]|#[0-9A-F]{3}){2})/{my $c = $cb->($1); defined $c ? $c : "\006CA$1"}/ieg; |
245 | $line =~ s/\006CA((?:I[0-9A-F]|#[0-9A-F]{3}){2})/{my $c = $cb->($1); defined $c ? $c : "\006CA$1"}/ieg; |
| 242 | $line =~ s/\006C([FB])(I[0-9A-F]|#[0-9A-F]{3})/{my $c = $cb->($1, $2); defined $c ? $c : "\006C$1$2"}/ieg; |
246 | $line =~ s/\006C([FB])(I[0-9A-F]|#[0-9A-F]{3})/{my $c = $cb->($1, $2); defined $c ? $c : "\006C$1$2"}/ieg; |
