Sereal encoder

lib/Message/Passing/Filter/Decoder/Sereal.pm

@@ -0,0 +1,74 @@
+package Message::Passing::Filter::Decoder::Sereal;
+use Moo;
+use Sereal::Decoder;
+use Try::Tiny;
+use Message::Passing::Exception::Decoding;
+use namespace::clean -except => 'meta';
+
+with qw/
+    Message::Passing::Role::Filter
+    Message::Passing::Role::HasErrorChain
+/;
+
+has sereal_args => (
+    is => 'ro',
+    default => sub { {} },
+);
+
+has _sereal => (
+    is      => 'lazy',
+    handles => [ 'decode' ],
+    default => sub {
+        my $s = shift;
+        return Sereal::Decoder->new( $s->sereal_args );
+    },
+);
+
+sub filter {
+    my ($self, $message) = @_;
+    try {
+        $self->decode( $message )
+    }
+    catch {
+        $self->error->consume(Message::Passing::Exception::Decoding->new(
+            exception => $_,
+            packed_data => $message,
+        ));
+        return; # Explicit return undef
+    };
+}
+
+1;
+
+=head1 NAME
+
+Message::Passing::Role::Filter::Decoder::Sereal
+
+=head1 DESCRIPTION
+
+Decodes string messages from Sereal into data structures.
+
+=head1 ATTRIBUTES
+
+=head1 METHODS
+
+=head2 new( %args )
+
+Constructor. On top of the generic filter arguments, accepts an optional C<sereal_args>, 
+which will be used as the arguments for the constructor of the
+underlying L<Sereal::Decoder> object.
+
+=head2 filter( $message )
+
+Sereal-decodes the message supplied as a parameter.
+
+=head1 SEE ALSO
+
+=over
+
+=item L<Message::Passing>
+
+=item L<Message::Passing::Manual::Concepts>
+
+=back
+

lib/Message/Passing/Filter/Encoder/Sereal.pm

@@ -0,0 +1,91 @@
+package Message::Passing::Filter::Encoder::Sereal;
+use Moo;
+use Sereal::Encoder;
+use Scalar::Util qw/ blessed /;
+use Try::Tiny;
+use Message::Passing::Exception::Encoding;
+use namespace::clean -except => 'meta';
+
+with qw/
+    Message::Passing::Role::Filter
+    Message::Passing::Role::HasErrorChain
+/;
+
+has sereal_args => (
+    is => 'ro',
+    default => sub { {} },
+);
+
+has _sereal => (
+    is      => 'lazy',
+    handles => [ 'encode'  ],
+    default => sub {
+        my $self = shift;
+        return Sereal::Encoder->new( $self->sereal_args );
+    },
+);
+
+sub filter {
+    my ($self, $message) = @_;
+    try {
+        if (blessed $message) { # FIXME - This should be moved out of here!
+            if ($message->can('pack')) {
+                $message = $message->pack;
+            }
+            elsif ($message->can('to_hash')) {
+                $message = $message->to_hash;
+            }
+        }
+        $self->encode( $message );
+    }
+    catch {
+        $self->error->consume(Message::Passing::Exception::Encoding->new(
+            exception => $_,
+            stringified_data => $message,
+        ));
+        return; # Explicitly drop the message from normal processing
+    }
+}
+
+1;
+
+=head1 NAME
+
+Message::Passing::Role::Filter::Encoder::Sereal - Encodes data structures as Sereal for output
+
+=head1 DESCRIPTION
+
+This filter takes a hash ref or an object for a message, and serializes it to
+L<Sereal>.
+
+Plain refs work as expected, and classes providing either a 
+C<pack()> or C<to_hash()> method. This means that anything based on
+L<Log::Message::Structures> or L<MooseX::Storage> should be correctly
+serialized.
+
+=head1 METHODS
+
+=head2 new( %args )
+
+Constructor. On top of the generic filter arguments, accepts an optional C<sereal_args>, 
+which will be used as the arguments for the constructor of the
+underlying L<Sereal::Encoder> object.
+
+
+=head2 filter( $message )
+
+Performs the Serial encoding.
+
+
+=head1 SEE ALSO
+
+=over
+
+=item L<Message::Passing>
+
+=item L<Message::Passing::Manual::Concepts>
+
+=back
+
+=cut
+

t/sereal.t

@@ -0,0 +1,46 @@
+use strict;
+use warnings;
+use Test::More;
+use Try::Tiny;
+
+plan skip_all => "Sereal::Encoder or Sereal::Decoder not present"
+    unless eval <<'END';
+            use Sereal::Decoder;
+            use Sereal::Encoder;
+            1;
+END
+
+use Message::Passing::Filter::Decoder::Sereal;
+use Message::Passing::Filter::Encoder::Sereal;
+use Message::Passing::Output::Test;
+use Message::Passing::Input::Null;
+use Message::Passing::Output::Null;
+
+my $cbct = Message::Passing::Output::Test->new;
+my $cbc = Message::Passing::Input::Null->new(
+    output_to => Message::Passing::Filter::Encoder::Sereal->new(
+        output_to => Message::Passing::Filter::Decoder::Sereal->new(
+            output_to => $cbct,
+        ),
+    ),
+);
+
+# Simulate dropping a message!
+{
+    local $cbc->output_to->{output_to} = Message::Passing::Output::Null->new;
+    $cbc->output_to->consume({ foo => 'bar' });
+}
+
+is $cbct->message_count, 0;
+
+subtest structure => sub {
+    my $struct = { a => 'foo', b => [ 1,2,3] };
+    $cbc->output_to->consume( $struct );
+
+    is $cbct->message_count => 1, "message made it";
+    is_deeply( ($cbct->messages)[-1], $struct, "content is good" ); 
+};
+
+
+done_testing;
+