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


The following commit has been merged in the master branch:
commit 561ccb07025e84302b0417f757d9562a20febdc7
Author: Tomas Doran <bobtfish at bobtfish.net>
Date:   Mon Jun 11 13:37:40 2012 -0400

    Add setting of error chain in script

diff --git a/lib/Message/Passing.pm b/lib/Message/Passing.pm
index 3fc6fe0..1a23f2a 100644
--- a/lib/Message/Passing.pm
+++ b/lib/Message/Passing.pm
@@ -15,6 +15,7 @@ with
     'Message::Passing::Role::CLIComponent' => { name => 'filter', default => 'Null' },
     'Message::Passing::Role::CLIComponent' => { name => 'decoder', default => 'JSON' },
     'Message::Passing::Role::CLIComponent' => { name => 'encoder', default => 'JSON' },
+    'Message::Passing::Role::CLIComponent' => { name => 'error', default => 'STDERR' },
     'Message::Passing::Role::Script';
 
 our $VERSION = '0.008';
@@ -32,6 +33,10 @@ sub get_config_from_file {
 sub build_chain {
     my $self = shift;
         message_chain {
+            error_log(
+                $self->error_options,
+                class => $self->error,
+            );
             output output => (
                 $self->output_options,
                 class => $self->output,
diff --git a/lib/Message/Passing/DSL.pm b/lib/Message/Passing/DSL.pm
index c56839c..f7b2d4f 100644
--- a/lib/Message/Passing/DSL.pm
+++ b/lib/Message/Passing/DSL.pm
@@ -9,7 +9,7 @@ use AnyEvent;
 use Moose::Util qw/ does_role /;
 
 Moose::Exporter->setup_import_methods(
-    as_is     => [qw/ run_message_server message_chain input filter output decoder encoder /],
+    as_is     => [qw/ run_message_server message_chain input filter output decoder encoder error_log /],
 );
 
 our $FACTORY;
@@ -40,6 +40,14 @@ sub message_chain (&) {
     ];
 }
 
+sub error_log {
+    my %opts = @_;
+    _check_factory();
+    $FACTORY->set_error(
+        %opts,
+    );
+}
+
 sub input {
      my ($name, %opts) = @_;
     _check_factory();
diff --git a/lib/Message/Passing/DSL/Factory.pm b/lib/Message/Passing/DSL/Factory.pm
index 5aefd46..309da4e 100644
--- a/lib/Message/Passing/DSL/Factory.pm
+++ b/lib/Message/Passing/DSL/Factory.pm
@@ -1,6 +1,7 @@
 package Message::Passing::DSL::Factory;
 use Moose;
 use String::RewritePrefix;
+use Message::Passing::Output::STDERR;
 use namespace::autoclean;
 
 sub expand_class_name {
@@ -25,6 +26,23 @@ has registry => (
     clearer => 'clear_registry',
 );
 
+sub set_error {
+    my ($self, %opts) = @_;
+    my $class = delete $opts{class}
+        || confess("Class name needed");
+    $class = $self->expand_class_name('Output', $class);
+    Class::MOP::load_class($class);
+    $self->_set_error($class->new(%opts));
+}
+
+has error => (
+    is => 'ro',
+    writer => '_set_error',
+    default => sub {
+        Message::Passing::Output::STDERR->new;
+    }
+);
+
 sub make {
     my ($self, %opts) = @_;
     my $class = delete $opts{class}
@@ -56,6 +74,9 @@ sub make {
             $opts{output_to} = $proper_output_to;
         }
     }
+    if (!exists($opts{error})) {
+        $opts{error} = $self->error;
+    }
     $class = $self->expand_class_name($type, $class);
     Class::MOP::load_class($class);
     my $out = $class->new(%opts);
diff --git a/t/00_compile.t b/t/00_compile.t
index ab389e8..c9e6d9c 100644
--- a/t/00_compile.t
+++ b/t/00_compile.t
@@ -25,6 +25,7 @@ use_ok('Message::Passing::Filter::Decoder::JSON');
 use_ok('Message::Passing::Filter::Decoder::Null');
 use_ok('Message::Passing::Role::HasHostnameAndPort');
 use_ok('Message::Passing::Role::HasUsernameAndPassword');
+use_ok('Message::Passing::Role::HasErrorChain');
 
 done_testing;
 

-- 
libmessage-passing-perl Debian packaging



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