| … | |
… | |
| 3 | no warnings; |
3 | no warnings; |
| 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 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); |
| 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 |
| … | |
… | |
| 143 | |
143 | |
| 144 | TODO |
144 | TODO |
| 145 | |
145 | |
| 146 | =cut |
146 | =cut |
| 147 | |
147 | |
|
|
148 | my @_ctcp_lowlevel_escape = ("\000", "0", "\012", "n", "\015", "r", "\020", "\020"); |
|
|
149 | |
|
|
150 | sub unescape_lowlevel { |
|
|
151 | my ($data) = @_; |
|
|
152 | my %map = reverse @_ctcp_lowlevel_escape; |
|
|
153 | $data =~ s/\020(.)/defined $map{$1} ? $map{$1} : $1/ge; |
|
|
154 | $data |
|
|
155 | } |
|
|
156 | |
|
|
157 | sub escape_lowlevel { |
|
|
158 | my ($data) = @_; |
|
|
159 | my %map = @_ctcp_lowlevel_escape; |
|
|
160 | $data =~ s/([\000\012\015\020])/"\020$map{$1}"/ge; |
|
|
161 | $data |
|
|
162 | } |
|
|
163 | |
|
|
164 | sub unescape_ctcp { |
|
|
165 | my ($data) = @_; |
|
|
166 | $data =~ s/\\(.)/$1 eq 'a' ? "\001" : ($1 eq "\\" ? "\\" : $1)/eg; |
|
|
167 | $data |
|
|
168 | } |
|
|
169 | |
|
|
170 | sub escape_ctcp { |
|
|
171 | my ($data) = @_; |
|
|
172 | $data =~ s/([\\\001])/$1 eq "\001" ? "\\a" : "\\\\"/eg; |
|
|
173 | $data |
|
|
174 | } |
|
|
175 | |
|
|
176 | =item B<decode_ctcp ($trailing)> |
|
|
177 | |
|
|
178 | This function decodes the C<$trailing> part of an IRC message. |
|
|
179 | It will first unescape the lower layer, extract CTCP messages |
|
|
180 | and then return a list with two elements: the line without the ctcp messages |
|
|
181 | and an array reference which contains array references of CTCP messages. |
|
|
182 | Those CTCP message array references will have the CTCP message tag as |
|
|
183 | first element (eg. "VERSION") and the rest of the CTCP message as the second |
|
|
184 | element. |
|
|
185 | |
|
|
186 | =cut |
|
|
187 | |
| 148 | sub decode_ctcp { |
188 | sub decode_ctcp { |
| 149 | my ($line) = @_; |
189 | my ($line) = @_; |
| 150 | |
190 | |
|
|
191 | $line = unescape_lowlevel ($line); |
|
|
192 | my @ctcp; |
| 151 | while ($line =~ /\G\001([^\001]*)\001/g) { |
193 | while ($line =~ /\G\001([^\001]*)\001/g) { |
| 152 | my $req = $1; |
194 | my $msg = unescape_ctcp ($1); |
|
|
195 | my ($tag, $data) = split / /, $msg, 2; |
|
|
196 | push @ctcp, [$tag, $data]; |
| 153 | } |
197 | } |
| 154 | |
198 | |
| 155 | $line =~ s/\001[^\001]*\001//g; |
199 | $line =~ s/\001[^\001]*\001//g; |
| 156 | |
200 | |
| 157 | return $line; |
201 | return ($line, \@ctcp) |
|
|
202 | } |
|
|
203 | |
|
|
204 | =item B<encode_ctcp (@msg)> |
|
|
205 | |
|
|
206 | This function encodes a ctcp message for the trailing part of a NOTICE |
|
|
207 | or PRIVMSG. C<@msg> is an array of strings or array references. |
|
|
208 | If an array reference occurs in the C<@msg> array it's first |
|
|
209 | element will be interpreted as CTCP TAG (eg. one of PING, VERSION, .. whatever) |
|
|
210 | the rest of the array ref will be appended to the tag and seperated by |
|
|
211 | spaces. |
|
|
212 | |
|
|
213 | All parts of the message will be contatenated and lowlevel quoted. |
|
|
214 | That means you can embed _any_ character from 0 to 255 in this message (thats |
|
|
215 | what the lowlevel quoting allows). |
|
|
216 | |
|
|
217 | =cut |
|
|
218 | |
|
|
219 | sub encode_ctcp { |
|
|
220 | my (@args) = @_; |
|
|
221 | escape_lowlevel ( |
|
|
222 | join "", map { |
|
|
223 | ref $_ |
|
|
224 | ? "\001" . escape_ctcp (join " ", @$_) . "\001" |
|
|
225 | : $_ |
|
|
226 | } @args |
|
|
227 | ) |
| 158 | } |
228 | } |
| 159 | |
229 | |
| 160 | =item B<filter_ctcp_text_attr ($line, $cb)> |
230 | =item B<filter_ctcp_text_attr ($line, $cb)> |
| 161 | |
231 | |
| 162 | TODO |
232 | TODO |
