… | |
… | |
68 | use Scalar::Util (); |
68 | use Scalar::Util (); |
69 | |
69 | |
70 | use AnyEvent; |
70 | use AnyEvent; |
71 | use AnyEvent::Handle; |
71 | use AnyEvent::Handle; |
72 | use AnyEvent::Util (); |
72 | use AnyEvent::Util (); |
|
|
73 | |
|
|
74 | our %TOLC; # tolc cache |
73 | |
75 | |
74 | sub touc($) { |
76 | sub touc($) { |
75 | local $_ = shift; |
77 | local $_ = shift; |
76 | 1 while s/((?:^|_)(?:svk|chk|uri|fcp|ds|mime|dda)(?:_|$))/\U$1/; |
78 | 1 while s/((?:^|_)(?:svk|chk|uri|fcp|ds|mime|dda)(?:_|$))/\U$1/; |
77 | s/(?:^|_)(.)/\U$1/g; |
79 | s/(?:^|_)(.)/\U$1/g; |
… | |
… | |
232 | |
234 | |
233 | if (my $cb = $PERSISTENT_TYPE{$type}) { |
235 | if (my $cb = $PERSISTENT_TYPE{$type}) { |
234 | my $id = $kv->{identifier}; |
236 | my $id = $kv->{identifier}; |
235 | my $req = $_[0]{req}{$id} ||= {}; |
237 | my $req = $_[0]{req}{$id} ||= {}; |
236 | $cb->($self, $req, $kv); |
238 | $cb->($self, $req, $kv); |
237 | $self->recv (request_change => $kv, $type, @extra); |
239 | $self->recv (request_changed => $kv, $type, @extra); |
238 | } |
240 | } |
239 | |
241 | |
240 | my $on = $self->{on}; |
242 | my $on = $self->{on}; |
241 | for (0 .. $#$on) { |
243 | for (0 .. $#$on) { |
242 | unless (my $res = $on->[$_]($self, $type, $kv, @extra)) { |
244 | unless (my $res = $on->[$_]($self, $type, $kv, @extra)) { |
… | |
… | |
254 | } |
256 | } |
255 | |
257 | |
256 | sub on_read { |
258 | sub on_read { |
257 | my ($self) = @_; |
259 | my ($self) = @_; |
258 | |
260 | |
259 | my $type; |
261 | my ($k, $v, $type); |
260 | my %kv; |
262 | my %kv; |
261 | my $rdata; |
263 | my $rdata; |
262 | |
264 | |
263 | my $hdr_cb; $hdr_cb = sub { |
265 | my $hdr_cb; $hdr_cb = sub { |
264 | if ($_[1] =~ /^([^=]+)=(.*)$/) { |
266 | if (($v = index $_[1], "=") >= 0) { |
265 | my ($k, $v) = ($1, $2); |
267 | $k = substr $_[1], 0, $v; |
|
|
268 | $v = substr $_[1], $v + 1; |
|
|
269 | $k = ($TOLC{$k} ||= tolc $k); |
|
|
270 | |
|
|
271 | if ($k !~ /\./) { |
|
|
272 | # special case common case, for performance only |
|
|
273 | $kv{$k} = $v; |
|
|
274 | } else { |
266 | my @k = split /\./, tolc $k; |
275 | my @k = split /\./, $k; |
267 | my $ro = \\%kv; |
276 | my $ro = \\%kv; |
268 | |
277 | |
269 | while (@k) { |
278 | while (@k) { |
270 | my $k = shift @k; |
279 | $k = shift @k; |
271 | if ($k =~ /^\d+$/) { |
280 | if ($k =~ /^\d+$/) { |
272 | $ro = \$$ro->[$k]; |
281 | $ro = \$$ro->[$k]; |
273 | } else { |
282 | } else { |
274 | $ro = \$$ro->{$k}; |
283 | $ro = \$$ro->{$k}; |
|
|
284 | } |
275 | } |
285 | } |
|
|
286 | |
|
|
287 | $$ro = $v; |
276 | } |
288 | } |
277 | |
|
|
278 | $$ro = $v; |
|
|
279 | |
289 | |
280 | $_[0]->push_read (line => $hdr_cb); |
290 | $_[0]->push_read (line => $hdr_cb); |
281 | } elsif ($_[1] eq "Data") { |
291 | } elsif ($_[1] eq "Data") { |
282 | $_[0]->push_read (chunk => delete $kv{data_length}, sub { |
292 | $_[0]->push_read (chunk => delete $kv{data_length}, sub { |
283 | $rdata = \$_[1]; |
293 | $rdata = \$_[1]; |
… | |
… | |
289 | die "protocol error, expected message end, got $_[1]\n";#d# |
299 | die "protocol error, expected message end, got $_[1]\n";#d# |
290 | } |
300 | } |
291 | }; |
301 | }; |
292 | |
302 | |
293 | $self->{hdl}->push_read (line => sub { |
303 | $self->{hdl}->push_read (line => sub { |
294 | $type = tolc $_[1]; |
304 | $type = ($TOLC{$_[1]} ||= tolc $_[1]); |
295 | $_[0]->push_read (line => $hdr_cb); |
305 | $_[0]->push_read (line => $hdr_cb); |
296 | }); |
306 | }); |
297 | } |
307 | } |
298 | |
308 | |
299 | sub default_recv { |
309 | sub default_recv { |