AnyEvent-Redis-RipeRedis

 view release on metacpan or  search on metacpan

lib/AnyEvent/Redis/RipeRedis.pm  view on Meta::CPAN

use warnings;

package AnyEvent::Redis::RipeRedis;

use base qw( Exporter );

our $VERSION = '1.62';

use AnyEvent;
use AnyEvent::Handle;
use Encode qw( find_encoding is_utf8 );
use Scalar::Util qw( looks_like_number weaken );
use Digest::SHA qw( sha1_hex );
use Carp qw( croak );

my %ERROR_CODES;

BEGIN {
  %ERROR_CODES = (
    E_CANT_CONN                  => 1,
    E_LOADING_DATASET            => 2,

lib/AnyEvent/Redis/RipeRedis.pm  view on Meta::CPAN

sub _push_write {
  my $self = shift;
  my $cmd  = shift;

  my $cmd_str = '';
  foreach my $token ( $cmd->{kwd}, @{ $cmd->{args} } ) {
    unless ( defined $token ) {
      $token = '';
    }
    elsif ( defined $self->{encoding} && is_utf8( $token ) ) {
      $token = $self->{encoding}->encode( $token );
    }
    $cmd_str .= '$' . length( $token ) . EOL . $token . EOL;
  }
  $cmd_str = '*' . ( scalar( @{ $cmd->{args} } ) + 1 ) . EOL . $cmd_str;

  my $handle = $self->{_handle};
  if ( defined $self->{read_timeout} && !@{ $self->{_processing_queue} } ) {
    $handle->rtimeout_reset();
    $handle->rtimeout( $self->{read_timeout} );

lib/AnyEvent/Redis/RipeRedis.pm  view on Meta::CPAN

  my $redis = AnyEvent::Redis::RipeRedis->new(
    host                   => 'localhost',
    port                   => 6379,
    password               => 'yourpass',
    database               => 7,
    lazy                   => 1,
    connection_timeout     => 5,
    read_timeout           => 5,
    reconnect              => 1,
    min_reconnect_interval => 5,
    encoding               => 'utf8',

    on_connect => sub {
      # handling...
    },

    on_disconnect => sub {
      # handling...
    },

    on_connect_error => sub {

t/01-accessors.t  view on Meta::CPAN

use lib 't/tlib';
use Test::More tests => 37;
use AnyEvent::Redis::RipeRedis qw( :err_codes );

my $REDIS = AnyEvent::Redis::RipeRedis->new(
  password               => 'test',
  connection_timeout     => 10,
  read_timeout           => 5,
  reconnect              => 1,
  min_reconnect_interval => 5,
  encoding               => 'utf8',

  on_connect => sub {
    return 1;
  },

  on_disconnect => sub {
    return 2;
  },

  on_connect_error => sub {

t/01-accessors.t  view on Meta::CPAN

  $redis->min_reconnect_interval(10);
  is( $redis->min_reconnect_interval, 10, "set 'min_reconnect_interval'" );

  return;
}

sub t_encoding {
  my $redis = shift;

  my $t_enc = $redis->encoding;
  is( $t_enc->name, 'utf8', "get 'encoding'" );

  $redis->encoding(undef);
  is( $redis->encoding, undef, "disable 'encoding'" );

  $redis->encoding('UTF-16');
  $t_enc = $redis->encoding;
  is( $t_enc->name, 'UTF-16', "set 'encoding'" );

  return;
}

t/04-commands.t  view on Meta::CPAN

use 5.008000;
use strict;
use warnings;
use utf8;

use Test::More;
use AnyEvent::Redis::RipeRedis qw( :err_codes );
require 't/test_helper.pl';

my $SERVER_INFO = run_redis_instance();
if ( !defined $SERVER_INFO ) {
  plan skip_all => 'redis-server is required for this test';
}
plan tests => 50;

t/04-commands.t  view on Meta::CPAN

ev_loop(
  sub {
    my $cv = shift;

    $REDIS = AnyEvent::Redis::RipeRedis->new(
      host               => $SERVER_INFO->{host},
      port               => $SERVER_INFO->{port},
      connection_timeout => 5,
      read_timeout       => 5,
      encoding           => 'utf8',

      on_connect => sub {
        $T_IS_CONN = 1;
        $cv->send();
      },
      on_disconnect => sub {
        $T_IS_DISCONN = 1;
      },
    );
  },

t/04-commands.t  view on Meta::CPAN

t_bulk_reply_mth1($REDIS);
t_bulk_reply_mth2($REDIS);

t_set_undef_mth1($REDIS);
t_set_undef_mth2($REDIS);

t_get_undef_mth1($REDIS);
t_get_undef_mth2($REDIS);

t_set_utf8_string_mth1($REDIS);
t_set_utf8_string_mth2($REDIS);

t_get_utf8_string_mth1($REDIS);
t_get_utf8_string_mth2($REDIS);

t_get_non_existent_mth1($REDIS);
t_get_non_existent_mth2($REDIS);

t_mbulk_reply_mth1($REDIS);
t_mbulk_reply_mth2($REDIS);

t_mbulk_reply_empty_list_mth1($REDIS);
t_mbulk_reply_empty_list_mth2($REDIS);

t/04-commands.t  view on Meta::CPAN

        }
      );
    }
  );

  is( $t_reply, '', "GET; 'on_reply' used; undef" );

  return;
}

sub t_set_utf8_string_mth1 {
  my $redis = shift;

  my $t_reply;

  ev_loop(
    sub {
      my $cv = shift;

      $redis->set( 'ключ', 'Значение',
        { on_done => sub {

t/04-commands.t  view on Meta::CPAN

        }
      );
    }
  );

  is( $t_reply, 'OK', "SET; 'on_done' used; UTF-8 string" );

  return;
}

sub t_set_utf8_string_mth2 {
  my $redis = shift;

  my $t_reply;

  ev_loop(
    sub {
      my $cv = shift;

      $redis->set( 'ключ', 'Значение',
        sub {

t/04-commands.t  view on Meta::CPAN

        }
      );
    }
  );

  is( $t_reply, 'OK', "SET; 'on_reply' used; UTF-8 string" );

  return;
}

sub t_get_utf8_string_mth1 {
  my $redis = shift;

  my $t_reply;

  ev_loop(
    sub {
      my $cv = shift;

      $redis->set( 'ключ', 'Значение' );

t/04-commands.t  view on Meta::CPAN

        }
      );
    }
  );

  is( $t_reply, 'Значение', "GET; 'on_done' used; UTF-8 string" );

  return;
}

sub t_get_utf8_string_mth2 {
  my $redis = shift;

  my $t_reply;

  ev_loop(
    sub {
      my $cv = shift;

      $redis->set( 'ключ', 'Значение' );

t/10-exceptions.t  view on Meta::CPAN

    "invalid 'min_reconnect_interval' (negative number; accessor)",
  );

  return;
}

sub t_encoding {
  like(
    exception {
      my $redis = AnyEvent::Redis::RipeRedis->new(
        encoding => 'utf88',
      );
    },
    qr/Encoding "utf88" not found/,
    'invalid encoding (constructor)',
  );

  my $redis = AnyEvent::Redis::RipeRedis->new();

  like(
    exception {
      $redis->encoding('utf88');
    },
    qr/Encoding "utf88" not found/,
    'invalid encoding (accessor)',
  );

  return;
}

sub t_on_message {
  my $redis = AnyEvent::Redis::RipeRedis->new();

  like(