Redis.pre-github/lib/Redis.pm

package Redis;

use warnings;
use strict;

use IO::Socket::INET;
use Data::Dump qw/dump/;
use Carp qw/confess/;

=head1 NAME

Redis - perl binding for Redis database

=cut

our $VERSION = '0.01';


=head1 SYNOPSIS

Pure perl bindings for L<http://code.google.com/p/redis/>

This version support git version of Redis available at
L<git://github.com/antirez/redis>

    use Redis;

    my $r = Redis->new();

=head1 FUNCTIONS

=head2 new

=cut

our $debug = $ENV{REDIS} || 0;

our $sock;
my $server = '127.0.0.1:6379';

sub new {
        my $class = shift;
        my $self = {};
        bless($self, $class);

        warn "# opening socket to $server";

        $sock ||= IO::Socket::INET->new(
                PeerAddr => $server,
                Proto => 'tcp',
        ) || die $!;

        $self;
}

sub __sock_result {
        my $result = <$sock>;
        warn "## result: ",dump( $result ) if $debug;
        $result =~ s{\r\n$}{} || warn "can't find cr/lf";
        return $result;
}

sub __sock_read_bulk {
        my $len = <$sock>;
        warn "## bulk len: ",dump($len) if $debug;
        return undef if $len eq "nil\r\n";
        my $v;
        if ( $len > 0 ) {
                read($sock, $v, $len) || die $!;
                warn "## bulk v: ",dump($v) if $debug;
        }
        my $crlf;
        read($sock, $crlf, 2); # skip cr/lf
        return $v;
}

sub _sock_result_bulk {
        my $self = shift;
        warn "## _sock_result_bulk ",dump( @_ ) if $debug;
        print $sock join(' ',@_) . "\r\n";
        __sock_read_bulk();
}

sub _sock_result_bulk_list {
        my $self = shift;
        warn "## _sock_result_bulk_list ",dump( @_ ) if $debug;

        my $size = $self->_sock_send( @_ );
        confess $size unless $size > 0;
        $size--;

        my @list = ( 0 .. $size );
        foreach ( 0 .. $size ) {
                $list[ $_ ] = __sock_read_bulk();
        }

        warn "## list = ", dump( @list ) if $debug;
        return @list;
}

sub __sock_ok {
        my $ok = <$sock>;
        return undef if $ok eq "nil\r\n";
        confess dump($ok) unless $ok eq "+OK\r\n";
}

sub _sock_send {
        my $self = shift;
        warn "## _sock_send ",dump( @_ ) if $debug;
        print $sock join(' ',@_) . "\r\n";
        __sock_result();
}

sub _sock_send_ok {
        my $self = shift;
        warn "## _sock_send_ok ",dump( @_ ) if $debug;
        print $sock join(' ',@_) . "\r\n";
        __sock_ok();
}

sub __sock_send_bulk_raw {
        warn "## _sock_send_bulk ",dump( @_ ) if $debug;
        my $value = pop;
        $value = '' unless defined $value; # FIXME errr? nil?
        print $sock join(' ',@_) . ' ' . length($value) . "\r\n$value\r\n"
}

sub _sock_send_bulk {
        my $self = shift;
        __sock_send_bulk_raw( @_ );
        __sock_ok();
}

sub _sock_send_bulk_number {
        my $self = shift;
        __sock_send_bulk_raw( @_ );
        my $v = __sock_result();
        confess $v unless $v =~ m{^\-?\d+$};
        return $v;
}

=head1 Connection Handling

=head2 quit

  $r->quit;

=cut

sub quit {
        my $self = shift;

        close( $sock ) || warn $!;
}

=head2 ping

  $r->ping || die "no server?";

=cut

sub ping {
        print $sock "PING\r\n";
        my $pong = <$sock>;
        die "ping failed, got ", dump($pong) unless $pong eq "+PONG\r\n";
}

=head1 Commands operating on string values

=head2 set

  $r->set( foo => 'bar', $new );

=cut

sub set {
        my ( $self, $key, $value, $new ) = @_;
        $self->_sock_send_bulk( "SET" . ( $new ? 'NX' : '' ), $key, $value );
}

=head2 get

  my $value = $r->get( 'foo' );

=cut

