[SCM] libmessage-passing-perl Debian packaging branch, master, updated. debian/0.111-3-14-g44f6e88

[Tomas Doran]

The following commit has been merged in the master branch:
commit 8fde902cdb423c94390d1f515c7cebb72d4fb547
Author: Tomas Doran <bobtfish at bobtfish.net>
Date:   Tue Jun 5 20:48:26 2012 +0100

    Fix up the type constraints to be nucer

diff --git a/Makefile.PL b/Makefile.PL
index 6d1ba8e..dec6eb3 100644
--- a/Makefile.PL
+++ b/Makefile.PL
@@ -16,6 +16,7 @@ resources(
 requires 'Moose';
 requires 'namespace::autoclean';
 requires 'AnyEvent';
+requires 'MooseX::Types';
 requires 'MooseX::Types::Common';
 requires 'MooseX::Types::LoadableClass';
 requires 'String::RewritePrefix';
diff --git a/lib/Message/Passing/Role/CLIComponent.pm b/lib/Message/Passing/Role/CLIComponent.pm
index 1335f90..c78bb51 100644
--- a/lib/Message/Passing/Role/CLIComponent.pm
+++ b/lib/Message/Passing/Role/CLIComponent.pm
@@ -1,7 +1,9 @@
 package Message::Passing::Role::CLIComponent;
 use MooseX::Role::Parameterized;
 use Moose::Util::TypeConstraints;
-use Message::Passing::Types;
+use Message::Passing::Types qw/
+    Hash_from_JSON
+/;
 use namespace::autoclean;
 
 parameter name => (
@@ -29,7 +31,7 @@ role {
     );
 
     has "${name}_options" => (
-        isa => "Message::Passing::Types::FromJSON",
+        isa => Hash_from_JSON,
         traits    => ['Hash'],
         default => sub { {} },
         handles => {
diff --git a/lib/Message/Passing/Role/HasAConnection.pm b/lib/Message/Passing/Role/HasAConnection.pm
index fe64418..6b4111b 100644
--- a/lib/Message/Passing/Role/HasAConnection.pm
+++ b/lib/Message/Passing/Role/HasAConnection.pm
@@ -1,5 +1,6 @@
 package Message::Passing::Role::HasAConnection;
 use Moose::Role;
+use Moose::Util::TypeConstraints;
 use namespace::autoclean;
 
 requires '_build_connection_manager', 'connected';
@@ -7,7 +8,7 @@ requires '_build_connection_manager', 'connected';
 has connection_manager => (
     is => 'ro',
     lazy => 1,
-    #isa => ->can('subscribe_to_connect')
+    isa => duck_type([qw/subscribe_to_connect/]),
     builder => '_build_connection_manager',
 );
 
diff --git a/lib/Message/Passing/Role/Input.pm b/lib/Message/Passing/Role/Input.pm
index 0179ceb..191d4bf 100644
--- a/lib/Message/Passing/Role/Input.pm
+++ b/lib/Message/Passing/Role/Input.pm
@@ -1,13 +1,15 @@
 package Message::Passing::Role::Input;
 use Moose::Role;
 use JSON qw/ from_json /;
-use Message::Passing::Types;
+use Message::Passing::Types qw/
+    Output_Type
+/;
 use namespace::autoclean;
 
 sub decode { from_json( $_[1], { utf8  => 1 } ) }
 
 has output_to => (
-    isa => 'Message::Passing::Types::Output',
+    isa => Output_Type,
     is => 'ro',
     required => 1,
     coerce => 1,
diff --git a/lib/Message/Passing/Types.pm b/lib/Message/Passing/Types.pm
index 03f105c..dea5ff5 100644
--- a/lib/Message/Passing/Types.pm
+++ b/lib/Message/Passing/Types.pm
@@ -2,17 +2,27 @@ package Message::Passing::Types;
 use MooseX::Types ();
 use Moose::Util::TypeConstraints;
 use JSON ();
+use MooseX::Types::Moose qw/ Str HashRef /;
 use MooseX::Types::Common::String qw/ NonEmptySimpleStr /;
 use MooseX::Getopt;
 use Try::Tiny;
 use namespace::autoclean;
 
-role_type 'Message::Passing::Types::Input', { role => 'Message::Passing::Role::Input' };
-role_type 'Message::Passing::Types::Output', { role => 'Message::Passing::Role::Output' };
-role_type 'Message::Passing::Types::Filter', { role => 'Message::Passing::Role::Filter' };
+use MooseX::Types -declare => [qw{
+    Output_Type
+    Input_Type
+    Filter_Type
+    Codec_Type
+    Hash_from_JSON
+    JSON_from_Hash
+}];
 
-coerce 'Message::Passing::Types::Output',
-    from 'HashRef',
+role_type Input_Type, { role => 'Message::Passing::Role::Input' };
+role_type Output_Type, { role => 'Message::Passing::Role::Output' };
+role_type Filter_Type, { role => 'Message::Passing::Role::Filter' };
+
+coerce Output_Type,
+    from HashRef,
     via {
         my %stuff = %$_;
         my $class = delete($stuff{class});
@@ -20,15 +30,15 @@ coerce 'Message::Passing::Types::Output',
         $class->new(%stuff);
     };
 
-subtype 'Message::Passing::Types::FromJSON',
-    as "HashRef";
+subtype Hash_from_JSON,
+    as HashRef;
 
-coerce 'Message::Passing::Types::FromJSON',
+coerce Hash_from_JSON,
   from NonEmptySimpleStr,
   via { try { JSON->new->relaxed->decode($_) } };
 
 MooseX::Getopt::OptionTypeMap->add_option_type_to_map(
-    'Message::Passing::Types::FromJSON' => '=s'
+    Hash_from_JSON, '=s'
 );
 
 1;
diff --git a/t/00_compile.t b/t/00_compile.t
index 10de0ce..a4cf1ce 100644
--- a/t/00_compile.t
+++ b/t/00_compile.t
@@ -3,6 +3,7 @@ use warnings;
 
 use Test::More;
 
+use_ok("Message::Passing::Types") or BAIL_OUT("Types used everywhere!");
 use_ok('Message::Passing::Role::HasAConnection');
 use_ok('Message::Passing::Role::ConnectionManager');
 use_ok('Message::Passing');
diff --git a/t/role_connectionmanager.t b/t/role_connectionmanager.t
index 80acd46..73cd9d9 100644
--- a/t/role_connectionmanager.t
+++ b/t/role_connectionmanager.t
@@ -80,20 +80,24 @@ ok !$sub;
 # Test connectiomn timeout
 $i = My::Connection::Wrapper->new;
 my $cv = AnyEvent->condvar;
-my $t; $t = AnyEvent->timer(
-    after => 0.11,
-    cb => sub { $cv->send },
-);
+{
+    my $t; $t = AnyEvent->timer(
+        after => 0.11,
+        cb => sub { undef $t; $cv->send },
+    );
+}
 ok $i->{connection};
 $cv->recv;
 ok !$i->{connection};
 
 # Test reconnect
 $cv = AnyEvent->condvar;
-$t; $t = AnyEvent->timer(
-    after => 0.11,
-    cb => sub { $cv->send },
-);
+{
+    my $t; $t = AnyEvent->timer(
+        after => 0.11,
+        cb => sub { undef $t; $cv->send },
+    );
+}
 $cv->recv;
 $i->_set_connected(1);
 ok $i->{connection};
@@ -101,10 +105,12 @@ my ($c, $d) = (0,0);
 My::Connection::Wrapper->meta->add_before_method_modifier('_build_timeout_timer', sub { $c++ });
 My::Connection::Wrapper->meta->add_before_method_modifier('_build_reconnect_timer', sub { $d++ });
 $cv = AnyEvent->condvar;
-my $t; $t = AnyEvent->timer(
-    after => 0.5,
-    cb => sub { $cv->send },
-);
+{
+    my $t; $t = AnyEvent->timer(
+        after => 0.5,
+        cb => sub { undef $t; $cv->send },
+    );
+}
 $cv->recv;
 is $c, 0;
 is $d, 0;

-- 
libmessage-passing-perl Debian packaging