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

Tomas Doran bobtfish at bobtfish.net
Mon May 6 11:56:42 UTC 2013


The following commit has been merged in the master branch:
commit cdd3ea656ea774878398c628b223536460c76207
Author: Tomas Doran <bobtfish at bobtfish.net>
Date:   Sun Mar 4 01:20:40 2012 +0000

    Simplify main script to use DSL

diff --git a/lib/Log/Stash.pm b/lib/Log/Stash.pm
index 8e55fd7..a997530 100644
--- a/lib/Log/Stash.pm
+++ b/lib/Log/Stash.pm
@@ -10,40 +10,24 @@ use Try::Tiny;
 use namespace::autoclean;
 use 5.8.4;
 
+use Log::Stash::DSL;
+
 with 'MooseX::Getopt';
 
 our $VERSION = '0.001';
 $VERSION = eval $VERSION;
 
 my %things = (
-    Input  => 1,
-    Filter => 0,
-    Output => 1,
+    input  => 1,
+    filter => 0,
+    output => 1,
 );
 
 foreach my $name (keys %things ) {
-    my $class = subtype LoadableClass, where { 1 };
-    coerce $class,
-        from NonEmptySimpleStr,
-        via {
-            to_LoadableClass(String::RewritePrefix->rewrite({
-                '' => 'Log::Stash::' . $name . '::',
-                '+' => ''
-            }, $_));
-        };
-
-    has lc($name) => (
-        isa => $class,
+    has $name => (
+        isa => 'Str',
         is => 'ro',
         required => $things{$name},
-        coerce => 1,
-    );
-
-    has lc($name) . '_instance' => (
-        is => 'ro',
-        lazy => 1,
-        does => "Log::Stash::Role::$name",
-        builder => '_build_' . lc($name) . '_instance',
     );
 }
 
@@ -51,25 +35,27 @@ has '+filter' => (
     default => 'Null',
 );
 
-sub _build_input_instance {
+sub build_chain {
     my $self = shift;
-    $self->input->new($self->input_options, output_to => $self->filter_instance);
-}
-
-sub _build_filter_instance {
-    my $self = shift;
-    $self->filter->new($self->filter_options, output_to => $self->output_instance);
-}
-
-sub _build_output_instance {
-    my $self = shift;
-    $self->output->new($self->output_options);
+        chain {
+            output out => (
+                $self->output_options,
+                class => $self->output,
+            );
+            filter fil => (
+                $self->filter_options,
+                class => $self->filter,
+                output_to => 'out',
+            );
+            input in => (
+                $self->input_options,
+                class => $self->input,
+                output_to => 'fil',
+            );
+        };
 }
 
-sub start {
-    my $self = shift;
-    $self->input_instance;
-}
+sub start { run __PACKAGE__->new_with_options->build_chain }
 
 my $json_type = subtype
   as "HashRef";
@@ -78,13 +64,13 @@ coerce $json_type,
   from NonEmptySimpleStr,
   via { try { JSON::XS->new->relaxed->decode($_) } };
 
-foreach my $name (map { lc($_) . "_options"  } keys %things) {
+foreach my $name (map { "${_}_options"  } keys %things) {
     has $name => (
         isa => $json_type,
         traits    => ['Hash'],
         default => sub { {} },
         handles => {
-            lc($name) => 'elements',
+            $name => 'elements',
         },
         coerce => 1,
     );
diff --git a/lib/Log/Stash/DSL.pm b/lib/Log/Stash/DSL.pm
index 01e866a..1207a47 100644
--- a/lib/Log/Stash/DSL.pm
+++ b/lib/Log/Stash/DSL.pm
@@ -17,30 +17,13 @@ sub _check_factory {
     confess("Not inside a chain { block!!") unless $FACTORY;
 }
 
-our ($self, $class) = ('', '');
 sub chain (&) {
     my $code = shift;
-    my ($caller, undef, undef) = caller();
-    if ($class ne $caller) {
-        $class = $caller;
-        if ($class->can('new_with_options')) {
-            $self = $class->new_with_options;
-        }
-        elsif ($class->can('new')) {
-            $self = $class->new;
-        }
-        else {
-            $self = $class;
-        }
-    }
     if ($FACTORY) {
         confess("Cannot chain witin a chain");
     }
-    if ($caller->can('new_with_options')) {
-        $caller->new_with_options;
-    }
     local $FACTORY = Log::Stash::DSL::Factory->new;
-    my $ret = $self->$code();
+    my $ret = $code->();
     my %items = $FACTORY->registry;
     $FACTORY->clear_registry;
     weaken($items{$_}) for keys %items;
@@ -82,7 +65,6 @@ sub output {
 }
 
 sub run {
-    undef $self;
     my $chain = shift;
     AnyEvent->condvar->recv;
 }
@@ -106,17 +88,22 @@ Log::Stash::DSL - An easy way to make chains of logstash objects.
         default => 'tcp://*:5558',
     );
 
-    run chain {
+    sub build_chain {
         my $self = shift;
-        output console => (
-            class => 'STDOUT',
-        );
-        input zmq => (
-            class => 'ZeroMQ',
-            output_to => 'console',
-            socket_bind => $self->socket_bind,
-        );
-    };
+        chain {
+            output console => (
+                class => 'STDOUT',
+            );
+            input zmq => (
+                class => 'ZeroMQ',
+                output_to => 'console',
+                socket_bind => $self->socket_bind,
+            );
+        };
+    }
+
+    sub start { run __PACKAGE__->new_with_options->build_chain }
+    __PACKAGE__->start unless caller;
 
 =head1 DESCRIPTION
 
diff --git a/script/logstash b/script/logstash
index b178da1..ad14211 100755
--- a/script/logstash
+++ b/script/logstash
@@ -3,11 +3,7 @@ use FindBin qw/ $Bin /;
 use lib "$Bin/../lib"; # FIXME
 use strict;
 use warnings;
-use AnyEvent;
 use Log::Stash;
 
-my $self = Log::Stash->new_with_options;
-$self->start;
-
-AnyEvent->condvar->recv;
+Log::Stash->start;
 
diff --git a/t/dsl.t b/t/dsl.t
index 371bf09..1da5c3a 100644
--- a/t/dsl.t
+++ b/t/dsl.t
@@ -4,21 +4,7 @@ use Test::More;
 
 use Log::Stash::DSL;
 
-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();
+my $c = chain {
         output test => (
             class => 'Test',
         );
@@ -30,8 +16,7 @@ my ($c, $ob);
             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';
@@ -40,8 +25,5 @@ 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;
 
diff --git a/t/logstash_script.t b/t/logstash_script.t
index 49102e6..e814f37 100644
--- a/t/logstash_script.t
+++ b/t/logstash_script.t
@@ -16,9 +16,10 @@ is_deeply {$i->input_options}, {"foo" => "bar"};
 is_deeply {$i->filter_options}, {"baz" => "quux"};
 is_deeply {$i->output_options}, {"x" => "m"};
 
-$i->filter_instance->consume({ foo => "bar" });
+my $chain = $i->build_chain;
+$chain->output_to->consume({ foo => "bar" });
 
-is_deeply [$i->output_instance->messages], [{ foo => "bar" }];
+is_deeply [$chain->output_to->output_to->messages], [{ foo => "bar" }];
 
 done_testing;
 

-- 
libmessage-passing-perl Debian packaging



More information about the Pkg-perl-cvs-commits mailing list