The Perl Toolchain Summit needs more sponsors. If your company depends on Perl, please support this very important event.
use 5.008000;
use strict;
use warnings;

use Test::More tests => 31;
use AnyEvent::Redis::RipeRedis qw( :err_codes );
use Net::EmptyPort qw( empty_port );
use Scalar::Util qw( weaken );
require 't/test_helper.pl';

t_cant_connect_mth1();
t_cant_connect_mth2();

t_no_connection();
t_reconnection();
t_read_timeout();

t_premature_conn_close_mth1();
t_premature_conn_close_mth2();

t_subscription_lost();


sub t_cant_connect_mth1 {
  my $redis;
  my $port = empty_port();

  my $t_cli_err_msg;
  my $t_cmd_err_msg;
  my $t_cmd_err_code;

  AE::now_update();
  ev_loop(
    sub {
      my $cv = shift;

      $redis = AnyEvent::Redis::RipeRedis->new(
        port               => $port,
        connection_timeout => 3,
        reconnect          => 0,

        on_connect_error => sub {
          $t_cli_err_msg = shift;
        },
      );

      $redis->ping(
        { on_error => sub {
            $t_cmd_err_msg  = shift;
            $t_cmd_err_code = shift;

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

  my $t_npref = "can't connect; 'on_connect_error' used";
  like( $t_cli_err_msg, qr/^Can't connect to localhost:$port:/,
      "$t_npref; client error message" );
  like( $t_cmd_err_msg,
      qr/^Operation "ping" aborted: Can't connect to localhost:$port:/,
      "$t_npref; command error message" );
  is( $t_cmd_err_code, E_CANT_CONN, "$t_npref; command error code" );

  return;
}

sub t_cant_connect_mth2 {
  my $redis;
  my $port = empty_port();

  my $t_cli_err_msg;
  my $t_cli_err_code;
  my $t_cmd_err_msg;
  my $t_cmd_err_code;

  AE::now_update();
  ev_loop(
    sub {
      my $cv = shift;

      $redis = AnyEvent::Redis::RipeRedis->new(
        port               => $port,
        connection_timeout => 3,
        reconnect          => 0,

        on_error => sub {
          $t_cli_err_msg  = shift;
          $t_cli_err_code = shift;
        },
      );

      $redis->ping(
        { on_error => sub {
            $t_cmd_err_msg  = shift;
            $t_cmd_err_code = shift;

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

  my $t_npref = "can't connect; 'on_error' used";
  like( $t_cli_err_msg, qr/^Can't connect to localhost:$port:/,
      "$t_npref; client error message" );
  is( $t_cli_err_code, E_CANT_CONN, "$t_npref; client error code" );
  like( $t_cmd_err_msg,
      qr/^Operation "ping" aborted: Can't connect to localhost:$port:/,
      "$t_npref; command error message" );
  is( $t_cmd_err_code, E_CANT_CONN, "$t_npref; command error code" );

  return;
}

sub t_no_connection {
  my $redis;
  my $port = empty_port();

  my $t_cli_err_msg;
  my $t_cmd_err_msg_0;
  my $t_cmd_err_code_0;

  AE::now_update();
  ev_loop(
    sub {
      my $cv = shift;

      $redis = AnyEvent::Redis::RipeRedis->new(
        port               => $port,
        connection_timeout => 3,
        reconnect          => 0,

        on_connect_error => sub {
          $t_cli_err_msg = shift;
        },
      );

      $redis->ping(
        { on_error => sub {
            $t_cmd_err_msg_0  = shift;
            $t_cmd_err_code_0 = shift;

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

  my $t_npref = 'no connection';
  like( $t_cli_err_msg, qr/^Can't connect to localhost:$port:/,
      "$t_npref; client error message" );
  like( $t_cmd_err_msg_0,
      qr/^Operation "ping" aborted: Can't connect to localhost:$port:/,
      "$t_npref; first command error message" );
  is( $t_cmd_err_code_0, E_CANT_CONN, "$t_npref; first command error code" );

  my $t_cmd_err_msg_1;
  my $t_cmd_err_code_1;

  ev_loop(
    sub {
      my $cv = shift;

      $redis->ping(
        { on_error => sub {
            $t_cmd_err_msg_1 = shift;
            $t_cmd_err_code_1 = shift;

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

  is( $t_cmd_err_msg_1,
      "Operation \"ping\" aborted: No connection to the server.",
      "$t_npref; second command error message" );
  is( $t_cmd_err_code_1, E_NO_CONN, "$t_npref; second command error code" );

  return;
}

sub t_reconnection {
  my $port = empty_port();
  my $server_info = run_redis_instance(
    port => $port,
  );

  SKIP: {
    if ( !defined $server_info ) {
      skip 'redis-server is required for this test', 5;
    }

    my $t_conn_cnt = 0;
    my $t_disconn_cnt = 0;
    my $t_cli_err_msg;
    my $t_cli_err_code;
    my $redis;

    AE::now_update();
    ev_loop(
      sub {
        my $cv = shift;

        $redis = AnyEvent::Redis::RipeRedis->new(
          host => $server_info->{host},
          port => $server_info->{port},

          on_connect => sub {
            $t_conn_cnt++;
          },
          on_disconnect => sub {
            $t_disconn_cnt++;
            $cv->send();
          },
          on_error => sub {
            $t_cli_err_msg  = shift;
            $t_cli_err_code = shift;
          },
        );

        $redis->ping(
          { on_done => sub {
              my $timer;
              $timer = AE::postpone(
                sub {
                  undef $timer;
                  $server_info->{server}->stop();
                }
              );
            },
          }
        );
      }
    );

    $server_info = run_redis_instance(
      port => $port,
    );

    my $t_pong;

    ev_loop(
      sub {
        my $cv = shift;

        $redis->ping(
          {
            on_done => sub {
              $t_pong = shift;
              $cv->send();
            },
          }
        );
      }
    );

    my $t_npref = 'reconnection';
    is( $t_conn_cnt, 2, "$t_npref; connections" );
    is( $t_disconn_cnt, 1, "$t_npref; disconnections" );
    is( $t_cli_err_msg, 'Connection closed by remote host.',
        "$t_npref; error message" );
    is( $t_cli_err_code, E_CONN_CLOSED_BY_REMOTE_HOST, "$t_npref; error code" );
    is( $t_pong, 'PONG', "$t_npref; success PING" );

    $redis->disconnect();
  }

  return;
}

sub t_read_timeout {
  my $server_info = run_redis_instance();

  SKIP: {
    if ( !defined $server_info ) {
      skip 'redis-server is required for this test', 4;
    }

    my $redis;

    my $t_cli_err_msg;
    my $t_cli_err_code;
    my $t_cmd_err_msg;
    my $t_cmd_err_code;

    ev_loop(
      sub {
        my $cv = shift;

        $redis = AnyEvent::Redis::RipeRedis->new(
          host         => $server_info->{host},
          port         => $server_info->{port},
          reconnect    => 0,
          read_timeout => 1,

          on_error => sub {
            $t_cli_err_msg  = shift;
            $t_cli_err_code = shift;
          },
        );

        $redis->brpop( 'non_existent', '3',
          { on_error => sub {
              $t_cmd_err_msg  = shift;
              $t_cmd_err_code = shift;

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

    $redis->disconnect();

    my $t_npref = 'read timeout';
    is( $t_cli_err_msg, 'Read timed out.', "$t_npref; client error message" );
    is( $t_cli_err_code, E_READ_TIMEDOUT, "$t_npref; client error code" );
    is( $t_cmd_err_msg, "Operation \"brpop\" aborted: Read timed out.",
        "$t_npref; command error message" );
    is( $t_cmd_err_code, E_READ_TIMEDOUT, "$t_npref; command error code" );
  }

  return;
}

sub t_premature_conn_close_mth1 {
  my $t_cli_err_msg;
  my $t_cli_err_code;
  my $t_cmd_err_msg;
  my $t_cmd_err_code;

  my $redis = AnyEvent::Redis::RipeRedis->new(
    on_error => sub {
      $t_cli_err_msg = shift;
      $t_cli_err_code = shift;
    },
  );

  $redis->ping(
    { on_error => sub {
        $t_cmd_err_msg = shift;
        $t_cmd_err_code = shift;
      },
    }
  );

  $redis->disconnect();

  my $t_npref = 'premature connection close; disconnect() used';
  is( $t_cli_err_msg, 'Connection closed by client prematurely.',
      "$t_npref; client error message" );
  is( $t_cli_err_code, E_CONN_CLOSED_BY_CLIENT, "$t_npref; client error message" );
  is( $t_cmd_err_msg,
      "Operation \"ping\" aborted: Connection closed by client prematurely.",
      "$t_npref; command error message" );
  is( $t_cmd_err_code, E_CONN_CLOSED_BY_CLIENT, "$t_npref; command error message" );

  return;
}

sub t_premature_conn_close_mth2 {
  my $on_error_was_called = 0;
  my $t_cmd_err_msg;

  local $SIG{__WARN__} = sub {
    $t_cmd_err_msg = shift;

    chomp( $t_cmd_err_msg );
  };

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

  $redis->ping(
    { on_error => sub {
        $on_error_was_called = 1;
      },
    }
  );

  undef $redis;

  my $t_npref = 'premature connection close; undef() used';
  ok( !$on_error_was_called, "$t_npref; 'on_error' callback ignored" );
  is( $t_cmd_err_msg,
      "Operation \"ping\" aborted: Client object destroyed prematurely.",
      "$t_npref; command error message" );

  return;
}

sub t_subscription_lost {
  my $server_info = run_redis_instance();

  SKIP: {
    if ( !defined $server_info ) {
      skip 'redis-server is required for this test', 4;
    }

    my $redis;

    my $t_cli_err_msg;
    my $t_cli_err_code;
    my $t_cmd_err_msg;
    my $t_cmd_err_code;

    ev_loop(
      sub {
        my $cv = shift;

        $redis = AnyEvent::Redis::RipeRedis->new(
          host => $server_info->{host},
          port => $server_info->{port},

          on_error => sub {
            $t_cli_err_msg  = shift;
            $t_cli_err_code = shift;
          },
        );

        $redis->subscribe( 'ch_foo',
          { on_done => sub {
              $server_info->{server}->stop();
            },

            on_error => sub {
              $t_cmd_err_msg  = shift;
              $t_cmd_err_code = shift;

              $cv->send();
            },

            on_message => sub {},
          },
        );
      }
    );

    my $t_npref = 'subscription lost';
    is( $t_cli_err_msg, 'Connection closed by remote host.',
        "$t_npref; client error message" );
    is( $t_cli_err_code, E_CONN_CLOSED_BY_REMOTE_HOST,
        "$t_npref; client error code" );
    is( $t_cmd_err_msg,
        "Subscription \"ch_foo\" lost: Connection closed by remote host.",
        "$t_npref; command error message" );
    is( $t_cmd_err_code, E_CONN_CLOSED_BY_REMOTE_HOST,
        "$t_npref; command error code" );
  }

  return;
}