[libmessage-passing-perl] 01/11: Add Message::Passing::Filter::Mangle

[Jonas Smedegaard]

This is an automated email from the git hooks/post-receive script.

js pushed a commit to branch master
in repository libmessage-passing-perl.

commit da7704812940c600aaa99048328a99ed40814100
Author: Alexander Hartmaier <abraxxa at cpan.org>
Date:   Mon Jul 29 17:02:08 2013 +0200

    Add Message::Passing::Filter::Mangle
    
    for use with Message::Passing::DSL when you don't want to write a named filter
---
 Changes                              |    3 ++
 lib/Message/Passing/Filter/Mangle.pm |   52 +++++++++++++++++++++++
 t/filter_mangle.t                    |   78 ++++++++++++++++++++++++++++++++++
 3 files changed, 133 insertions(+)

diff --git a/Changes b/Changes
index f47e778..ebf71fb 100644
--- a/Changes
+++ b/Changes
@@ -1,3 +1,6 @@
+  - Add Message::Passing::Filter::Mangle for use with Message::Passing::DSL
+    when you don't want to write a named filter.
+
 0.112
   - Change to LGPL_2_1.
 
diff --git a/lib/Message/Passing/Filter/Mangle.pm b/lib/Message/Passing/Filter/Mangle.pm
new file mode 100644
index 0000000..4e92bd3
--- /dev/null
+++ b/lib/Message/Passing/Filter/Mangle.pm
@@ -0,0 +1,52 @@
+package Message::Passing::Filter::Mangle;
+use Moo;
+use MooX::Types::MooseLike::Base qw/ CodeRef /;
+use namespace::clean -except => 'meta';
+
+has filter_function => (
+    isa      => CodeRef,
+    is       => 'ro',
+    required => 1,
+    handles  => { 'filter' => '' },
+);
+
+with 'Message::Passing::Role::Filter';
+
+1;
+
+=head1 NAME
+
+Message::Passing::Filter::Mangle - Filter and/or mangle messages the way you
+want.
+
+=head1 DESCRIPTION
+
+This filter takes a sub which is called with the same arguments as
+L<Message::Passing::Role::Filter/filter>.
+
+It's intended for use with L<Message::Passing::DSL> when you don't want to write
+a named filter.
+
+=head1 ATTRIBUTES
+
+=head2 filter_function
+
+=head1 METHODS
+
+=head2 filter
+
+Calls filter_function passing on all received arguments.
+
+=head1 SPONSORSHIP
+
+This module exists due to the wonderful people at Suretec Systems Ltd.
+<http://www.suretecsystems.com/> who sponsored its development for its
+VoIP division called SureVoIP <http://www.surevoip.co.uk/> for use with
+the SureVoIP API - 
+<http://www.surevoip.co.uk/support/wiki/api_documentation>
+
+=head1 AUTHOR, COPYRIGHT AND LICENSE
+
+See L<Message::Passing>.
+
+=cut
diff --git a/t/filter_mangle.t b/t/filter_mangle.t
new file mode 100644
index 0000000..2fb5a7d
--- /dev/null
+++ b/t/filter_mangle.t
@@ -0,0 +1,78 @@
+use strict;
+use warnings;
+use Test::More;
+use Data::Dumper;
+
+use Message::Passing::Filter::Mangle;
+use Message::Passing::Output::Test;
+
+my @data = (
+    [   'Passthrough filter of scalar messages',
+        sub {
+            my ( $self, $message ) = @_;
+
+            return $message;
+        },
+        'test message',
+        'test message',
+    ],
+    [   'Passthrough filter of hashref message',
+        sub {
+            my ( $self, $message ) = @_;
+
+            return $message;
+        },
+        { message => 'test message' },
+        { message => 'test message' },
+    ],
+    [   'All filter of scalar messages',
+        sub {
+            return;
+        },
+        'test message',
+        undef,
+    ],
+    [   'All filter of hashref message',
+        sub {
+            return;
+        },
+        { message => 'test message' },
+        undef,
+    ],
+    [   'Mangle filter of scalar messages',
+        sub {
+            my ( $self, $message ) = @_;
+
+            return $message . ' from me';
+        },
+        'test message',
+        'test message from me',
+    ],
+    [   'Mangle filter of hashref message',
+        sub {
+            my ( $self, $message ) = @_;
+
+            $message->{from} = 'me';
+
+            return $message;
+        },
+        { message => 'test message' },
+        { message => 'test message', from => 'me' },
+    ],
+);
+
+foreach my $datum (@data) {
+    my ( $name, $filter_function, $input, $exp ) = @$datum;
+    my $out = Message::Passing::Output::Test->new;
+    my $in  = Message::Passing::Filter::Mangle->new(
+        filter_function => $filter_function,
+        output_to       => $out,
+    );
+    $in->consume($input);
+    my ($output) = $out->messages;
+    is_deeply $output, $exp, $name
+        or diag "Got " . Dumper($output) . " expected " . Dumper($exp);
+}
+
+done_testing;
+

-- 
Alioth's /usr/local/bin/git-commit-notice on /srv/git.debian.org/git/pkg-perl/packages/libmessage-passing-perl.git