[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 25701eec8b4f3ddc5f6078385386e4e445bce922
Author: Tomas Doran <bobtfish at bobtfish.net>
Date:   Sun Mar 4 00:51:16 2012 +0000

    DSL for defining your own

diff --git a/lib/Log/Stash/DSL.pm b/lib/Log/Stash/DSL.pm
index f7f4ad2..57d63a3 100644
--- a/lib/Log/Stash/DSL.pm
+++ b/lib/Log/Stash/DSL.pm
@@ -36,7 +36,6 @@ sub chain (&) {
     if ($FACTORY) {
         confess("Cannot chain witin a chain");
     }
-    my $self;
     if ($caller->can('new_with_options')) {
         $caller->new_with_options;
     }
@@ -92,5 +91,29 @@ sub run {
 
 =head1 NAME
 
-Log::Stash::DSL
+Log::Stash::DSL - An easy way to make chains of logstash objects.
+
+=head1 SYNOPSIS
+
+    use Log::Stash::DSL;
+
+    with 'MooseX::GetOpt';
+
+    has socket_bind => (
+        is => 'ro',
+        isa => 'Str',
+        default => 'tcp://*:5558',
+    );
+
+    run chain {
+        my $self = shift;
+        output console => (
+            class => 'STDOUT',
+        );
+        input zmq => (
+            class => 'ZeroMQ',
+            output_to => 'console',
+            socket_bind => $self->socket_bind,
+        );
+    };
 
diff --git a/lib/Log/Stash/DSL/Factory.pm b/lib/Log/Stash/DSL/Factory.pm
index 6a0d41b..aace223 100644
--- a/lib/Log/Stash/DSL/Factory.pm
+++ b/lib/Log/Stash/DSL/Factory.pm
@@ -34,10 +34,27 @@ sub make {
     confess("We already have a thing named $name")
         if $self->registry_has($name);
     my $output_to = $opts{output_to};
-    if ($output_to && !ref($output_to)) {
-        my $proper_output_to = $self->registry_get($output_to)
-            || confess("Do not have a component named '$output_to'");
-        $opts{output_to} = $proper_output_to;
+    if ($output_to && !blessed($output_to)) {
+        # We have to deal with the ARRAY case here for Filter::T
+        if (ref($output_to) eq 'ARRAY') {
+            my @out;
+            foreach my $name_or_thing (@$output_to) {
+                if (blessed($name_or_thing)) {
+                    push(@out, $name_or_thing);
+                }
+                else {
+                    my $thing = $self->registry_get($name)
+                        || confess("Do not have a component named '$name'");
+                    push(@out, $thing);
+                }
+            }
+            $opts{output_to} = \@out;
+        }
+        else {
+            my $proper_output_to = $self->registry_get($output_to)
+                || confess("Do not have a component named '$output_to'");
+            $opts{output_to} = $proper_output_to;
+        }
     }
     $class = $self->expand_class_name($type, $class);
     Class::MOP::load_class($class);
diff --git a/t/dsl.t b/t/dsl.t
index 884b978..371bf09 100644
--- a/t/dsl.t
+++ b/t/dsl.t
@@ -4,20 +4,34 @@ use Test::More;
 
 use Log::Stash::DSL;
 
-my $c = chain {
-    output test => (
-        class => 'Test',
-    );
-    filter null => (
-        class => 'Null',
-        output_to => 'test',
-    );
-    input stdin => (
-        class => 'STDIN',
-        output_to => 'null',
+my ($c, $ob);
+{
+    package Foo;
+    use Log::Stash::DSL;
+
+    with 'MooseX::Getopt';
+
+    local @ARGV = ('--foo', 'bar');
+    has foo => (
+        isa => 'Str',
+        is => 'ro',
     );
-};
 
+    $c = chain {
+        $ob = shift();
+        output test => (
+            class => 'Test',
+        );
+        filter null => (
+            class => 'Null',
+            output_to => 'test',
+        );
+        input stdin => (
+            class => 'STDIN',
+            output_to => 'null',
+        );
+    };
+}
 isa_ok $c, 'Log::Stash::Input::STDIN';
 isa_ok $c->output_to, 'Log::Stash::Filter::Null';
 isa_ok $c->output_to->output_to, 'Log::Stash::Output::Test';
@@ -26,5 +40,8 @@ my $test = $c->output_to->output_to;
 is $test->messages_count, 1;
 is_deeply [$test->messages], [{foo => 'bar'}];
 
+isa_ok $ob, 'Foo';
+is $ob->foo, 'bar';
+
 done_testing;
 

-- 
libmessage-passing-perl Debian packaging