6 |
use IO::Socket::INET; |
use IO::Socket::INET; |
7 |
use Data::Dumper; |
use Data::Dumper; |
8 |
use Carp qw/confess/; |
use Carp qw/confess/; |
9 |
|
use Encode; |
10 |
|
|
11 |
=head1 NAME |
=head1 NAME |
12 |
|
|
14 |
|
|
15 |
=cut |
=cut |
16 |
|
|
17 |
our $VERSION = '0.0801'; |
our $VERSION = '1.2001'; |
18 |
|
|
19 |
|
|
20 |
=head1 DESCRIPTION |
=head1 DESCRIPTION |
21 |
|
|
22 |
Pure perl bindings for L<http://code.google.com/p/redis/> |
Pure perl bindings for L<http://code.google.com/p/redis/> |
23 |
|
|
24 |
This version support git version 0.08 or later of Redis available at |
This version supports protocol 1.2 or later of Redis available at |
25 |
|
|
26 |
L<git://github.com/antirez/redis> |
L<git://github.com/antirez/redis> |
27 |
|
|
62 |
sadd => 1, srem => 1, |
sadd => 1, srem => 1, |
63 |
sismember => 1, |
sismember => 1, |
64 |
echo => 1, |
echo => 1, |
65 |
|
getset => 1, |
66 |
|
smove => 1, |
67 |
|
zadd => 1, |
68 |
|
zrem => 1, |
69 |
|
zscore => 1, |
70 |
|
zincrby => 1, |
71 |
|
append => 1, |
72 |
}; |
}; |
73 |
|
|
74 |
# we don't want DESTROY to fallback into AUTOLOAD |
# we don't want DESTROY to fallback into AUTOLOAD |
78 |
sub AUTOLOAD { |
sub AUTOLOAD { |
79 |
my $self = shift; |
my $self = shift; |
80 |
|
|
81 |
|
use bytes; |
82 |
|
|
83 |
my $sock = $self->{sock} || die "no server connected"; |
my $sock = $self->{sock} || die "no server connected"; |
84 |
|
|
85 |
my $command = $AUTOLOAD; |
my $command = $AUTOLOAD; |
118 |
} |
} |
119 |
|
|
120 |
my $result = <$sock> || die "can't read socket: $!"; |
my $result = <$sock> || die "can't read socket: $!"; |
121 |
|
Encode::_utf8_on($result); |
122 |
warn "<< $result" if $self->{debug}; |
warn "<< $result" if $self->{debug}; |
123 |
my $type = substr($result,0,1); |
my $type = substr($result,0,1); |
124 |
$result = substr($result,1,-2); |
$result = substr($result,1,-2); |
137 |
} |
} |
138 |
|
|
139 |
if ( $type eq '-' ) { |
if ( $type eq '-' ) { |
140 |
confess $result; |
confess "[$command] $result"; |
141 |
} elsif ( $type eq '+' ) { |
} elsif ( $type eq '+' ) { |
142 |
return $result; |
return $result; |
143 |
} elsif ( $type eq '$' ) { |
} elsif ( $type eq '$' ) { |
158 |
my $v; |
my $v; |
159 |
if ( $len > 0 ) { |
if ( $len > 0 ) { |
160 |
read($self->{sock}, $v, $len) || die $!; |
read($self->{sock}, $v, $len) || die $!; |
161 |
|
Encode::_utf8_on($v); |
162 |
warn "<< ",Dumper($v),$/ if $self->{debug}; |
warn "<< ",Dumper($v),$/ if $self->{debug}; |
163 |
} |
} |
164 |
my $crlf; |
my $crlf; |
372 |
|
|
373 |
my $info_hash = $r->info; |
my $info_hash = $r->info; |
374 |
|
|
375 |
|
=head1 ENCODING |
376 |
|
|
377 |
|
Since Redis knows nothing about encoding, we are forcing utf-8 flag on all data received from Redis. |
378 |
|
This change is introduced in 1.2001 version. |
379 |
|
|
380 |
|
This allows us to round-trip utf-8 encoded characters correctly, but might be problem if you push |
381 |
|
binary junk into Redis and expect to get it back without utf-8 flag turned on. |
382 |
|
|
383 |
=head1 AUTHOR |
=head1 AUTHOR |
384 |
|
|
385 |
Dobrica Pavlinusic, C<< <dpavlin at rot13.org> >> |
Dobrica Pavlinusic, C<< <dpavlin at rot13.org> >> |
430 |
|
|
431 |
=head1 COPYRIGHT & LICENSE |
=head1 COPYRIGHT & LICENSE |
432 |
|
|
433 |
Copyright 2009 Dobrica Pavlinusic, all rights reserved. |
Copyright 2009-2010 Dobrica Pavlinusic, all rights reserved. |
434 |
|
|
435 |
This program is free software; you can redistribute it and/or modify it |
This program is free software; you can redistribute it and/or modify it |
436 |
under the same terms as Perl itself. |
under the same terms as Perl itself. |