[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 d4798b048a34e5e274b6e713fb2331146f61784e
Author: Tomas Doran <bobtfish at bobtfish.net>
Date:   Sun Jul 15 10:36:40 2012 +0100

    Fix lots of stuff so the script works again

diff --git a/lib/Message/Passing/DSL.pm b/lib/Message/Passing/DSL.pm
index eb17b64..9eb92d2 100644
--- a/lib/Message/Passing/DSL.pm
+++ b/lib/Message/Passing/DSL.pm
@@ -22,25 +22,24 @@ sub message_chain (&) {
     }
     local $FACTORY = Message::Passing::DSL::Factory->new;
     $code->();
-    my %items = $FACTORY->registry;
+    my %items = %{ $FACTORY->registry };
     $FACTORY->clear_registry;
-#    weaken($items{$_}) for
-#        grep { blessed($items{$_}) && $items{$_}->can('consume') }
-#        keys %items;
-#    foreach my $name (keys %items) {
-#        next if $items{$name};
-#        warn "Unused output or filter $name in chain\n";
-#    }
+    weaken($items{$_}) for
+        grep { blessed($items{$_}) && $items{$_}->can('consume') }
+        keys %items;
+    foreach my $name (keys %items) {
+        next if $items{$name};
+        warn "Unused output or filter $name in chain\n";
+    }
     return [
-#        grep { ! ( blessed($_) && $_->can('consume') ) }
-#        grep { blessed($_) && $_->can('output_to') }
+        grep { ! ( blessed($_) && $_->can('consume') ) }
+        grep { blessed($_) && $_->can('output_to') }
         values %items
     ];
 }
 
 sub error_log {
     my %opts = @_;
-    use Data::Dumper; warn Dumper(\%opts);
     _check_factory();
     $FACTORY->set_error(
         %opts,
diff --git a/lib/Message/Passing/Role/CLIComponent.pm b/lib/Message/Passing/Role/CLIComponent.pm
index 6baa87d..c8f00f1 100644
--- a/lib/Message/Passing/Role/CLIComponent.pm
+++ b/lib/Message/Passing/Role/CLIComponent.pm
@@ -5,6 +5,8 @@ use Package::Variant
     importing => ['Moo::Role'],
     subs => [ qw(has around before after with) ];
 use MooX::Types::MooseLike::Base qw/ Str /;
+use JSON ();
+use Try::Tiny qw/ try /;
 #use namespace::clean -except => 'CLIComponent';
 
 sub make_variant {
@@ -25,10 +27,17 @@ sub make_variant {
 
     has "${name}_options" => (
         is => 'ro',
-        #isa => Hash_from_JSON,
-        #traits    => ['Hash'],
         default => sub { {} },
-#        coerce => 1,
+        isa => sub { ref($_[0]) eq 'HASH' },
+        coerce => sub {
+            my $str = shift;
+            if (! ref $str) {
+                try {
+                    $str = JSON->new->relaxed->decode($str)
+                };
+            }
+            $str;
+        },
     );
 }
 
diff --git a/lib/Message/Passing/Types.pm b/lib/Message/Passing/Types.pm
index 3de85ca..771736b 100644
--- a/lib/Message/Passing/Types.pm
+++ b/lib/Message/Passing/Types.pm
@@ -1,52 +1,51 @@
 package Message::Passing::Types;
-use MooseX::Types ();
-use Moose::Util::TypeConstraints;
+use strict;
+use warnings;
+use MooX::Types::MooseLike::Base qw/ :all /;
+use Scalar::Util qw/ blessed /;
 use JSON ();
-use MooseX::Types::Moose qw/ Str HashRef ArrayRef /;
-use MooseX::Types::Common::String qw/ NonEmptySimpleStr /;
-use MooseX::Getopt;
-use Try::Tiny;
+use Try::Tiny qw/ try /;
+use Module::Runtime qw/ require_module /;
 use namespace::clean -except => 'meta';
 
-use MooseX::Types -declare => [qw{
-    Output_Type
-    Input_Type
-    Filter_Type
-    Codec_Type
-    Hash_from_JSON
-    JSON_from_Hash
-    ArrayOfStr
-}];
-
-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});
-        Class::MOP::load_class($class);
-        $class->new(%stuff);
-    };
-
-subtype Hash_from_JSON,
-    as HashRef;
-
-coerce Hash_from_JSON,
-  from NonEmptySimpleStr,
-  via { try { JSON->new->relaxed->decode($_) } };
-
-MooseX::Getopt::OptionTypeMap->add_option_type_to_map(
-    Hash_from_JSON, '=s'
-);
-
-subtype ArrayOfStr,
-    as ArrayRef[Str];
-
-coerce ArrayOfStr,
-    from Str,
-    via { [ $_ ] };
+use base qw(Exporter);
+our @EXPORT_OK = ();
+my $defs = [
+    {
+        name => 'Output_Type',
+        test => sub { blessed($_[0]) && $_[0]->can('consume') },
+        coerce => sub {
+            my $val = shift;
+            if (ref($val) eq 'HASH') {
+                my %stuff = %$val;
+                my $class = delete($stuff{class});
+                require_module($class);
+                $val = $class->new(%stuff);
+            }
+            $val;
+        },
+    },
+    {
+        name => 'Input_Type',
+        test => sub { blessed($_[0]) && $_[0]->can('output_to') },
+        message => sub { "$_[0] cannot ->output_to!" }
+    },
+    {
+        name => 'Filter_Type',
+        test => sub { blessed($_[0]) && $_[0]->can('output_to') && $_[0]->can('consume')},
+        message => sub { "$_[0] cannot ->output_to or cannot ->consume!" }
+    },
+    {
+        name => 'Hash_from_JSON',
+        test => sub { ref($_[0]) eq 'HASH' },
+        coerce => sub {
+            my $str = shift;
+            try {
+                JSON->new->relaxed->decode($str)
+            };
+        },
+    },
+];
+MooX::Types::MooseLike::register_types($defs, __PACKAGE__);
 
 1;
diff --git a/t/logstash_script.t b/t/logstash_script.t
index eb1c8c6..2526399 100644
--- a/t/logstash_script.t
+++ b/t/logstash_script.t
@@ -19,12 +19,16 @@ is_deeply $i->output_options, {"x" => "m"};
 my $chain = $i->build_chain;
 my $input = $chain->[0];
 my $decoder = $input->output_to;
+isa_ok $decoder, 'Message::Passing::Filter::Decoder::JSON';
 my $filter = $decoder->output_to;
+isa_ok $filter, 'Message::Passing::Filter::Null';
 my $encoder = $filter->output_to;
+isa_ok $encoder, 'Message::Passing::Filter::Encoder::JSON';
 my $output = $encoder->output_to;
+isa_ok $output, 'Message::Passing::Output::Test';
 $filter->consume({ foo => "bar" });
 
-is_deeply $output->messages, ['{"foo":"bar"}'];
+is_deeply [$output->messages], ['{"foo":"bar"}'];
 
 done_testing;
 

-- 
libmessage-passing-perl Debian packaging