File Coverage

blib/lib/Message/Passing/Filter/Encoder/JSON.pm
Criterion Covered Total %
statement 31 31 100.0
branch 7 8 87.5
condition n/a
subroutine 10 10 100.0
pod 1 1 100.0
total 49 50 98.0


line stmt bran cond sub pod time code
1             package Message::Passing::Filter::Encoder::JSON;
2 6     6   4555 use Moo;
  6         10123  
  6         35  
3 6     6   3463 use MooX::Types::MooseLike::Base qw( Bool HasMethods );
  6         5677  
  6         436  
4 6     6   896 use JSON::MaybeXS qw ();
  6         5961  
  6         167  
5 6     6   35 use Scalar::Util qw/ blessed /;
  6         22  
  6         355  
6 6     6   684 use Try::Tiny;
  6         1229  
  6         421  
7 6     6   2905 use Message::Passing::Exception::Encoding;
  6         17  
  6         243  
8 6     6   50 use namespace::clean -except => 'meta';
  6         15  
  6         31  
9              
10             with qw/
11             Message::Passing::Role::Filter
12             Message::Passing::Role::HasErrorChain
13             /;
14              
15             has pretty => (
16             isa => Bool,
17             default => sub { 0 },
18             is => 'ro',
19             );
20              
21             has _json => (
22             is => 'lazy',
23             isa => HasMethods [qw( encode )],
24             default => sub {
25             my $self = shift;
26             return JSON::MaybeXS->new( utf8 => 1, pretty => $self->pretty );
27             },
28             );
29              
30             sub filter {
31 7     7 1 16 my ($self, $message) = @_;
32             try {
33 7 100   7   398 return $message unless ref($message);
34 6 100       31 if (blessed $message) { # FIXME - This should be moved out of here!
35 4 100       28 if ($message->can('pack')) {
    50          
36 3         13 $message = $message->pack;
37             }
38             elsif ($message->can('to_hash')) {
39 1         3 $message = $message->to_hash;
40             }
41             }
42 6         167 $self->_json->encode( $message );
43             }
44             catch {
45 1     1   156 $self->error->consume(Message::Passing::Exception::Encoding->new(
46             exception => $_,
47             stringified_data => $message,
48             ));
49 1         58 return; # Explicitly drop the message from normal processing
50             }
51 7         69 }
52              
53             1;
54              
55             =head1 NAME
56              
57             Message::Passing::Role::Filter::Encoder::JSON - Encodes data structures as JSON for output
58              
59             =head1 DESCRIPTION
60              
61             This filter takes a hash ref or an object for a message, and serializes it to JSON.
62              
63             Plain refs work as expected, and classes generated by either:
64              
65             =over
66              
67             =item Log::Message::Structures
68              
69             =item MooseX::Storage
70              
71             =back
72              
73             should be correctly serialized.
74              
75             =head1 METHODS
76              
77             =head2 filter
78              
79             Performs the JSON encoding.
80              
81             =head2 pretty
82              
83             Attribute controlling if JSON is pretty printed.
84              
85             =head1 SEE ALSO
86              
87             =over
88              
89             =item L<Message::Passing>
90              
91             =item L<Message::Passing::Manual::Concepts>
92              
93             =back
94              
95             =head1 SPONSORSHIP
96              
97             This module exists due to the wonderful people at Suretec Systems Ltd.
98             <http://www.suretecsystems.com/> who sponsored its development for its
99             VoIP division called SureVoIP <http://www.surevoip.co.uk/> for use with
100             the SureVoIP API -
101             <http://www.surevoip.co.uk/support/wiki/api_documentation>
102              
103             =head1 AUTHOR, COPYRIGHT AND LICENSE
104              
105             See L<Message::Passing>.
106              
107             =cut
108