/[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

Annotation of /lib/Redis.pm

Parent Directory Parent Directory | Revision Log Revision Log


Revision 9 - (hide annotations)
Sat Mar 21 22:54:10 2009 UTC (15 years ago) by dpavlin
File size: 3375 byte(s)
exists
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     Redis - The great new Redis!
13    
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     use Redis;
24    
25 dpavlin 2 my $r = Redis->new();
26 dpavlin 1
27    
28    
29 dpavlin 2
30 dpavlin 1 =head1 FUNCTIONS
31    
32 dpavlin 2 =head2 new
33 dpavlin 1
34     =cut
35    
36 dpavlin 2 our $sock;
37     my $server = '127.0.0.1:6379';
38    
39     sub new {
40     my $class = shift;
41     my $self = {};
42     bless($self, $class);
43    
44     warn "# opening socket to $server";
45    
46     $sock ||= IO::Socket::INET->new(
47     PeerAddr => $server,
48     Proto => 'tcp',
49     ) || die $!;
50    
51     $self;
52 dpavlin 1 }
53    
54 dpavlin 2 =head1 Connection Handling
55 dpavlin 1
56 dpavlin 2 =head2 quit
57    
58     $r->quit;
59    
60 dpavlin 1 =cut
61    
62 dpavlin 2 sub quit {
63     my $self = shift;
64    
65     close( $sock ) || warn $!;
66 dpavlin 1 }
67    
68 dpavlin 2 =head2 ping
69    
70 dpavlin 3 $r->ping || die "no server?";
71 dpavlin 2
72     =cut
73    
74     sub ping {
75     print $sock "PING\r\n";
76     my $pong = <$sock>;
77     die "ping failed, got ", dump($pong) unless $pong eq "+PONG\r\n";
78     }
79    
80 dpavlin 3 =head1 Commands operating on string values
81    
82     =head2 set
83    
84 dpavlin 5 $r->set( foo => 'bar', $new );
85 dpavlin 3
86     =cut
87    
88     sub set {
89 dpavlin 5 my ( $self, $k, $v, $new ) = @_;
90     print $sock ( $new ? "SETNX" : "SET" ) . " $k " . length($v) . "\r\n$v\r\n";
91 dpavlin 3 my $ok = <$sock>;
92 dpavlin 5 confess dump($ok) unless $ok eq "+OK\r\n";
93 dpavlin 3 }
94    
95     =head2 get
96    
97     my $value = $r->get( 'foo' );
98    
99     =cut
100    
101     sub get {
102     my ( $self, $k ) = @_;
103     print $sock "GET $k\r\n";
104     my $len = <$sock>;
105 dpavlin 4 # warn "# len: ",dump($len);
106     return undef if $len eq "nil\r\n";
107 dpavlin 3 my $v;
108     read($sock, $v, $len) || die $!;
109 dpavlin 4 # warn "# v: ",dump($v);
110     my $crlf;
111     read($sock, $crlf, 2); # skip cr/lf
112 dpavlin 3 return $v;
113     }
114    
115 dpavlin 7 =head2 incr
116 dpavlin 4
117 dpavlin 7 $r->incr('counter');
118     $r->incr('tripplets', 3);
119 dpavlin 4
120 dpavlin 7 =cut
121    
122     sub incr {
123     my ( $self, $key, $value ) = @_;
124     if ( defined $value ) {
125     print $sock "INCRBY $key $value\r\n";
126     } else {
127     print $sock "INCR $key\r\n";
128     }
129     my $count = <$sock>;
130     warn "# $key = $count";
131     return $count;
132     }
133    
134 dpavlin 8 =head2 decr
135    
136     $r->decr('counter');
137     $r->decr('tripplets', 3);
138    
139     =cut
140    
141     sub decr {
142     my ( $self, $key, $value ) = @_;
143     if ( defined $value ) {
144     print $sock "DECRBY $key $value\r\n";
145     } else {
146     print $sock "DECR $key\r\n";
147     }
148     my $count = <$sock>;
149     warn "# $key = $count";
150     return $count;
151     }
152    
153 dpavlin 9 =head2 exists
154    
155     $r->exists( 'key' ) && print "got key!";
156    
157     =cut
158    
159     sub exists {
160     my ( $self, $key ) = @_;
161     print $sock "EXISTS $key\r\n";
162     my $found = <$sock>;
163     $found =~ s{\r\n$}{};
164     warn "# exists $key = $found";
165     return $found;
166     }
167    
168 dpavlin 1 =head1 AUTHOR
169    
170     Dobrica Pavlinusic, C<< <dpavlin at rot13.org> >>
171    
172     =head1 BUGS
173    
174     Please report any bugs or feature requests to C<bug-redis at rt.cpan.org>, or through
175     the web interface at L<http://rt.cpan.org/NoAuth/ReportBug.html?Queue=Redis>. I will be notified, and then you'll
176     automatically be notified of progress on your bug as I make changes.
177    
178    
179    
180    
181     =head1 SUPPORT
182    
183     You can find documentation for this module with the perldoc command.
184    
185     perldoc Redis
186    
187    
188     You can also look for information at:
189    
190     =over 4
191    
192     =item * RT: CPAN's request tracker
193    
194     L<http://rt.cpan.org/NoAuth/Bugs.html?Dist=Redis>
195    
196     =item * AnnoCPAN: Annotated CPAN documentation
197    
198     L<http://annocpan.org/dist/Redis>
199    
200     =item * CPAN Ratings
201    
202     L<http://cpanratings.perl.org/d/Redis>
203    
204     =item * Search CPAN
205    
206     L<http://search.cpan.org/dist/Redis>
207    
208     =back
209    
210    
211     =head1 ACKNOWLEDGEMENTS
212    
213    
214     =head1 COPYRIGHT & LICENSE
215    
216     Copyright 2009 Dobrica Pavlinusic, all rights reserved.
217    
218     This program is free software; you can redistribute it and/or modify it
219     under the same terms as Perl itself.
220    
221    
222     =cut
223    
224     1; # End of Redis

  ViewVC Help
Powered by ViewVC 1.1.26