[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:57:23 UTC 2013


The following commit has been merged in the master branch:
commit 69025f25fc2423ee5c52ca32d87db03cac3a5e92
Author: Tomas Doran <bobtfish at bobtfish.net>
Date:   Sun Jul 8 13:31:57 2012 +0100

    Get shit almost working

diff --git a/lib/Message/Passing.pm b/lib/Message/Passing.pm
index 69ccc45..f671ff3 100644
--- a/lib/Message/Passing.pm
+++ b/lib/Message/Passing.pm
@@ -1,26 +1,49 @@
 package Message::Passing;
-use Moose;
+use Moo;
 use Getopt::Long qw(:config pass_through);
 use Config::Any;
 use Message::Passing::Role::CLIComponent;
 use Message::Passing::DSL;
-use namespace::clean -except => 'meta';
+use Carp qw/ confess /;
+use namespace::clean -except => [qw/ meta new_with_options has /];
 use 5.8.4;
 
+sub new_with_config {
+    my ($class, %args) = @_;
+
+    warn "NEW WITH CONFIG";
+
+    if (my $conf = $args{configfile}) {
+        warn "LOADING config file $conf";
+        my $cfg = $class->get_config_from_file($conf);
+        foreach my $k (keys %$cfg) {
+            if (!exists $args{$k}) {
+                $args{$k} = $cfg->{$k};
+            }
+        }
+    }
+    $class->new(%args);
+}
+
+use MooX::Options creation_chain_method => 'new_with_config';
+
 with
-    'MooseX::Getopt',
-    'MooseX::ConfigFromFile',
-    CLIComponent( name => 'input' ),
-    CLIComponent( name => 'output' ),
-    CLIComponent( name => 'filter', default => 'Null' ),
-    CLIComponent( name => 'decoder', default => 'JSON' ),
-    CLIComponent( name => 'encoder', default => 'JSON' ),
-    CLIComponent( name => 'error', default => 'STDERR' ),
+    CLIComponent( name => 'input', option => __PACKAGE__->can('option') ),
+    CLIComponent( name => 'output', option => __PACKAGE__->can('option') ),
+    CLIComponent( name => 'filter', default => 'Null', option => __PACKAGE__->can('option') ),
+    CLIComponent( name => 'decoder', default => 'JSON', option => __PACKAGE__->can('option') ),
+    CLIComponent( name => 'encoder', default => 'JSON', option => __PACKAGE__->can('option') ),
+    CLIComponent( name => 'error', default => 'STDERR', option => __PACKAGE__->can('option') ),
     'Message::Passing::Role::Script';
 
 our $VERSION = '0.009';
 $VERSION = eval $VERSION;
 
+option configfile => (
+    is => 'ro',
+    format => 's',
+);
+
 sub get_config_from_file {
     my ($class, $filename) = @_;
     my ($fn, $cfg) = %{ Config::Any->load_files({
@@ -34,30 +57,30 @@ sub build_chain {
     my $self = shift;
         message_chain {
             error_log(
-                $self->error_options,
+                %{ $self->error_options },
                 class => $self->error,
             );
             output output => (
-                $self->output_options,
+                %{ $self->output_options },
                 class => $self->output,
             );
             encoder("encoder",
-                $self->encoder_options,
+                %{ $self->encoder_options },
                 class => $self->encoder,
                 output_to => 'output',
             );
             filter filter => (
-                $self->filter_options,
+                %{ $self->filter_options },
                 class => $self->filter,
                 output_to => 'encoder',
             );
             decoder("decoder",
-                $self->decoder_options,
+                %{ $self->decoder_options },
                 class => $self->decoder,
                 output_to => 'filter',
             );
             input input => (
-                $self->input_options,
+                %{ $self->input_options },
                 class => $self->input,
                 output_to => 'decoder',
             );
diff --git a/lib/Message/Passing/DSL.pm b/lib/Message/Passing/DSL.pm
index 500a24a..eb17b64 100644
--- a/lib/Message/Passing/DSL.pm
+++ b/lib/Message/Passing/DSL.pm
@@ -1,7 +1,7 @@
 package Message::Passing::DSL;
 use Message::Passing::DSL::Factory;
 use Carp qw/ confess /;
-use Scalar::Util qw/weaken/;
+use Scalar::Util qw/ blessed weaken /;
 use AnyEvent;
 use Moose::Util qw/ does_role /;
 use Exporter qw/ import /;
@@ -24,22 +24,23 @@ sub message_chain (&) {
     $code->();
     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/DSL/Factory.pm b/lib/Message/Passing/DSL/Factory.pm
index d6f9339..db175e0 100644
--- a/lib/Message/Passing/DSL/Factory.pm
+++ b/lib/Message/Passing/DSL/Factory.pm
@@ -3,6 +3,8 @@ use Moo;
 use MooX::Types::MooseLike::Base qw/ HashRef /;
 use String::RewritePrefix;
 use Message::Passing::Output::STDERR;
+use Carp qw/ confess /;
+use Scalar::Util qw/ blessed /;
 use namespace::clean -except => 'meta';
 
 sub expand_class_name {
@@ -17,17 +19,17 @@ has registry => (
     is => 'ro',
     isa => HashRef,
     default => sub { {} },
-    traits => ['Hash'],
-    handles => {
-        registry_get => 'get',
-        registry_has => 'get',
-        registry_set => 'set',
-        registry => 'elements',
-    },
     lazy => 1,
     clearer => 'clear_registry',
 );
 
+sub registry_get { shift->registry->{shift()} }
+sub registry_has { exists shift->registry->{shift()} }
+sub registry_set {
+    my ($self, $name, $val) = @_;
+    $self->registry->{$name} = $val;
+}
+
 sub set_error {
     my ($self, %opts) = @_;
     my $class = delete $opts{class}
diff --git a/lib/Message/Passing/Role/CLIComponent.pm b/lib/Message/Passing/Role/CLIComponent.pm
index ef45c0b..6baa87d 100644
--- a/lib/Message/Passing/Role/CLIComponent.pm
+++ b/lib/Message/Passing/Role/CLIComponent.pm
@@ -15,12 +15,13 @@ sub make_variant {
     my $has_default = exists $arguments{default};
     my $default = $has_default ? $arguments{default} : undef;
 
-    has $name => (
-        isa => Str,
-        is => 'ro',
-        required => $has_default ? 0 : 1,
-        $has_default ? ( default => sub { $default } ) : (),
-    );
+    $arguments{'option'}->("$name" =>
+            format => 's',
+#            isa => Str,
+            is => 'ro',
+#            required => "$has_default" ? 0 : 1,
+            "$has_default" ? ( default => sub { "$default" } ) : (),
+        );
 
     has "${name}_options" => (
         is => 'ro',
@@ -48,7 +49,7 @@ Message::Passing::Role::CLIComponent - Role providing 'foo' and 'foo_options' at
             Message::Passing::Role::Script
             MooseX::Getopt
         /;
-    
+
     sub build_chain {
         my $self = shift;
         message_chain {
diff --git a/t/configfile.t b/t/configfile.t
index ebe8303..ca08644 100644
--- a/t/configfile.t
+++ b/t/configfile.t
@@ -30,7 +30,7 @@ my $i;
 ok $i;
 is $i->input, 'Null';
 is $i->output, 'Test';
-is_deeply {$i->input_options}, {
+is_deeply $i->input_options, {
         foo => 'bar',
     };
 
diff --git a/t/logstash_script.t b/t/logstash_script.t
index b5bea35..eb1c8c6 100644
--- a/t/logstash_script.t
+++ b/t/logstash_script.t
@@ -12,9 +12,9 @@ my $i = Message::Passing->new(
     output_options => '{"x":"m"}',
 );
 
-is_deeply {$i->input_options}, {"foo" => "bar"};
-is_deeply {$i->filter_options}, {"baz" => "quux"};
-is_deeply {$i->output_options}, {"x" => "m"};
+is_deeply $i->input_options, {"foo" => "bar"};
+is_deeply $i->filter_options, {"baz" => "quux"};
+is_deeply $i->output_options, {"x" => "m"};
 
 my $chain = $i->build_chain;
 my $input = $chain->[0];
@@ -24,7 +24,7 @@ my $encoder = $filter->output_to;
 my $output = $encoder->output_to;
 $filter->consume({ foo => "bar" });
 
-is_deeply [$output->messages], ['{"foo":"bar"}'];
+is_deeply $output->messages, ['{"foo":"bar"}'];
 
 done_testing;
 

-- 
libmessage-passing-perl Debian packaging



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