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   12305 use Moo;
  6         21738  
  6         49  
3 6     6   5323 use MooX::Types::MooseLike::Base qw( Bool HasMethods );
  6         9406  
  6         816  
4 6     6   3926 use JSON::MaybeXS qw ();
  6         3979  
  6         155  
5 6     6   40 use Scalar::Util qw/ blessed /;
  6         10  
  6         355  
6 6     6   865 use Try::Tiny;
  6         1807  
  6         407  
7 6     6   3157 use Message::Passing::Exception::Encoding;
  6         62  
  6         307  
8 6     6   45 use namespace::clean -except => 'meta';
  6         9  
  6         42  
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 17 my ($self, $message) = @_;
32             try {
33 7 100   7   530 return $message unless ref($message);
34 6 100       45 if (blessed $message) { # FIXME - This should be moved out of here!
35 4 100       48 if ($message->can('pack')) {
    50          
36 3         18 $message = $message->pack;
37             }
38             elsif ($message->can('to_hash')) {
39 1         6 $message = $message->to_hash;
40             }
41             }
42 6         106 $self->_json->encode( $message );
43             }
44             catch {
45 1     1   193 $self->error->consume(Message::Passing::Exception::Encoding->new(
46             exception => $_,
47             stringified_data => $message,
48             ));
49 1         99 return; # Explicitly drop the message from normal processing
50             }
51 7         103 }
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
90              
91             =item L
92              
93             =back
94              
95             =head1 SPONSORSHIP
96              
97             This module exists due to the wonderful people at Suretec Systems Ltd.
98             who sponsored its development for its
99             VoIP division called SureVoIP for use with
100             the SureVoIP API -
101            
102              
103             =head1 AUTHOR, COPYRIGHT AND LICENSE
104              
105             See L.
106              
107             =cut
108