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

Diff of /lib/Redis.pm

Parent Directory Parent Directory | Revision Log Revision Log | View Patch Patch

revision 36 by dpavlin, Sun Mar 22 18:05:12 2009 UTC revision 41 by dpavlin, Sun Mar 22 18:42:21 2009 UTC
# Line 33  L<git://github.com/antirez/redis> Line 33  L<git://github.com/antirez/redis>
33    
34  =cut  =cut
35    
36    our $debug = $ENV{REDIS} || 0;
37    
38  our $sock;  our $sock;
39  my $server = '127.0.0.1:6379';  my $server = '127.0.0.1:6379';
40    
# Line 51  sub new { Line 53  sub new {
53          $self;          $self;
54  }  }
55    
56  sub _sock_result {  sub __sock_result {
57          my $result = <$sock>;          my $result = <$sock>;
58          warn "# result: ",dump( $result );          warn "## result: ",dump( $result ) if $debug;
59          $result =~ s{\r\n$}{} || warn "can't find cr/lf";          $result =~ s{\r\n$}{} || warn "can't find cr/lf";
60          return $result;          return $result;
61  }  }
62    
63  sub _sock_read_bulk {  sub __sock_read_bulk {
64          my $len = <$sock>;          my $len = <$sock>;
65          warn "## bulk len: ",dump($len);          warn "## bulk len: ",dump($len) if $debug;
66          return undef if $len eq "nil\r\n";          return undef if $len eq "nil\r\n";
67          my $v;          my $v;
68          if ( $len > 0 ) {          if ( $len > 0 ) {
69                  read($sock, $v, $len) || die $!;                  read($sock, $v, $len) || die $!;
70                  warn "## bulk v: ",dump($v);                  warn "## bulk v: ",dump($v) if $debug;
71          }          }
72          my $crlf;          my $crlf;
73          read($sock, $crlf, 2); # skip cr/lf          read($sock, $crlf, 2); # skip cr/lf
# Line 74  sub _sock_read_bulk { Line 76  sub _sock_read_bulk {
76    
77  sub _sock_result_bulk {  sub _sock_result_bulk {
78          my $self = shift;          my $self = shift;
79          warn "## _sock_result_bulk ",dump( @_ );          warn "## _sock_result_bulk ",dump( @_ ) if $debug;
80          print $sock join(' ',@_) . "\r\n";          print $sock join(' ',@_) . "\r\n";
81          _sock_read_bulk();          __sock_read_bulk();
82  }  }
83    
84  sub _sock_result_bulk_list {  sub _sock_result_bulk_list {
85          my $self = shift;          my $self = shift;
86          warn "## _sock_result_bulk_list ",dump( @_ );          warn "## _sock_result_bulk_list ",dump( @_ ) if $debug;
87    
88          my $size = $self->_sock_send( @_ );          my $size = $self->_sock_send( @_ );
89          confess $size unless $size > 0;          confess $size unless $size > 0;
# Line 89  sub _sock_result_bulk_list { Line 91  sub _sock_result_bulk_list {
91    
92          my @list = ( 0 .. $size );          my @list = ( 0 .. $size );
93          foreach ( 0 .. $size ) {          foreach ( 0 .. $size ) {
94                  $list[ $_ ] = _sock_read_bulk();                  $list[ $_ ] = __sock_read_bulk();
95          }          }
96    
97          warn "## list = ", dump( @list );          warn "## list = ", dump( @list ) if $debug;
98          return @list;          return @list;
99  }  }
100    
# Line 104  sub __sock_ok { Line 106  sub __sock_ok {
106    
107  sub _sock_send {  sub _sock_send {
108          my $self = shift;          my $self = shift;
109          warn "## _sock_send ",dump( @_ );          warn "## _sock_send ",dump( @_ ) if $debug;
110          print $sock join(' ',@_) . "\r\n";          print $sock join(' ',@_) . "\r\n";
111          _sock_result();          __sock_result();
112  }  }
113    
114  sub _sock_send_ok {  sub _sock_send_ok {
115          my $self = shift;          my $self = shift;
116          warn "## _sock_send_ok ",dump( @_ );          warn "## _sock_send_ok ",dump( @_ ) if $debug;
117          print $sock join(' ',@_) . "\r\n";          print $sock join(' ',@_) . "\r\n";
118          __sock_ok();          __sock_ok();
119  }  }
120    
121  sub __sock_send_bulk_raw {  sub __sock_send_bulk_raw {
122          my $self = shift;          warn "## _sock_send_bulk ",dump( @_ ) if $debug;
         warn "## _sock_send_bulk ",dump( @_ );  
123          my $value = pop;          my $value = pop;
124          $value = '' unless defined $value; # FIXME errr? nil?          $value = '' unless defined $value; # FIXME errr? nil?
125          print $sock join(' ',@_) . ' ' . length($value) . "\r\n$value\r\n"          print $sock join(' ',@_) . ' ' . length($value) . "\r\n$value\r\n"
126  }  }
127    
128  sub _sock_send_bulk {  sub _sock_send_bulk {
129            my $self = shift;
130          __sock_send_bulk_raw( @_ );          __sock_send_bulk_raw( @_ );
131          __sock_ok();          __sock_ok();
132  }  }
133    
134  sub _sock_send_bulk_number {  sub _sock_send_bulk_number {
135            my $self = shift;
136          __sock_send_bulk_raw( @_ );          __sock_send_bulk_raw( @_ );
137          my $v = _sock_result();          my $v = __sock_result();
138          confess $v unless $v =~ m{^\-?\d+$};          confess $v unless $v =~ m{^\-?\d+$};
139          return $v;          return $v;
140  }  }
# Line 473  sub sinterstore { Line 476  sub sinterstore {
476          $self->_sock_send_ok( 'SINTERSTORE', @_ );          $self->_sock_send_ok( 'SINTERSTORE', @_ );
477  }  }
478    
479    =head1 Multiple databases handling commands
480    
481    =head2 select
482    
483      $r->select( $dbindex ); # 0 for new clients
484    
485    =cut
486    
487    sub select {
488            my ($self,$dbindex) = @_;
489            confess dump($dbindex) . 'not number' unless $dbindex =~ m{^\d+$};
490            $self->_sock_send_ok( 'SELECT', $dbindex );
491    }
492    
493    =head2 move
494    
495      $r->move( $key, $dbindex );
496    
497    =cut
498    
499    sub move {
500            my ( $self, $key, $dbindex ) = @_;
501            $self->_sock_send( 'MOVE', $key, $dbindex );
502    }
503    
504    =head2 flushdb
505    
506      $r->flushdb;
507    
508    =cut
509    
510    sub flushdb {
511            my $self = shift;
512            $self->_sock_send_ok('FLUSHDB');
513    }
514    
515    =head2 flushall
516    
517      $r->flushall;
518    
519    =cut
520    
521    sub flushall {
522            my $self = shift;
523            $self->_sock_send_ok('flushall');
524    }
525    
526  =head1 AUTHOR  =head1 AUTHOR
527    
528  Dobrica Pavlinusic, C<< <dpavlin at rot13.org> >>  Dobrica Pavlinusic, C<< <dpavlin at rot13.org> >>
Legend:
Removed from v.36  
changed lines
  Added in v.41
  ViewVC Help
Powered by ViewVC 1.1.26