sub get {
        my $self = shift;
        $self->_sock_result_bulk('GET', @_);
}

=head2 incr

  $r->incr('counter');
  $r->incr('tripplets', 3);

=cut

        
sub incr {
        my $self = shift;
        $self->_sock_send( 'INCR' . ( $#_ ? 'BY' : '' ), @_ );
}

=head2 decr

  $r->decr('counter');
  $r->decr('tripplets', 3);

=cut

sub decr {
        my $self = shift;
        $self->_sock_send( 'DECR' . ( $#_ ? 'BY' : '' ), @_ );
}

=head2 exists

  $r->exists( 'key' ) && print "got key!";

=cut

sub exists {
        my ( $self, $key ) = @_;
        $self->_sock_send( 'EXISTS', $key );
}

=head2 del

  $r->del( 'key' ) || warn "key doesn't exist";

=cut

sub del {
        my ( $self, $key ) = @_;
        $self->_sock_send( 'DEL', $key );
}

=head2 type

  $r->type( 'key' ); # = string

=cut

sub type {
        my ( $self, $key ) = @_;
        $self->_sock_send( 'TYPE', $key );
}

=head1 Commands operating on the key space

=head2 keys

  my @keys = $r->keys( '*glob_pattern*' );

=cut

sub keys {
        my ( $self, $glob ) = @_;
        my $keys = $self->_sock_result_bulk( 'KEYS', $glob );
        return split(/\s/, $keys) if $keys;
        return () if wantarray;
}

=head2 randomkey

  my $key = $r->randomkey;

=cut

sub randomkey {
        my ( $self ) = @_;
        $self->_sock_send( 'RANDOMKEY' );
}

=head2 rename

  my $ok = $r->rename( 'old-key', 'new-key', $new );

=cut

sub rename {
        my ( $self, $old, $new, $nx ) = @_;
        $self->_sock_send_ok( 'RENAME' . ( $nx ? 'NX' : '' ), $old, $new );
}

=head2 dbsize

  my $nr_keys = $r->dbsize;

=cut

sub dbsize {
        my ( $self ) = @_;
        $self->_sock_send('DBSIZE');
}

=head1 Commands operating on lists

See also L<Redis::List> for tie interface.

=head2 rpush

  $r->rpush( $key, $value );

=cut

sub rpush {
        my ( $self, $key, $value ) = @_;
        $self->_sock_send_bulk('RPUSH', $key, $value);
}

=head2 lpush

  $r->lpush( $key, $value );

=cut

sub lpush {
        my ( $self, $key, $value ) = @_;
        $self->_sock_send_bulk('LPUSH', $key, $value);
}

=head2 llen

  $r->llen( $key );

=cut

sub llen {
        my ( $self, $key ) = @_;
        $self->_sock_send( 'LLEN', $key );
}

=head2 lrange

  my @list = $r->lrange( $key, $start, $end );

=cut

sub lrange {
        my ( $self, $key, $start, $end ) = @_;
        $self->_sock_result_bulk_list('LRANGE', $key, $start, $end);
}

=head2 ltrim

  my $ok = $r->ltrim( $key, $start, $end );

=cut

sub ltrim {
        my ( $self, $key, $start, $end ) = @_;
        $self->_sock_send_ok( 'LTRIM', $key, $start, $end );
}

=head2 lindex

  $r->lindex( $key, $index );

=cut

sub lindex {
        my ( $self, $key, $index ) = @_;
        $self->_sock_result_bulk( 'LINDEX', $key, $index );
}

=head2 lset

  $r->lset( $key, $index, $value );

=cut

sub lset {
        my ( $self, $key, $index, $value ) = @_;
        $self->_sock_send_bulk( 'LSET', $key, $index, $value );
}

=head2 lrem

  my $modified_count = $r->lrem( $key, $count, $value );

=cut

sub lrem {
        my ( $self, $key, $count, $value ) = @_;
        $self->_sock_send_bulk_number( 'LREM', $key, $count, $value );
}

=head2 lpop

  my $value = $r->lpop( $key );

=cut

sub lpop {
        my ( $self, $key ) = @_;
        $self->_sock_result_bulk( 'LPOP', $key );
}

=head2 rpop

  my $value = $r->rpop( $key );

=cut

sub rpop {
        my ( $self, $key ) = @_;
        $self->_sock_result_bulk( 'RPOP', $key );
}

=head1 Commands operating on sets

=head2 sadd

  $r->sadd( $key, $member );

=cut

sub sadd {
        my ( $self, $key, $member ) = @_;
        $self->_sock_send_bulk_number( 'SADD', $key, $member );
}

=head2 srem

  $r->srem( $key, $member );

=cut

sub srem {
        my ( $self, $key, $member ) = @_;
        $self->_sock_send_bulk_number( 'SREM', $key, $member );
}

=head2 scard

  my $elements = $r->scard( $key );

=cut

sub scard {
        my ( $self, $key ) = @_;
        $self->_sock_send( 'SCARD', $key );
}

=head2 sismember

  $r->sismember( $key, $member );

=cut

sub sismember {
        my ( $self, $key, $member ) = @_;
        $self->_sock_send_bulk_number( 'SISMEMBER', $key, $member );
}

=head2 sinter

  $r->sinter( $key1, $key2, ... );

=cut

sub sinter {
        my $self = shift;
        $self->_sock_result_bulk_list( 'SINTER', @_ );
}

=head2 sinterstore

  my $ok = $r->sinterstore( $dstkey, $key1, $key2, ... );

=cut

sub sinterstore {
        my $self = shift;
        $self->_sock_send_ok( 'SINTERSTORE', @_ );
}

=head1 Multiple databases handling commands

=head2 select

  $r->select( $dbindex ); # 0 for new clients

=cut

sub select {
        my ($self,$dbindex) = @_;
        confess dump($dbindex) . 'not number' unless $dbindex =~ m{^\d+$};
        $self->_sock_send_ok( 'SELECT', $dbindex );
}

=head2 move

  $r->move( $key, $dbindex );

=cut

sub move {
        my ( $self, $key, $dbindex ) = @_;
        $self->_sock_send( 'MOVE', $key, $dbindex );
}

=head2 flushdb

  $r->flushdb;

=cut

sub flushdb {
        my $self = shift;
        $self->_sock_send_ok('FLUSHDB');
}

=head2 flushall

  $r->flushall;

=cut

sub flushall {
        my $self = shift;
        $self->_sock_send_ok('flushall');
}

=head1 AUTHOR

Dobrica Pavlinusic, C<< <dpavlin at rot13.org> >>

=head1 BUGS

Please report any bugs or feature requests to C<bug-redis at rt.cpan.org>, or through
the web interface at L<http://rt.cpan.org/NoAuth/ReportBug.html?Queue=Redis>.  I will be notified, and then you'll
automatically be notified of progress on your bug as I make changes.


=head1 SUPPORT

You can find documentation for this module with the perldoc command.

    perldoc Redis


You can also look for information at:

=over 4

=item * RT: CPAN's request tracker

L<http://rt.cpan.org/NoAuth/Bugs.html?Dist=Redis>

=item * AnnoCPAN: Annotated CPAN documentation

L<http://annocpan.org/dist/Redis>

=item * CPAN Ratings

L<http://cpanratings.perl.org/d/Redis>

=item * Search CPAN

L<http://search.cpan.org/dist/Redis>

=back


=head1 ACKNOWLEDGEMENTS


=head1 COPYRIGHT & LICENSE

Copyright 2009 Dobrica Pavlinusic, all rights reserved.

This program is free software; you can redistribute it and/or modify it
under the same terms as Perl itself.


=cut

1; # End of Redis
1	dpavlin	1	package Redis;
2
3			use warnings;
4			use strict;
5
6	dpavlin	2	use IO::Socket::INET;
7			use Data::Dump qw/dump/;
8	dpavlin	5	use Carp qw/confess/;
9	dpavlin	2
10	dpavlin	1	=head1 NAME
11
12	dpavlin	36	Redis - perl binding for Redis database
13	dpavlin	1
14			=cut
15
16			our $VERSION = '0.01';
17
18
19			=head1 SYNOPSIS
20
21	dpavlin	2	Pure perl bindings for L<http://code.google.com/p/redis/>
22	dpavlin	1
23	dpavlin	36	This version support git version of Redis available at
24			L<git://github.com/antirez/redis>
25
26	dpavlin	1	use Redis;
27
28	dpavlin	2	my $r = Redis->new();
29	dpavlin	1
30			=head1 FUNCTIONS
31
32	dpavlin	2	=head2 new
33	dpavlin	1
34			=cut
35
36	dpavlin	37	our $debug = $ENV{REDIS} \|\| 0;
37
38	dpavlin	2	our $sock;
39			my $server = '127.0.0.1:6379';
40
41			sub new {
42			my $class = shift;
43			my $self = {};
44			bless($self, $class);
45
46			warn "# opening socket to $server";
47
48			$sock \|\|= IO::Socket::INET->new(
49			PeerAddr => $server,
50			Proto => 'tcp',
51			) \|\| die $!;
52
53			$self;
54	dpavlin	1	}
55
56	dpavlin	40	sub __sock_result {
57	dpavlin	11	my $result = <$sock>;
58	dpavlin	37	warn "## result: ",dump( $result ) if $debug;
59	dpavlin	11	$result =~ s{\r\n$}{} \|\| warn "can't find cr/lf";
60			return $result;
61			}
62
63	dpavlin	40	sub __sock_read_bulk {
64	dpavlin	12	my $len = <$sock>;
65	dpavlin	37	warn "## bulk len: ",dump($len) if $debug;
66	dpavlin	12	return undef if $len eq "nil\r\n";
67			my $v;
68	dpavlin	28	if ( $len > 0 ) {
69			read($sock, $v, $len) \|\| die $!;
70	dpavlin	37	warn "## bulk v: ",dump($v) if $debug;
71	dpavlin	28	}
72	dpavlin	12	my $crlf;
73			read($sock, $crlf, 2); # skip cr/lf
74			return $v;
75			}
76
77	dpavlin	21	sub _sock_result_bulk {
78			my $self = shift;
79	dpavlin	37	warn "## _sock_result_bulk ",dump( @_ ) if $debug;
80	dpavlin	21	print $sock join(' ',@_) . "\r\n";
81	dpavlin	40	__sock_read_bulk();
82	dpavlin	21	}
83
84	dpavlin	33	sub _sock_result_bulk_list {
85			my $self = shift;
86	dpavlin	37	warn "## _sock_result_bulk_list ",dump( @_ ) if $debug;
87	dpavlin	33
88			my $size = $self->_sock_send( @_ );
89			confess $size unless $size > 0;
90			$size--;
91
92			my @list = ( 0 .. $size );
93			foreach ( 0 .. $size ) {
94	dpavlin	40	$list[ $_ ] = __sock_read_bulk();
95	dpavlin	33	}
96
97	dpavlin	37	warn "## list = ", dump( @list ) if $debug;
98	dpavlin	33	return @list;
99			}
100
101	dpavlin	26	sub __sock_ok {
102	dpavlin	14	my $ok = <$sock>;
103	dpavlin	28	return undef if $ok eq "nil\r\n";
104	dpavlin	14	confess dump($ok) unless $ok eq "+OK\r\n";
105			}
106
107	dpavlin	20	sub _sock_send {
108			my $self = shift;
109	dpavlin	37	warn "## _sock_send ",dump( @_ ) if $debug;
110	dpavlin	20	print $sock join(' ',@_) . "\r\n";
111	dpavlin	40	__sock_result();
112	dpavlin	20	}
113
114	dpavlin	21	sub _sock_send_ok {
115			my $self = shift;
116	dpavlin	37	warn "## _sock_send_ok ",dump( @_ ) if $debug;
117	dpavlin	21	print $sock join(' ',@_) . "\r\n";
118	dpavlin	26	__sock_ok();
119	dpavlin	21	}
120
121	dpavlin	26	sub __sock_send_bulk_raw {
122	dpavlin	37	warn "## _sock_send_bulk ",dump( @_ ) if $debug;
123	dpavlin	24	my $value = pop;
124	dpavlin	28	$value = '' unless defined $value; # FIXME errr? nil?
125			print $sock join(' ',@_) . ' ' . length($value) . "\r\n$value\r\n"
126	dpavlin	18	}
127
128	dpavlin	26	sub _sock_send_bulk {
129	dpavlin	40	my $self = shift;
130	dpavlin	26	__sock_send_bulk_raw( @_ );
131			__sock_ok();
132			}
133	dpavlin	18
134	dpavlin	26	sub _sock_send_bulk_number {
135	dpavlin	40	my $self = shift;
136	dpavlin	26	__sock_send_bulk_raw( @_ );
137	dpavlin	40	my $v = __sock_result();
138	dpavlin	26	confess $v unless $v =~ m{^\-?\d+$};
139			return $v;
140			}
141
142	dpavlin	2	=head1 Connection Handling
143	dpavlin	1
144	dpavlin	2	=head2 quit
145
146			$r->quit;
147
148	dpavlin	1	=cut
149
150	dpavlin	2	sub quit {
151			my $self = shift;
152
153			close( $sock ) \|\| warn $!;
154	dpavlin	1	}
155
156	dpavlin	2	=head2 ping
157
158	dpavlin	3	$r->ping \|\| die "no server?";
159	dpavlin	2
160			=cut
161
162			sub ping {
163			print $sock "PING\r\n";
164			my $pong = <$sock>;
165			die "ping failed, got ", dump($pong) unless $pong eq "+PONG\r\n";
166			}
167
168	dpavlin	3	=head1 Commands operating on string values
169
170			=head2 set
171
172	dpavlin	5	$r->set( foo => 'bar', $new );
173	dpavlin	3
174			=cut
175
176			sub set {
177	dpavlin	18	my ( $self, $key, $value, $new ) = @_;
178			$self->_sock_send_bulk( "SET" . ( $new ? 'NX' : '' ), $key, $value );
179	dpavlin	3	}
180
181			=head2 get
182
183			my $value = $r->get( 'foo' );
184
185			=cut
186
187			sub get {
188	dpavlin	21	my $self = shift;
189			$self->_sock_result_bulk('GET', @_);
190	dpavlin	3	}
191
192	dpavlin	7	=head2 incr
193	dpavlin	4
194	dpavlin	7	$r->incr('counter');
195			$r->incr('tripplets', 3);
196	dpavlin	4
197	dpavlin	7	=cut
198
199	dpavlin	10
200
201	dpavlin	7	sub incr {
202	dpavlin	21	my $self = shift;
203			$self->_sock_send( 'INCR' . ( $#_ ? 'BY' : '' ), @_ );
204	dpavlin	7	}
205
206	dpavlin	8	=head2 decr
207
208			$r->decr('counter');
209			$r->decr('tripplets', 3);
210
211			=cut
212
213			sub decr {
214	dpavlin	21	my $self = shift;
215			$self->_sock_send( 'DECR' . ( $#_ ? 'BY' : '' ), @_ );
216	dpavlin	8	}
217
218	dpavlin	9	=head2 exists
219
220			$r->exists( 'key' ) && print "got key!";
221
222			=cut
223
224			sub exists {
225			my ( $self, $key ) = @_;
226	dpavlin	21	$self->_sock_send( 'EXISTS', $key );
227	dpavlin	9	}
228
229	dpavlin	10	=head2 del
230
231			$r->del( 'key' ) \|\| warn "key doesn't exist";
232
233			=cut
234
235			sub del {
236			my ( $self, $key ) = @_;
237	dpavlin	21	$self->_sock_send( 'DEL', $key );
238	dpavlin	10	}
239
240	dpavlin	11	=head2 type
241
242			$r->type( 'key' ); # = string
243
244			=cut
245
246			sub type {
247			my ( $self, $key ) = @_;
248	dpavlin	21	$self->_sock_send( 'TYPE', $key );
249	dpavlin	11	}
250
251	dpavlin	12	=head1 Commands operating on the key space
252
253			=head2 keys
254
255			my @keys = $r->keys( 'glob_pattern' );
256
257			=cut
258
259			sub keys {
260			my ( $self, $glob ) = @_;
261	dpavlin	43	my $keys = $self->_sock_result_bulk( 'KEYS', $glob );
262			return split(/\s/, $keys) if $keys;
263			return () if wantarray;
264	dpavlin	12	}
265
266	dpavlin	13	=head2 randomkey
267
268			my $key = $r->randomkey;
269
270			=cut
271
272			sub randomkey {
273	dpavlin	14	my ( $self ) = @_;
274	dpavlin	21	$self->_sock_send( 'RANDOMKEY' );
275	dpavlin	13	}
276
277	dpavlin	14	=head2 rename
278
279	dpavlin	15	my $ok = $r->rename( 'old-key', 'new-key', $new );
280	dpavlin	14
281			=cut
282
283			sub rename {
284			my ( $self, $old, $new, $nx ) = @_;
285	dpavlin	21	$self->_sock_send_ok( 'RENAME' . ( $nx ? 'NX' : '' ), $old, $new );
286	dpavlin	14	}
287
288	dpavlin	17	=head2 dbsize
289
290			my $nr_keys = $r->dbsize;
291
292			=cut
293
294			sub dbsize {
295			my ( $self ) = @_;
296	dpavlin	21	$self->_sock_send('DBSIZE');
297	dpavlin	17	}
298
299	dpavlin	18	=head1 Commands operating on lists
300
301	dpavlin	35	See also L<Redis::List> for tie interface.
302
303	dpavlin	18	=head2 rpush
304
305			$r->rpush( $key, $value );
306
307			=cut
308
309			sub rpush {
310			my ( $self, $key, $value ) = @_;
311			$self->_sock_send_bulk('RPUSH', $key, $value);
312			}
313
314	dpavlin	19	=head2 lpush
315
316			$r->lpush( $key, $value );
317
318			=cut
319
320			sub lpush {
321			my ( $self, $key, $value ) = @_;
322			$self->_sock_send_bulk('LPUSH', $key, $value);
323			}
324
325	dpavlin	20	=head2 llen
326
327			$r->llen( $key );
328
329			=cut
330
331			sub llen {
332			my ( $self, $key ) = @_;
333	dpavlin	21	$self->_sock_send( 'LLEN', $key );
334	dpavlin	20	}
335
336	dpavlin	21	=head2 lrange
337
338			my @list = $r->lrange( $key, $start, $end );
339
340			=cut
341
342			sub lrange {
343			my ( $self, $key, $start, $end ) = @_;
344	dpavlin	33	$self->_sock_result_bulk_list('LRANGE', $key, $start, $end);
345	dpavlin	21	}
346
347	dpavlin	22	=head2 ltrim
348
349			my $ok = $r->ltrim( $key, $start, $end );
350
351			=cut
352
353			sub ltrim {
354			my ( $self, $key, $start, $end ) = @_;
355			$self->_sock_send_ok( 'LTRIM', $key, $start, $end );
356			}
357
358	dpavlin	23	=head2 lindex
359
360			$r->lindex( $key, $index );
361
362			=cut
363
364			sub lindex {
365			my ( $self, $key, $index ) = @_;
366	dpavlin	24	$self->_sock_result_bulk( 'LINDEX', $key, $index );
367	dpavlin	23	}
368
369	dpavlin	24	=head2 lset
370	dpavlin	23
371	dpavlin	24	$r->lset( $key, $index, $value );
372
373			=cut
374
375			sub lset {
376			my ( $self, $key, $index, $value ) = @_;
377			$self->_sock_send_bulk( 'LSET', $key, $index, $value );
378			}
379
380	dpavlin	26	=head2 lrem
381
382	dpavlin	27	my $modified_count = $r->lrem( $key, $count, $value );
383	dpavlin	26
384			=cut
385
386			sub lrem {
387			my ( $self, $key, $count, $value ) = @_;
388			$self->_sock_send_bulk_number( 'LREM', $key, $count, $value );
389			}
390
391	dpavlin	27	=head2 lpop
392
393			my $value = $r->lpop( $key );
394
395			=cut
396
397			sub lpop {
398			my ( $self, $key ) = @_;
399	dpavlin	30	$self->_sock_result_bulk( 'LPOP', $key );
400	dpavlin	27	}
401
402			=head2 rpop
403
404			my $value = $r->rpop( $key );
405
406			=cut
407
408			sub rpop {
409			my ( $self, $key ) = @_;
410	dpavlin	30	$self->_sock_result_bulk( 'RPOP', $key );
411	dpavlin	27	}
412
413	dpavlin	30	=head1 Commands operating on sets
414
415			=head2 sadd
416
417			$r->sadd( $key, $member );
418
419			=cut
420
421			sub sadd {
422			my ( $self, $key, $member ) = @_;
423			$self->_sock_send_bulk_number( 'SADD', $key, $member );
424			}
425
426			=head2 srem
427
428			$r->srem( $key, $member );
429
430			=cut
431
432			sub srem {
433			my ( $self, $key, $member ) = @_;
434			$self->_sock_send_bulk_number( 'SREM', $key, $member );
435			}
436
437	dpavlin	31	=head2 scard
438
439			my $elements = $r->scard( $key );
440
441			=cut
442
443			sub scard {
444			my ( $self, $key ) = @_;
445			$self->_sock_send( 'SCARD', $key );
446			}
447
448	dpavlin	32	=head2 sismember
449
450			$r->sismember( $key, $member );
451
452			=cut
453
454			sub sismember {
455			my ( $self, $key, $member ) = @_;
456			$self->_sock_send_bulk_number( 'SISMEMBER', $key, $member );
457			}
458
459	dpavlin	33	=head2 sinter
460
461			$r->sinter( $key1, $key2, ... );
462
463			=cut
464
465			sub sinter {
466			my $self = shift;
467			$self->_sock_result_bulk_list( 'SINTER', @_ );
468			}
469
470	dpavlin	34	=head2 sinterstore
471
472			my $ok = $r->sinterstore( $dstkey, $key1, $key2, ... );
473
474			=cut
475
476			sub sinterstore {
477			my $self = shift;
478			$self->_sock_send_ok( 'SINTERSTORE', @_ );
479			}
480
481	dpavlin	38	=head1 Multiple databases handling commands
482
483			=head2 select
484
485	dpavlin	40	$r->select( $dbindex ); # 0 for new clients
486	dpavlin	38
487			=cut
488
489			sub select {
490	dpavlin	40	my ($self,$dbindex) = @_;
491			confess dump($dbindex) . 'not number' unless $dbindex =~ m{^\d+$};
492			$self->_sock_send_ok( 'SELECT', $dbindex );
493	dpavlin	38	}
494
495	dpavlin	40	=head2 move
496
497			$r->move( $key, $dbindex );
498
499			=cut
500
501			sub move {
502			my ( $self, $key, $dbindex ) = @_;
503			$self->_sock_send( 'MOVE', $key, $dbindex );
504			}
505
506	dpavlin	41	=head2 flushdb
507
508			$r->flushdb;
509
510			=cut
511
512			sub flushdb {
513			my $self = shift;
514			$self->_sock_send_ok('FLUSHDB');
515			}
516
517			=head2 flushall
518
519			$r->flushall;
520
521			=cut
522
523			sub flushall {
524			my $self = shift;
525			$self->_sock_send_ok('flushall');
526			}
527
528	dpavlin	1	=head1 AUTHOR
529
530			Dobrica Pavlinusic, C<< <dpavlin at rot13.org> >>
531
532			=head1 BUGS
533
534			Please report any bugs or feature requests to C<bug-redis at rt.cpan.org>, or through
535			the web interface at L<http://rt.cpan.org/NoAuth/ReportBug.html?Queue=Redis>. I will be notified, and then you'll
536			automatically be notified of progress on your bug as I make changes.
537
538
539
540
541			=head1 SUPPORT
542
543			You can find documentation for this module with the perldoc command.
544
545			perldoc Redis
546
547
548			You can also look for information at:
549
550			=over 4
551
552			=item * RT: CPAN's request tracker
553
554			L<http://rt.cpan.org/NoAuth/Bugs.html?Dist=Redis>
555
556			=item * AnnoCPAN: Annotated CPAN documentation
557
558			L<http://annocpan.org/dist/Redis>
559
560			=item * CPAN Ratings
561
562			L<http://cpanratings.perl.org/d/Redis>
563
564			=item * Search CPAN
565
566			L<http://search.cpan.org/dist/Redis>
567
568			=back
569
570
571			=head1 ACKNOWLEDGEMENTS
572
573
574			=head1 COPYRIGHT & LICENSE
575
576			Copyright 2009 Dobrica Pavlinusic, all rights reserved.
577
578			This program is free software; you can redistribute it and/or modify it
579			under the same terms as Perl itself.
580
581
582			=cut
583
584			1; # End of Redis