Redis.pre-github/lib/Redis.pm

package Redis;

use warnings;
use strict;

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

=head1 NAME

Redis - The great new Redis!

=cut

our $VERSION = '0.01';


=head1 SYNOPSIS

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

    use Redis;

    my $r = Redis->new();


=head1 FUNCTIONS

=head2 new

=cut

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;
}

=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' );

=cut

sub set {
        my ( $self, $k, $v ) = @_;
        print $sock "SET $k " . length($v) . "\r\n$v\r\n";
        my $ok = <$sock>;
        die dump($ok) unless $ok eq "+OK\r\n";
}

=head2 get

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

=cut

sub get {
        my ( $self, $k ) = @_;
        print $sock "GET $k\r\n";
        my $len = <$sock>;
#       warn "# len: ",dump($len);
        return undef if $len eq "nil\r\n";
        my $v;
        read($sock, $v, $len) || die $!;
#       warn "# v: ",dump($v);
        my $crlf;
        read($sock, $crlf, 2); # skip cr/lf
        return $v;
}


=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
9	dpavlin	1	=head1 NAME
10
11			Redis - The great new Redis!
12
13			=cut
14
15			our $VERSION = '0.01';
16
17
18			=head1 SYNOPSIS
19
20	dpavlin	2	Pure perl bindings for L<http://code.google.com/p/redis/>
21	dpavlin	1
22			use Redis;
23
24	dpavlin	2	my $r = Redis->new();
25	dpavlin	1
26
27
28	dpavlin	2
29	dpavlin	1	=head1 FUNCTIONS
30
31	dpavlin	2	=head2 new
32	dpavlin	1
33			=cut
34
35	dpavlin	2	our $sock;
36			my $server = '127.0.0.1:6379';
37
38			sub new {
39			my $class = shift;
40			my $self = {};
41			bless($self, $class);
42
43			warn "# opening socket to $server";
44
45			$sock \|\|= IO::Socket::INET->new(
46			PeerAddr => $server,
47			Proto => 'tcp',
48			) \|\| die $!;
49
50			$self;
51	dpavlin	1	}
52
53	dpavlin	2	=head1 Connection Handling
54	dpavlin	1
55	dpavlin	2	=head2 quit
56
57			$r->quit;
58
59	dpavlin	1	=cut
60
61	dpavlin	2	sub quit {
62			my $self = shift;
63
64			close( $sock ) \|\| warn $!;
65	dpavlin	1	}
66
67	dpavlin	2	=head2 ping
68
69	dpavlin	3	$r->ping \|\| die "no server?";
70	dpavlin	2
71			=cut
72
73			sub ping {
74			print $sock "PING\r\n";
75			my $pong = <$sock>;
76			die "ping failed, got ", dump($pong) unless $pong eq "+PONG\r\n";
77			}
78
79	dpavlin	3	=head1 Commands operating on string values
80
81			=head2 set
82
83			$r->set( foo => 'bar' );
84
85			=cut
86
87			sub set {
88			my ( $self, $k, $v ) = @_;
89			print $sock "SET $k " . length($v) . "\r\n$v\r\n";
90			my $ok = <$sock>;
91			die dump($ok) unless $ok eq "+OK\r\n";
92			}
93
94			=head2 get
95
96			my $value = $r->get( 'foo' );
97
98			=cut
99
100			sub get {
101			my ( $self, $k ) = @_;
102			print $sock "GET $k\r\n";
103			my $len = <$sock>;
104	dpavlin	4	# warn "# len: ",dump($len);
105			return undef if $len eq "nil\r\n";
106	dpavlin	3	my $v;
107			read($sock, $v, $len) \|\| die $!;
108	dpavlin	4	# warn "# v: ",dump($v);
109			my $crlf;
110			read($sock, $crlf, 2); # skip cr/lf
111	dpavlin	3	return $v;
112			}
113
114	dpavlin	4
115
116	dpavlin	1	=head1 AUTHOR
117
118			Dobrica Pavlinusic, C<< <dpavlin at rot13.org> >>
119
120			=head1 BUGS
121
122			Please report any bugs or feature requests to C<bug-redis at rt.cpan.org>, or through
123			the web interface at L<http://rt.cpan.org/NoAuth/ReportBug.html?Queue=Redis>. I will be notified, and then you'll
124			automatically be notified of progress on your bug as I make changes.
125
126
127
128
129			=head1 SUPPORT
130
131			You can find documentation for this module with the perldoc command.
132
133			perldoc Redis
134
135
136			You can also look for information at:
137
138			=over 4
139
140			=item * RT: CPAN's request tracker
141
142			L<http://rt.cpan.org/NoAuth/Bugs.html?Dist=Redis>
143
144			=item * AnnoCPAN: Annotated CPAN documentation
145
146			L<http://annocpan.org/dist/Redis>
147
148			=item * CPAN Ratings
149
150			L<http://cpanratings.perl.org/d/Redis>
151
152			=item * Search CPAN
153
154			L<http://search.cpan.org/dist/Redis>
155
156			=back
157
158
159			=head1 ACKNOWLEDGEMENTS
160
161
162			=head1 COPYRIGHT & LICENSE
163
164			Copyright 2009 Dobrica Pavlinusic, all rights reserved.
165
166			This program is free software; you can redistribute it and/or modify it
167			under the same terms as Perl itself.
168
169
170			=cut
171
172			1; # End of Redis