lib/Redis.pm

   1 package Redis;
   2
   3 use warnings;
   4 use strict;
   5
   6 use IO::Socket::INET;
   7 use Data::Dump qw/dump/;
   8
   9 =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 Pure perl bindings for L<http://code.google.com/p/redis/>
  21
  22     use Redis;
  23
  24     my $r = Redis->new();
  25
  26
  27
  28
  29 =head1 FUNCTIONS
  30
  31 =head2 new
  32
  33 =cut
  34
  35 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 }
  52
  53 =head1 Connection Handling
  54
  55 =head2 quit
  56
  57   $r->quit;
  58
  59 =cut
  60
  61 sub quit {
  62         my $self = shift;
  63
  64         close( $sock ) || warn $!;
  65 }
  66
  67 =head2 ping
  68
  69   $r->ping || die "no server?";
  70
  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 =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 #       warn "# len: ",dump($len);
 105         return undef if $len eq "nil\r\n";
 106         my $v;
 107         read($sock, $v, $len) || die $!;
 108 #       warn "# v: ",dump($v);
 109         my $crlf;
 110         read($sock, $crlf, 2); # skip cr/lf
 111         return $v;
 112 }
 113
 114
 115
 116 =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