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   6927 use Moo;
  6         17441  
  6         41  
3 6     6   4223 use MooX::Types::MooseLike::Base qw( Bool HasMethods );
  6         11157  
  6         1356  
4 6     6   5704 use JSON::MaybeXS qw ();
  6         3929  
  6         130  
5 6     6   40 use Scalar::Util qw/ blessed /;
  6         12  
  6         293  
6 6     6   870 use Try::Tiny;
  6         1161  
  6         346  
7 6     6   4363 use Message::Passing::Exception::Encoding;
  6         48  
  6         208  
8 6     6   39 use namespace::clean -except => 'meta';
  6         10  
  6         36  
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 15 my ($self, $message) = @_;
32             try {
33 7 100   7   436 return $message unless ref($message);
34 6 100       38 if (blessed $message) { # FIXME - This should be moved out of here!
35 4 100       40 if ($message->can('pack')) {
    50          
36 3         14 $message = $message->pack;
37             }
38             elsif ($message->can('to_hash')) {
39 1         4 $message = $message->to_hash;
40             }
41             }
42 6         87 $self->_json->encode( $message );
43             }
44             catch {
45 1     1   129 $self->error->consume(Message::Passing::Exception::Encoding->new(
46             exception => $_,
47             stringified_data => $message,
48             ));
49 1         77 return; # Explicitly drop the message from normal processing
50             }
51 7         80 }
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