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

  ViewVC Help
Powered by ViewVC 1.1.26