/[Redis.pre-github]/lib/Redis.pm
This is repository of my old source code which isn't updated any more. Go to git.rot13.org for current projects!
ViewVC logotype

Contents of /lib/Redis.pm

Parent Directory Parent Directory | Revision Log Revision Log


Revision 53 - (show annotations)
Tue Mar 24 22:51:53 2009 UTC (15 years ago) by dpavlin
File size: 6498 byte(s)
update bindings for new protocol 0.08

new protocol is self-describing, so all commands are
now implemented using AUTOLOAD
1 package Redis;
2
3 use warnings;
4 use strict;
5
6 use IO::Socket::INET;
7 use Data::Dump qw/dump/;
8 use Carp qw/confess/;
9
10 =head1 NAME
11
12 Redis - perl binding for Redis database
13
14 =cut
15
16 our $VERSION = '0.08';
17
18
19 =head1 DESCRIPTION
20
21 Pure perl bindings for L<http://code.google.com/p/redis/>
22
23 This version support git version 0.08 of Redis available at
24
25 L<git://github.com/antirez/redis>
26
27 This documentation
28 lists commands which are exercised in test suite, but
29 additinal commands will work correctly since protocol
30 specifies enough information to support almost all commands
31 with same peace of code with a little help of C<AUTOLOAD>.
32
33 =head1 FUNCTIONS
34
35 =head2 new
36
37 my $r = Redis->new;
38
39 =cut
40
41 our $debug = $ENV{REDIS} || 0;
42
43 our $sock;
44 my $server = '127.0.0.1:6379';
45
46 sub new {
47 my $class = shift;
48 my $self = {};
49 bless($self, $class);
50
51 warn "# opening socket to $server";
52
53 $sock ||= IO::Socket::INET->new(
54 PeerAddr => $server,
55 Proto => 'tcp',
56 ) || die $!;
57
58 $self;
59 }
60
61 my $bulk_command = {
62 set => 1, setnx => 1,
63 rpush => 1, lpush => 1,
64 lset => 1, lrem => 1,
65 sadd => 1, srem => 1,
66 sismember => 1,
67 echo => 1,
68 };
69
70 # we don't want DESTROY to fallback into AUTOLOAD
71 sub DESTROY {}
72
73 our $AUTOLOAD;
74 sub AUTOLOAD {
75 my $self = shift;
76
77 my $command = $AUTOLOAD;
78 $command =~ s/.*://;
79
80 warn "## $command ",dump(@_) if $debug;
81
82 my $send;
83
84 if ( defined $bulk_command->{$command} ) {
85 my $value = pop;
86 $send
87 = uc($command)
88 . ' '
89 . join(' ', @_)
90 . ' '
91 . length($value)
92 . "\r\n$value\r\n"
93 ;
94 } else {
95 $send
96 = uc($command)
97 . ' '
98 . join(' ', @_)
99 . "\r\n"
100 ;
101 }
102
103 warn ">> $send" if $debug;
104 print $sock $send;
105
106 if ( $command eq 'quit' ) {
107 close( $sock ) || die "can't close socket: $!";
108 return 1;
109 }
110
111 my $result = <$sock> || die "can't read socket: $!";
112 warn "<< $result" if $debug;
113 my $type = substr($result,0,1);
114 $result = substr($result,1,-2);
115
116 if ( $command eq 'info' ) {
117 my $hash;
118 foreach my $l ( split(/\r\n/, __sock_read_bulk($result) ) ) {
119 my ($n,$v) = split(/:/, $l, 2);
120 $hash->{$n} = $v;
121 }
122 return $hash;
123 } elsif ( $command eq 'keys' ) {
124 return split(/\s/, __sock_read_bulk($result));
125 }
126
127 if ( $type eq '-' ) {
128 confess $result;
129 } elsif ( $type eq '+' ) {
130 return $result;
131 } elsif ( $type eq '$' ) {
132 return __sock_read_bulk($result);
133 } elsif ( $type eq '*' ) {
134 return __sock_read_multi_bulk($result);
135 } elsif ( $type eq ':' ) {
136 return $result; # FIXME check if int?
137 } else {
138 confess "unknown type: $type", __sock_read_line();
139 }
140 }
141
142 sub __sock_read_bulk {
143 my $len = shift;
144 return undef if $len < 0;
145
146 my $v;
147 if ( $len > 0 ) {
148 read($sock, $v, $len) || die $!;
149 warn "<< ",dump($v),$/ if $debug;
150 }
151 my $crlf;
152 read($sock, $crlf, 2); # skip cr/lf
153 return $v;
154 }
155
156 sub __sock_read_multi_bulk {
157 my $size = shift;
158 return undef if $size < 0;
159
160 $size--;
161
162 my @list = ( 0 .. $size );
163 foreach ( 0 .. $size ) {
164 $list[ $_ ] = __sock_read_bulk( substr(<$sock>,1,-2) );
165 }
166
167 warn "## list = ", dump( @list ) if $debug;
168 return @list;
169 }
170
171 1;
172
173 __END__
174
175 =head1 Connection Handling
176
177 =head2 quit
178
179 $r->quit;
180
181 =head2 ping
182
183 $r->ping || die "no server?";
184
185 =head1 Commands operating on string values
186
187 =head2 set
188
189 $r->set( foo => 'bar' );
190
191 $r->setnx( foo => 42 );
192
193 =head2 get
194
195 my $value = $r->get( 'foo' );
196
197 =head2 mget
198
199 my @values = $r->mget( 'foo', 'bar', 'baz' );
200
201 =head2 incr
202
203 $r->incr('counter');
204
205 $r->incrby('tripplets', 3);
206
207 =head2 decr
208
209 $r->decr('counter');
210
211 $r->decrby('tripplets', 3);
212
213 =head2 exists
214
215 $r->exists( 'key' ) && print "got key!";
216
217 =head2 del
218
219 $r->del( 'key' ) || warn "key doesn't exist";
220
221 =head2 type
222
223 $r->type( 'key' ); # = string
224
225 =head1 Commands operating on the key space
226
227 =head2 keys
228
229 my @keys = $r->keys( '*glob_pattern*' );
230
231 =head2 randomkey
232
233 my $key = $r->randomkey;
234
235 =head2 rename
236
237 my $ok = $r->rename( 'old-key', 'new-key', $new );
238
239 =head2 dbsize
240
241 my $nr_keys = $r->dbsize;
242
243 =head1 Commands operating on lists
244
245 See also L<Redis::List> for tie interface.
246
247 =head2 rpush
248
249 $r->rpush( $key, $value );
250
251 =head2 lpush
252
253 $r->lpush( $key, $value );
254
255 =head2 llen
256
257 $r->llen( $key );
258
259 =head2 lrange
260
261 my @list = $r->lrange( $key, $start, $end );
262
263 =head2 ltrim
264
265 my $ok = $r->ltrim( $key, $start, $end );
266
267 =head2 lindex
268
269 $r->lindex( $key, $index );
270
271 =head2 lset
272
273 $r->lset( $key, $index, $value );
274
275 =head2 lrem
276
277 my $modified_count = $r->lrem( $key, $count, $value );
278
279 =head2 lpop
280
281 my $value = $r->lpop( $key );
282
283 =head2 rpop
284
285 my $value = $r->rpop( $key );
286
287 =head1 Commands operating on sets
288
289 =head2 sadd
290
291 $r->sadd( $key, $member );
292
293 =head2 srem
294
295 $r->srem( $key, $member );
296
297 =head2 scard
298
299 my $elements = $r->scard( $key );
300
301 =head2 sismember
302
303 $r->sismember( $key, $member );
304
305 =head2 sinter
306
307 $r->sinter( $key1, $key2, ... );
308
309 =head2 sinterstore
310
311 my $ok = $r->sinterstore( $dstkey, $key1, $key2, ... );
312
313 =head1 Multiple databases handling commands
314
315 =head2 select
316
317 $r->select( $dbindex ); # 0 for new clients
318
319 =head2 move
320
321 $r->move( $key, $dbindex );
322
323 =head2 flushdb
324
325 $r->flushdb;
326
327 =head2 flushall
328
329 $r->flushall;
330
331 =head1 Sorting
332
333 =head2 sort
334
335 $r->sort("key BY pattern LIMIT start end GET pattern ASC|DESC ALPHA');
336
337 =head1 Persistence control commands
338
339 =head2 save
340
341 $r->save;
342
343 =head2 bgsave
344
345 $r->bgsave;
346
347 =head2 lastsave
348
349 $r->lastsave;
350
351 =head2 shutdown
352
353 $r->shutdown;
354
355 =head1 Remote server control commands
356
357 =head2 info
358
359 my $info_hash = $r->info;
360
361 =head1 AUTHOR
362
363 Dobrica Pavlinusic, C<< <dpavlin at rot13.org> >>
364
365 =head1 BUGS
366
367 Please report any bugs or feature requests to C<bug-redis at rt.cpan.org>, or through
368 the web interface at L<http://rt.cpan.org/NoAuth/ReportBug.html?Queue=Redis>. I will be notified, and then you'll
369 automatically be notified of progress on your bug as I make changes.
370
371
372
373
374 =head1 SUPPORT
375
376 You can find documentation for this module with the perldoc command.
377
378 perldoc Redis
379 perldoc Redis::List
380 perldoc Redis::Hash
381
382
383 You can also look for information at:
384
385 =over 4
386
387 =item * RT: CPAN's request tracker
388
389 L<http://rt.cpan.org/NoAuth/Bugs.html?Dist=Redis>
390
391 =item * AnnoCPAN: Annotated CPAN documentation
392
393 L<http://annocpan.org/dist/Redis>
394
395 =item * CPAN Ratings
396
397 L<http://cpanratings.perl.org/d/Redis>
398
399 =item * Search CPAN
400
401 L<http://search.cpan.org/dist/Redis>
402
403 =back
404
405
406 =head1 ACKNOWLEDGEMENTS
407
408
409 =head1 COPYRIGHT & LICENSE
410
411 Copyright 2009 Dobrica Pavlinusic, all rights reserved.
412
413 This program is free software; you can redistribute it and/or modify it
414 under the same terms as Perl itself.
415
416
417 =cut
418
419 1; # End of Redis

  ViewVC Help
Powered by ViewVC 1.1.26