From 70adaa4074e3af4d545bf29110fa1ba900201513 Mon Sep 17 00:00:00 2001
From: Pedro Melo <melo@simplicidade.org>
Date: Thu, 8 Nov 2012 09:51:36 +0000
Subject: [PATCH] Add on_connect callback to Redis constructor

The on_connect callback will be called after each successful connection.

Signed-off-by: Pedro Melo <melo@simplicidade.org>
---
 lib/Redis.pm      |  9 +++++++++
 t/06-on-connect.t | 33 +++++++++++++++++++++++++++++++++
 2 files changed, 42 insertions(+)
 create mode 100644 t/06-on-connect.t

diff --git a/lib/Redis.pm b/lib/Redis.pm
index d4710e0..ca657b9 100644
--- a/lib/Redis.pm
+++ b/lib/Redis.pm
@@ -45,6 +45,7 @@ sub new {
   }
 
   $self->{password} = $args{password} if $args{password};
+  $self->{on_connect} = $args{on_connect} if $args{on_connect};
 
   if ($args{sock}) {
     $self->{server} = $args{sock};
@@ -431,6 +432,8 @@ sub __build_sock {
     };
   }
 
+  $self->{on_connect}->($self) if exists $self->{on_connect};
+
   return;
 }
 
@@ -807,6 +810,7 @@ back without utf-8 flag turned on.
     my $r = Redis->new( sock => '/path/to/sock' );
     my $r = Redis->new( reconnect => 60, every => 5000 );
     my $r = Redis->new( password => 'boo' );
+    my $r = Redis->new( on_connect => sub { my ($redis) = @_; ... } );
 
 The C<< server >> parameter specifies the Redis server we should connect
 to, via TCP. Use the 'IP:PORT' format. If no C<< server >> option is
@@ -865,6 +869,11 @@ start or when reconnecting), the Redis C<< AUTH >> command will be send
 to the server. If the password is wrong, an exception will be thrown and
 reconnect will be disabled.
 
+You can also provide a code reference that will be immediatly after each
+sucessfull connection. The C<< on_connect >> attribute is used to
+provide the code reference, and it will be called with the first
+parameter being the Redis object.
+
 The C<< debug >> parameter enables debug information to STDERR,
 including all interactions with the server. You can also enable debug
 with the C<REDIS_DEBUG> environment variable.
diff --git a/t/06-on-connect.t b/t/06-on-connect.t
new file mode 100644
index 0000000..ddbeb98
--- /dev/null
+++ b/t/06-on-connect.t
@@ -0,0 +1,33 @@
+#!perl
+
+use warnings;
+use strict;
+use Test::More;
+use Test::Fatal;
+use Redis;
+use lib 't/tlib';
+use Test::SpawnRedisServer;
+
+my ($c, $srv) = redis(timeout => 1);
+END { $c->() if $c }
+
+subtest 'on_connect' => sub {
+  my $r;
+  ok($r = Redis->new(server => $srv, on_connect => sub { shift->incr('on_connect') }),
+    'connected to our test redis-server');
+  is($r->get('on_connect'), 1, '... on_connect code was run');
+
+  ok($r = Redis->new(server => $srv, on_connect => sub { shift->incr('on_connect') }),
+    'new connection is up and running');
+  is($r->get('on_connect'), 2, '... on_connect code was run again');
+
+  ok($r = Redis->new(reconnect => 1, server => $srv, on_connect => sub { shift->incr('on_connect') }),
+    'new connection with reconnect enabled');
+  is($r->get('on_connect'), 3, '... on_connect code one again perfect');
+
+  $r->quit;
+  is($r->get('on_connect'), 4, '... on_connect code works after reconnect also');
+};
+
+
+done_testing();