File Coverage

lib/AnyEvent/Memcached/Conn.pm
Criterion Covered Total %
statement 12 44 27.2
branch 0 28 0.0
condition 0 2 0.0
subroutine 4 6 66.6
pod 0 1 0.0
total 16 81 19.7


line stmt bran cond sub pod time code
1             package #hide
2             AnyEvent::Memcached::Conn;
3              
4 4     4   24 use common::sense 2;m{
  4         103  
  4         65  
5             use strict;
6             use warnings;
7             }x;
8 4     4   298 use base 'AnyEvent::Connection::Raw';
  4         6  
  4         434  
9 4     4   23 use AnyEvent::Memcached;
  4         5  
  4         186  
10 4     4   22 use AnyEvent::Connection::Util;
  4         6  
  4         30  
11              
12             our $NL = "\015\012";
13             our $QRNL = qr<\015?\012>;
14             our $VERSION = $AnyEvent::Memcached::VERSION;
15              
16             sub reader {
17 0     0 0   my ($self,%args) = @_;
18 0 0         $args{cb} or return $self->event( error => "no cb for command at @{[ (caller)[1,2] ]}" );
  0            
19 0 0         $self->{h} or return $args{cb}->(undef,"Not connected");
20 0   0       my $result = $args{res} || {};
21 0 0         my $ar = ref $result eq 'ARRAY' ? 1 : 0;
22 0 0         my $cut = exists $args{namespace} ? length $args{namespace} : 0;
23 0           my $reader;$reader = sub {
24 0     0     shift;
25 0 0         defined( local $_ = shift ) or return $args{cb}(undef,@_);
26 0 0         warn "<<$args{id} $_" if $self->{debug};
27 0 0         if ($_ eq "END") {
    0          
    0          
    0          
28 0           undef $reader;
29 0           $args{cb}( $result );
30             }
31             elsif (substr($_,0,5) eq 'ERROR') {
32 0           undef $reader;
33 0           $args{cb}( undef, $_ );
34             }
35             elsif (!length) {
36 0           warn "Skip empty line";
37 0           $self->{h}->unshift_read( line => $reader);
38             }
39             elsif( /^VALUE (\S+) (\d+) (\d+)(?:| (.+))$/ ) {
40 0           my ($key,$flags,$len,$cas) = ($1,$2,$3,$4);
41             #warn "have to read $1 $2 $3 $4";
42             $self->recv( $3+2 => cb => sub {
43             #shift;
44 0           my $data = shift;
45 0           substr($data,$len) = ''; # trim out data outside length
46             #$data = substr($data,0,length($data)-2);
47 0 0         $key = substr($key, $cut) if substr($key, 0, $cut) eq $args{namespace};
48 0 0         warn "+ received data $key: $data" if $self->{debug};
49 0 0         my $v = {
50             data => $data,
51             flags => $flags,
52             defined $cas ? (cas => $cas) : (),
53             };
54 0 0         if ($ar) {
55 0           push @$result, $key, $v;
56             } else {
57 0           $result->{$key} = $v;#{ data => $data, $cas ? (cas => $cas) : () };
58             }
59            
60 0           $self->{h}->unshift_read( line => $reader);
61 0           });
62             }
63             else {
64 0           die "Wrong data received: ".dumper($_)."($!)";
65             #$args{cb}(undef,$_);
66             #$self->handle_errors($_);
67             }
68 0           };
69 0           $self->{h}->push_read( line => $reader );
70             }
71              
72              
73             1;
74              
75             1;