view release on metacpan or  search on metacpan

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;

my $REDIS;
my $T_IS_CONN = 0;
my $T_IS_DISCONN = 0;

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

ok( $T_IS_CONN, 'on_connect' );

t_status_reply_mth1($REDIS);
t_status_reply_mth2($REDIS);

t_numeric_reply_mth1($REDIS);
t_numeric_reply_mth2($REDIS);

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_mbulk_reply_undef_mth1($REDIS);
t_mbulk_reply_undef_mth2($REDIS);

t_nested_mbulk_reply_mth1($REDIS);
t_nested_mbulk_reply_mth2($REDIS);

t_multi_word_command($REDIS);

t_oprn_error_mth1($REDIS);
t_oprn_error_mth2($REDIS);

t_default_on_error($REDIS);

t_error_after_exec_mth1($REDIS);
t_error_after_exec_mth2($REDIS);

t_quit($REDIS);


sub t_status_reply_mth1 {
  my $redis = shift;

  my $t_reply;

  ev_loop(
    sub {
      my $cv = shift;

      $redis->set( 'foo', "some\r\nstring",
        { on_done => sub {
            $t_reply = shift;
          },
        }
      );

      $redis->del( 'foo',
        { on_done => sub {
            $cv->send();
          }
        }
      );
    }
  );

  is( $t_reply, 'OK', "SET; 'on_done' used; status reply" );

  return;
}

sub t_status_reply_mth2 {

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

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

  return;
}

sub t_get_undef_mth1 {
  my $redis = shift;

  my $t_reply;

  ev_loop(
    sub {
      my $cv = shift;

      $redis->get( 'empty',
        { on_done => sub {
            $t_reply = shift;

            $cv->send();
          },
        }
      );
    }
  );

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

  return;
}

sub t_get_undef_mth2 {
  my $redis = shift;

  my $t_reply;

  ev_loop(
    sub {
      my $cv = shift;

      $redis->get( 'empty',
        sub {
          $t_reply = shift;

          if ( @_ ) {
            my $err_msg = shift;

            diag( $err_msg );
          }

          $cv->send();
        }
      );
    }
  );

  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_reply = shift;
          },
        }
      );

      $redis->del( 'ключ',
        { on_done => sub {
            $cv->send();
          }
        }
      );
    }
  );

  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_reply = shift;

          if ( @_ ) {
            my $err_msg = shift;

            diag( $err_msg );
          }
        },
      );

      $redis->del( 'ключ',
        sub {
          shift;

          if ( @_ ) {
            my $err_msg = shift;

            diag( $err_msg );
          }

          $cv->send();
        }
      );
    }
  );

  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( 'ключ', 'Значение' );

      $redis->get( 'ключ',
        { on_done => sub {
            $t_reply = shift;
          },
        }
      );

      $redis->del( 'ключ',
        { on_done => sub {
            $cv->send();
          }
        }
      );
    }
  );

  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( 'ключ', 'Значение' );

      $redis->get( 'ключ',
        sub {
          $t_reply = shift;

          if ( @_ ) {
            my $err_msg = shift;

            diag( $err_msg );
          }
        }
      );

      $redis->del( 'ключ',
        sub {
          shift;

          if ( @_ ) {
            my $err_msg = shift;

            diag( $err_msg );
          }

          $cv->send();
        }
      );
    }
  );

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

  return;
}

sub t_get_non_existent_mth1 {
  my $redis = shift;

  my $t_reply = 'not_undef';

  ev_loop(
    sub {
      my $cv = shift;

      $redis->get( 'non_existent',
        { on_done => sub {
            $t_reply = shift;

            $cv->send();
          },
        }
      );