File Coverage

blib/lib/Message/Passing/DSL.pm
Criterion Covered Total %
statement 48 52 92.3
branch 5 10 50.0
condition 2 3 66.6
subroutine 13 14 92.8
pod 8 8 100.0
total 76 87 87.3


line stmt bran cond sub pod time code
1             package Message::Passing::DSL;
2 4     4   30111 use Message::Passing::DSL::Factory;
  4         16  
  4         206  
3 4     4   41 use Carp qw/ confess /;
  4         10  
  4         277  
4 4     4   22 use Scalar::Util qw/ blessed weaken /;
  4         9  
  4         247  
5 4     4   18149 use AnyEvent;
  4         27442  
  4         144  
6 4     4   38 use Exporter qw/ import /;
  4         9  
  4         3298  
7              
8             our @EXPORT = qw/
9             run_message_server message_chain input filter output decoder encoder error_log
10             /;
11              
12             our $FACTORY;
13             sub _check_factory {
14 14 50   14   68 confess("Not inside a message_chain { block!!") unless $FACTORY;
15             }
16              
17             sub message_chain (&) {
18 3     3 1 806 my $code = shift;
19 3 50       14 if ($FACTORY) {
20 0         0 confess("Cannot chain within a chain");
21             }
22 3         54 local $FACTORY = Message::Passing::DSL::Factory->new;
23 3         2482 $code->();
24 3         9 my %items = %{ $FACTORY->registry };
  3         64  
25 3         68 $FACTORY->clear_registry;
26 3 50       809 weaken($items{$_}) for
  13         146  
27             grep { blessed($items{$_}) && $items{$_}->can('consume') }
28             keys %items;
29 3         11 foreach my $name (keys %items) {
30 13 50       37 next if $items{$name};
31 0         0 warn "Unused output or filter $name in chain\n";
32             }
33             return [
34 9 50 66     103 grep { ! ( blessed($_) && $_->can('consume') ) }
  13         105  
35 3         10 grep { blessed($_) && $_->can('output_to') }
36             values %items
37             ];
38             }
39              
40             sub error_log {
41 1     1 1 3 my %opts = @_;
42 1         4 _check_factory();
43 1         5 $FACTORY->set_error(
44             %opts,
45             );
46             }
47              
48             sub input {
49 4     4 1 30 my ($name, %opts) = @_;
50 4         13 _check_factory();
51 4         33 $FACTORY->make(
52             %opts,
53             name => $name,
54             _type => 'Input',
55             );
56             }
57              
58             sub filter {
59 3     3 1 21 my ($name, %opts) = @_;
60 3         10 _check_factory();
61 3         16 $FACTORY->make(
62             %opts,
63             name => $name,
64             _type => 'Filter',
65             );
66             }
67              
68             sub output {
69 4     4 1 23 my ($name, %opts) = @_;
70 4         12 _check_factory();
71 4         26 $FACTORY->make(
72             %opts,
73             name => $name,
74             _type => 'Output',
75             );
76             }
77              
78             sub decoder {
79 1     1 1 5 my ($name, %opts) = @_;
80 1         5 _check_factory();
81 1         6 $FACTORY->make(
82             %opts,
83             name => $name,
84             _type => 'Filter::Decoder',
85             );
86             }
87              
88             sub encoder {
89 1     1 1 5 my ($name, %opts) = @_;
90 1         5 _check_factory();
91 1         5 $FACTORY->make(
92             %opts,
93             name => $name,
94             _type => 'Filter::Encoder',
95             );
96             }
97              
98             sub run_message_server {
99 0     0 1   my $chain = shift;
100 0           AnyEvent->condvar->recv;
101             }
102              
103             1;
104              
105             =head1 NAME
106              
107             Message::Passing::DSL - An easy way to make chains of Message::Passing components.
108              
109             =head1 SYNOPSIS
110              
111             package mylogcollectorscript;
112             use Moo;
113             use MooX::Options;
114             use Message::Passing::DSL;
115             use MooX::Types::MooseLike::Base qw/ Str /;
116             use namespace::clean -except => [qw( meta _options_data _options_config )];
117              
118             with 'Message::Passing::Role::Script';
119              
120             option socket_bind => (
121             is => 'ro',
122             isa => Str,
123             default => sub { 'tcp://*:5558' },
124             );
125              
126             sub build_chain {
127             my $self = shift;
128             message_chain {
129             output console => (
130             class => 'STDOUT',
131             );
132             input zmq => (
133             class => 'ZeroMQ',
134             output_to => 'console',
135             socket_bind => $self->socket_bind,
136             );
137             };
138             }
139              
140             __PACKAGE__->start unless caller;
141             1;
142              
143             =head1 DESCRIPTION
144              
145             This module provides a simple to use helper system for writing
146             scripts which implement a L server, like
147             the built in L script.
148              
149             Rather than having to pass instances of an output to each input in the
150             C attribute, and full class names, you can use short names
151             for component classes, and strings for the C attribute,
152             the DSL resolves these and deals with instance construction for you.
153              
154             See example in the SYNOPSIS, and details for the exported sugar
155             functions below.
156              
157             =head2 FUNCTIONS
158              
159             =head3 message_chain
160              
161             Constructs a message chain (i.e. a series of Message::Passing objects
162             feeding into each other), warns about any unused parts of the chain,
163             and returns an array ref to the heads of the chain (i.e. the input class(es)).
164              
165             Maintains a registry / factory for the log classes, which is used to
166             allow the resolving of symbolic names in the output_to key to function.
167              
168             =head3 output
169              
170             Constructs a named output within a chain.
171              
172             message_chain {
173             output foo => ( class => 'STDOUT' );
174             ....
175             };
176              
177             Class names will be assumed to prefixed with 'Message::Passing::Output::',
178             unless you prefix the class with + e.g. C<< +My::Own::Output::Class >>
179              
180             =head3 encoder
181              
182             Constructs a named encoder within a chain.
183              
184             message_chain {
185             encoder fooenc => ( output_to => 'out', class => 'JSON' );
186             ....
187             };
188              
189             Class names will be assumed to prefixed with 'Message::Passing::Filter::Encoder::',
190             unless you prefix the class with + e.g. C<< +My::Own::Encoder::Class >>
191              
192             =head3 filter
193              
194             Constructs a named filter (which can act as both an output and an input)
195             within a chain.
196              
197             message_chain {
198             ...
199             filter bar => ( output_to => 'fooenc', class => 'Null' );
200             ...
201             };
202              
203             Class names will be assumed to prefixed with 'Message::Passing::Filter::',
204             unless you prefix the class with + e.g. C<< +My::Own::Filter::Class >>
205              
206             =head3 decoder
207              
208             Constructs a named decoder within a chain.
209              
210             message_chain {
211             decoder zmq_decode => ( output_to => 'filter', class => 'JSON' );
212             ....
213             };
214              
215             Class names will be assumed to prefixed with 'Message::Passing::Filter::Decoder::',
216             unless you prefix the class with + e.g. C<< +My::Own::Encoder::Class >>
217              
218              
219             =head3 input
220              
221             The last thing in a chain - produces data which gets consumed.
222              
223             message_chain {
224             ...
225             input zmq => ( output_to => 'zmq_decode', class => 'ZeroMQ', bind => '...' );
226             ....
227             }
228              
229             Class names will be assumed to prefixed with 'Message::Passing::Output::',
230             unless you prefix the class with + e.g. C<< +My::Own::Output::Class >>
231              
232             =head3 error_log
233              
234             Setup the error logging output. Takes the same arguments as an C<< input xxx => () >> block, except without a name.
235              
236             =head3 run_message_server
237              
238             This enters the event loop and causes log events to be consumed and
239             processed.
240              
241             Can be passed a message_chain to run, although this is entirely optional
242             (as all chains which are still in scope will run when the event
243             loop is entered).
244              
245             =head1 SPONSORSHIP
246              
247             This module exists due to the wonderful people at Suretec Systems Ltd.
248             who sponsored its development for its
249             VoIP division called SureVoIP for use with
250             the SureVoIP API -
251            
252              
253             =head1 AUTHOR, COPYRIGHT AND LICENSE
254              
255             See L.
256              
257             =cut