Message-Passing-0.116/0000755000175000017500000000000012472656214014656 5ustar ahartmaiahartmaiMessage-Passing-0.116/META.yml0000644000175000017500000000206512472656164016136 0ustar ahartmaiahartmai--- abstract: 'a simple way of doing messaging.' author: - 'Tomas (t0m) Doran ' build_requires: ExtUtils::MakeMaker: 6.59 configure_requires: ExtUtils::MakeMaker: 6.59 distribution_type: module dynamic_config: 1 generated_by: 'Module::Install version 1.14' license: lgpl_2_1 meta-spec: url: http://module-build.sourceforge.net/META-spec-v1.4.html version: 1.4 module_name: Message::Passing name: Message-Passing no_index: directory: - inc - t recommends: Linux::IO_Prio: 0.03 requires: AnyEvent: 0 AnyEvent::Handle::UDP: 0 Config::Any: 0 DateTime: 0 IO::Handle: 0 JSON::MaybeXS: '1.002002' Module::Runtime: '0.013' Moo: '0.091011' MooX::Options: '3.71' MooX::Types::MooseLike: '0.08' Package::Variant: '1.001001' String::RewritePrefix: 0 Sys::Hostname::Long: 0 Task::Weaken: 0 Try::Tiny: 0 namespace::clean: '0.23' perl: 5.8.4 resources: license: http://opensource.org/licenses/lgpl-license.php repository: git://github.com/suretec/Message-Passing.git version: '0.116' x_authority: cpan:GHENRY Message-Passing-0.116/lib/0000755000175000017500000000000012472656214015424 5ustar ahartmaiahartmaiMessage-Passing-0.116/lib/Message/0000755000175000017500000000000012472656214017010 5ustar ahartmaiahartmaiMessage-Passing-0.116/lib/Message/Passing/0000755000175000017500000000000012472656214020414 5ustar ahartmaiahartmaiMessage-Passing-0.116/lib/Message/Passing/Exception.pm0000644000175000017500000000070412022141471022672 0ustar ahartmaiahartmaipackage Message::Passing::Exception; use Moo::Role; use namespace::clean -except => 'meta'; sub as_hash { return { %{ $_[0] }, class => ref($_[0]) } } sub pack { $_[0]->as_hash; } 1; =head1 NAME Message::Passing::Exception - Base role for Message::Passing exceptions =head1 METHODS =head2 as_hash =head2 pack Synonyms, which return a flattened (to a hash) object. =head1 AUTHOR, COPYRIGHT AND LICENSE See L. =cut Message-Passing-0.116/lib/Message/Passing/Manual.pod0000644000175000017500000000114412015112611022312 0ustar ahartmaiahartmai=head1 NAME Message::Passing::Manual - table of contents for Message::Passing documentation =head1 SEE ALSO Some links to documentation written so far: =over =item L How (and why) the message passing library works. =item L Practical examples of things you can do with the framework. =item L Writing your own inputs, filters and outputs. =item L Running jobs using the framework. =back =head1 AUTHOR, COPYRIGHT & LICENSE See L. =cut Message-Passing-0.116/lib/Message/Passing/Input/0000755000175000017500000000000012472656214021513 5ustar ahartmaiahartmaiMessage-Passing-0.116/lib/Message/Passing/Input/FileTail.pm0000644000175000017500000000665012216011633023533 0ustar ahartmaiahartmaipackage Message::Passing::Input::FileTail; use Moo; use MooX::Types::MooseLike::Base qw/ Str Int /; use AnyEvent; use Scalar::Util qw/ weaken /; use POSIX ":sys_wait_h"; use Sys::Hostname::Long; use AnyEvent::Handle; use namespace::clean -except => 'meta'; use constant HOSTNAME => hostname_long(); with 'Message::Passing::Role::Input'; has filename => ( is => 'ro', isa => Str, required => 1, ); has _tail_handle => ( is => 'ro', lazy => 1, builder => '_build_tail_handle', clearer => '_clear_tail_handle', ); has raw => ( is => 'ro', default => sub { 0 }, ); sub _emit_line { my ($self, $line) = @_; my $data = $self->raw ? $line : { filename => $self->filename, message => $line, hostname => HOSTNAME, epochtime => AnyEvent->now, type => 'log_line', }; $self->output_to->consume($data); } sub _build_tail_handle { my $self = shift; weaken($self); die("Cannot open filename '" . $self->filename . "'") unless -r $self->filename; my $child_pid = open(my $r, "-|", "tail", "-F", $self->filename) || die "can't fork: $!"; my $cv = AnyEvent->condvar; my $hdl; $hdl = AnyEvent::Handle->new( fh => $r, on_read => sub { my ($hdl) = @_; $hdl->push_read( line => sub { my ($hdl, $line, $eof) = @_; $self->_emit_line($line); } ); }, on_eof => sub { # must re-initialize the original handle to continue tailing. # the timer isn't necessary, but just to be a good citizen. my $t; $t = AnyEvent->timer( after => 1, cb => sub { $t = undef; $hdl = init_tailer( $r); }); }, #on_error => $_handle_error, ); } sub _init_tailer { my ($self, $fh) = @_; my $hdl; $hdl = AnyEvent::Handle->new( fh => $fh, on_read => sub { my ($hdl) = @_; $hdl->push_read( line => sub { my ($hdl, $line, $eof) = @_; $self->_emit_line($line); } ); }, on_eof => sub { # must re-initialize the original handle to continue tailing. # the timer isn't necessary, but just to be a good citizen. my $t; $t = AnyEvent->timer( after => 1, cb => sub { $t = undef; $self->_init_tailer($fh); }); }, ); } sub BUILD { my $self = shift; $self->_tail_handle; } 1; =head1 NAME Message::Passing::Input::FileTail - File tailing input =head1 SYNOPSIS message-pass --input FileTail --input_options '{"filename": "/var/log/foo.log"} --output STDOUT {"filename":"/var/log/foo.log","message":"example line","hostname":"www.example.com","epochtime":"1346705476","type":"log_line"} =head1 DESCRIPTION =head1 ATTRIBUTES =head2 filename The filename of the file to tail. =head2 raw If the file data should be output raw (as just a line). Normally lines are output as a hash of data including the fields showing in the SYNOPSIS. =head1 SEE ALSO L =head1 SPONSORSHIP This module exists due to the wonderful people at Suretec Systems Ltd. who sponsored its development for its VoIP division called SureVoIP for use with the SureVoIP API - =head1 AUTHOR, COPYRIGHT AND LICENSE See L. =cut Message-Passing-0.116/lib/Message/Passing/Input/Null.pm0000644000175000017500000000141512015115155022747 0ustar ahartmaiahartmaipackage Message::Passing::Input::Null; use Moo; use AnyEvent; use Try::Tiny; use namespace::clean -except => 'meta'; with 'Message::Passing::Role::Input'; 1; =head1 NAME Message::Passing::Input::Null - Null input =head1 SYNOPSIS message-pass --input Null --output STDOUT # Nothing ever happens.. =head1 DESCRIPTION Does nothing (for testing). =head1 SEE ALSO L =head1 SPONSORSHIP This module exists due to the wonderful people at Suretec Systems Ltd. who sponsored its development for its VoIP division called SureVoIP for use with the SureVoIP API - =head1 AUTHOR, COPYRIGHT AND LICENSE See L. =cutMessage-Passing-0.116/lib/Message/Passing/Input/STDIN.pm0000644000175000017500000000270412135535427022733 0ustar ahartmaiahartmaipackage Message::Passing::Input::STDIN; use Moo; use AnyEvent; use Try::Tiny; use Scalar::Util qw/ weaken /; use namespace::clean -except => 'meta'; use IO::Handle; with qw/ Message::Passing::Role::Input /; has reader => ( is => 'ro', lazy => 1, default => sub { my $self = shift; weaken($self); AnyEvent->io(fh => \*STDIN, poll => 'r', cb => sub { exit 0 if STDIN->eof; my $input = ; return unless defined $input; chomp($input); return unless length $input; $self->output_to->consume($input); }); }, ); sub BUILD { my $self = shift; $self->reader; } 1; =head1 NAME Message::Passing::Input::STDIN - STDIN input =head1 SYNOPSIS message-pass --input STDIN --output STDOUT {"foo": "bar"} {"foo":"bar"} =head1 DESCRIPTION An input which gets messages from STDIN. Messages are expected to be c<\n> separated, and if EOF is encountered then this input will call C to terminate the program. =head1 SEE ALSO L =head1 SPONSORSHIP This module exists due to the wonderful people at Suretec Systems Ltd. who sponsored its development for its VoIP division called SureVoIP for use with the SureVoIP API - =head1 AUTHOR, COPYRIGHT AND LICENSE See L. =cut Message-Passing-0.116/lib/Message/Passing/Input/Socket/0000755000175000017500000000000012472656214022743 5ustar ahartmaiahartmaiMessage-Passing-0.116/lib/Message/Passing/Input/Socket/UDP.pm0000644000175000017500000000356512175506234023736 0ustar ahartmaiahartmaipackage Message::Passing::Input::Socket::UDP; use Moo; use AnyEvent; use AnyEvent::Handle::UDP; use Scalar::Util qw/ weaken /; use namespace::clean -except => 'meta'; with qw/ Message::Passing::Role::Input Message::Passing::Role::HasHostnameAndPort Message::Passing::Role::HasErrorChain /; has '+hostname' => ( default => sub { 'localhost' }, ); has '+port' => ( required => 1, ); sub _default_port { die "You must supply a port #" } has handle => ( is => 'ro', builder => '_build_handle', lazy => 1, ); sub BUILD { my $self = shift; $self->handle; } sub _send_data { my ($self, $data, $from_addr) = @_; $self->output_to->consume($data); } sub _build_handle { my $self = shift; weaken($self); AnyEvent::Handle::UDP->new( bind => [ $self->hostname, $self->port ], on_recv => sub { my ($data, $h, $from_addr) = @_; # The output can optionally drop from addr. $self->_send_data($data, $from_addr); }, on_error => sub { my ($h, $fatal, $msg) = @_; $self->error->consume($msg); }, ); } 1; =head1 NAME Message::Passing::Input::Socket::UDP - UDP input =head1 DESCRIPTION An input which gets messages from a UDP network socket using L. =head1 ATTRIBUTES =head2 hostname The hostname L will bind to. =head2 port The port L will bind to. =head1 SEE ALSO L =head1 SPONSORSHIP This module exists due to the wonderful people at Suretec Systems Ltd. who sponsored its development for its VoIP division called SureVoIP for use with the SureVoIP API - =head1 AUTHOR, COPYRIGHT AND LICENSE See L. =cut Message-Passing-0.116/lib/Message/Passing/Exception/0000755000175000017500000000000012472656214022352 5ustar ahartmaiahartmaiMessage-Passing-0.116/lib/Message/Passing/Exception/Decoding.pm0000644000175000017500000000120612022141471024404 0ustar ahartmaiahartmaipackage Message::Passing::Exception::Decoding; use Moo; use Data::Dumper (); use MooX::Types::MooseLike::Base qw/ Str /; use namespace::clean -except => 'meta'; with 'Message::Passing::Exception'; has exception => ( is => 'ro', required => 1, isa => Str, ); has packed_data => ( is => 'ro', isa => Str, required => 1, ); 1; =head1 NAME Message::Passing::Exception::Decoding - An issue when decoding data =head1 ATTRIBUTES =head2 exception The exception encountered when trying to encode the message =head2 packed_data The original message. =head1 AUTHOR, COPYRIGHT AND LICENSE See L. =cut Message-Passing-0.116/lib/Message/Passing/Exception/ConnectionDisconnected.pm0000644000175000017500000000054412022141471027316 0ustar ahartmaiahartmaipackage Message::Passing::Exception::ConnectionDisconnected; use Moo; use Data::Dumper (); use namespace::clean -except => 'meta'; with 'Message::Passing::Exception'; 1; =head1 NAME Message::Passing::Exception::ConnectionDisconnected - A connection disconnected =head1 ATTRIBUTES =head1 AUTHOR, COPYRIGHT AND LICENSE See L. =cut Message-Passing-0.116/lib/Message/Passing/Exception/Encoding.pm0000644000175000017500000000131312022141471024415 0ustar ahartmaiahartmaipackage Message::Passing::Exception::Encoding; use Moo; use Data::Dumper (); use MooX::Types::MooseLike::Base qw/ Str /; use namespace::clean -except => 'meta'; with 'Message::Passing::Exception'; has exception => ( is => 'ro', required => 1, ); has stringified_data => ( is => 'ro', isa => Str, coerce => sub { Data::Dumper::Dumper($_[0]); }, ); 1; =head1 NAME Message::Passing::Exception::Encoding - An issue when encoding data =head1 ATTRIBUTES =head2 exception The exception encountered when trying to encode the message =head2 stringified_data The original message, dumped using L. =head1 AUTHOR, COPYRIGHT AND LICENSE See L. =cut Message-Passing-0.116/lib/Message/Passing/Exception/ConnectionTimeout.pm0000644000175000017500000000102412022141471026334 0ustar ahartmaiahartmaipackage Message::Passing::Exception::ConnectionTimeout; use Moo; use Data::Dumper (); use MooX::Types::MooseLike::Base qw/ Str Num /; use namespace::clean -except => 'meta'; with 'Message::Passing::Exception'; has after => ( isa => Num, is => 'ro', required => 1, ); 1; =head1 NAME Message::Passing::Exception::ConnectionTimeout - A connection timed out =head1 ATTRIBUTES =head2 after How long we waited before the connection was timed out. =head1 AUTHOR, COPYRIGHT AND LICENSE See L. =cut Message-Passing-0.116/lib/Message/Passing/DSL/0000755000175000017500000000000012472656214021036 5ustar ahartmaiahartmaiMessage-Passing-0.116/lib/Message/Passing/DSL/Factory.pm0000644000175000017500000000633712312317724023005 0ustar ahartmaiahartmaipackage Message::Passing::DSL::Factory; use Moo; use MooX::Types::MooseLike::Base qw/ HashRef /; use String::RewritePrefix; use Message::Passing::Output::STDERR; use Carp qw/ confess /; use Scalar::Util qw/ blessed /; use Module::Runtime qw/ require_module /; use namespace::clean -except => [qw/ meta _build_default_error_chain /]; sub expand_class_name { my ($self, $type, $name) = @_; String::RewritePrefix->rewrite({ '' => 'Message::Passing::' . $type . '::', '+' => '' }, $name); } has registry => ( is => 'ro', isa => HashRef, default => sub { {} }, lazy => 1, clearer => 'clear_registry', ); sub registry_get { shift->registry->{shift()} } sub registry_has { exists shift->registry->{shift()} } sub registry_set { my ($self, $name, $val) = @_; $self->registry->{$name} = $val; } sub set_error { my ($self, %opts) = @_; my $class = delete $opts{class} || confess("Class name needed"); require_module($class); $self->_set_error($class->new(%opts)); } use Message::Passing::Role::HasErrorChain; *_build_default_error_chain = \&Message::Passing::Role::HasErrorChain::_build_default_error_chain; has error => ( is => 'ro', writer => '_set_error', lazy => 1, builder => '_build_default_error_chain', ); sub make { my ($self, %opts) = @_; my $class = delete $opts{class} || confess("Class name needed"); my $name = delete $opts{name}; my $type = delete $opts{_type}; confess("We already have a thing named $name") if $self->registry_has($name); my $output_to = $opts{output_to}; if ($output_to && !blessed($output_to)) { # We have to deal with the ARRAY case here for Filter::T if (ref($output_to) eq 'ARRAY') { my @out; foreach my $name_or_thing (@$output_to) { if (blessed($name_or_thing)) { push(@out, $name_or_thing); } else { my $thing = $self->registry_get($name_or_thing) || confess("Do not have a component named '$name_or_thing'"); push(@out, $thing); } } $opts{output_to} = \@out; } else { my $proper_output_to = $self->registry_get($output_to) || confess("Do not have a component named '$output_to'"); $opts{output_to} = $proper_output_to; } } if (!exists($opts{error})) { $opts{error} = $self->error; } $class = $self->expand_class_name($type, $class); require_module($class); my $out = $class->new(%opts); $self->registry_set($name, $out); return $out; } 1; =head1 NAME Message::Passing::DSL::Factory - Build a set of chains using symbolic names =head1 DESCRIPTION No user serviceable parts inside. See L. =head1 SPONSORSHIP This module exists due to the wonderful people at Suretec Systems Ltd. who sponsored its development for its VoIP division called SureVoIP for use with the SureVoIP API - =head1 AUTHOR, COPYRIGHT AND LICENSE See L. =cut Message-Passing-0.116/lib/Message/Passing/Manual/0000755000175000017500000000000012472656214021631 5ustar ahartmaiahartmaiMessage-Passing-0.116/lib/Message/Passing/Manual/Workers.pod0000644000175000017500000000016412015112611023747 0ustar ahartmaiahartmai=head1 NAME Message::Passing::Manual::Workers =head1 AUTHOR, COPYRIGHT & LICENSE See L. =cut Message-Passing-0.116/lib/Message/Passing/Manual/Components.pod0000644000175000017500000001052712472647747024502 0ustar ahartmaiahartmai=head1 NAME Message::Passing::Manual::Components - Writing inputs, outputs and filters =head1 Writing your own scripts The supplied L script is useful for testing, and is also fine for production use in simple cases, however, for less simple cases (for example scripts with multiple inputs or outputs), then the default script isn't suitable. =head2 Like the message-pass script If you just want to override some of the behavior of the message-pass script, to provide different details etc, then this is easy to do by subclassing the script. An example of doing this is: package Message::Passing::Script::WebHooks; use Moo; use MooX::Options; use namespace::clean -except => 'meta'; extends 'Message::Passing'; option '+encoder' => ( init_arg => undef, default => '+Message::Passing::Filter::Encoder::Null', nogetopt => 1, ); option '+output' => ( nogetopt => 1, ); __PACKAGE__->start( output => 'WebHooks' ) unless caller; This shows overriding the default command line options, as this script is dedicated to L. =head2 Different scripts If you want a more complex example, rather than just overriding some of the functionality from the default script, then you're better off writing your own script. See L, for a basic role you are likely to want to use to do this. You'll also want to use L, as shown in the example documentation for the script role.. If you are writing your own script, want some components to be completely configurable (as per the default script), then see L, which implements attributes to help you do this in the same way as the normal script (i.e. C, and C). =head1 Writing Filters A filter is just a class which consumes both L and L. Simple filters can just consume L, and implement a C method. Please see the documentation for that Role for more information. More complex filters can compose the input and output roles themselves, and consume / emit messages as they choose. For a simple example of this type of filter, see L. =head2 Encoders and Decoders Encoders and Decoders are just implemented the same as standard filters. The only difference is the default namespace supplied by the DSL, which appends C or C to the standard filter prefix. =head1 Writing Inputs and Outputs The interface for both inputs and outputs is conceptually very simple, however there are some gotchas to watch out for which are described below. =head2 Use common attributes. Please try to keep the names of your component's attributes in keeping with the other inputs and outputs in the framework. To help with this, a number of simple roles with attributes you may want are included in the distribution: =over =item L =item L =back =head2 MUST by asynchronous. Your input or output B block in the course of it's normal operation. You should use L to make your input or output asynchronous. If you are trying to convert a synchronous module into being an input, then you can often make it 'asynchronous enough' by grabbing the file descriptor and setting up an IO watcher on it. L is an example of an input implemented like this. =head2 Connecting to a server. If your input or output connects to a server, you should be using the connection manager role supplied to manage this connection, rather than trying to manage it in your component directly. This is so that users can have multiple inputs and outputs which share the same connection, which is both possible and desirable with a number of protocols. Roles are provided to help component authors with this, please see the documentation in: =over =item L - for your component =item L - to implement your connection manager. =back For example code using these roles, see L, which implements a simple example. =head1 AUTHOR, COPYRIGHT & LICENSE See L. =cut Message-Passing-0.116/lib/Message/Passing/Manual/Cookbook.pod0000644000175000017500000000741212216011633024071 0ustar ahartmaiahartmai=head1 NAME Message::Passing::Manual::Cookbook - Common recipies =head1 Aggregating logs =head2 Logging from an application. You can use L, or any log system which will output into L. use Log::Dispatch; use Log::Dispatch::Message::Passing; use Message::Passing::Filter::Encoder::JSON; use Message::Passing::Output::ZeroMQ; my $log = Log::Dispatch->new; $log->add(Log::Dispatch::Message::Passing->new( name => 'myapp_aggregate_log', min_level => 'debug', output => Message::Passing::Filter::Encoder::JSON->new( output_to => Message::Passing::Output::ZeroMQ->new( connect => 'tcp://192.168.0.1:5558', ), ), )); $log->warn($_) for qw/ foo bar baz /; =head2 Aggregating this log As simple as using the command line interface: message-pass --input ZeroMQ --input_options '{"socket_bind":"tcp://192.168.0.1:5558"}' \ --output File --output_options '{"filename":"/tmp/mylog"}' And you've now got a multi-host log aggregation system for your application! =head2 Doing it manually You don't have to do any of the above, if you don't want to - you can easily reuse the ZeroMQ output yourself: my $log = Message::Passing::Output::ZeroMQ->new( connect => 'tcp://192.168.0.1:5558', linger => 1, # make sure message is sent (flushed) before thread dies ); $log->consume("A log message"); =head2 A note about outputs ZeroMQ is the recommended B for sending messages from within your application. This is because ZeroMQ uses a different (POSIX) thread to send messages - meaning that it transports messages independently to whatever your perl code is doing. This is B the case for other message outputs, and therefore they are unlikely to work well, or at all, unless your application is already asynchronous and using an L supported event library. =head2 A note about ZeroMQ By default L will use PUB/SUB sockets for logging, with a finite 'high water mark'. This means that if your application logs significantly more data than you can fit down the network, you B. If your application needs to do this, you can either increase this high water mark, or disable it (so ZeroMQ will buffer an infinite number of messages at the sending client - potentially using infinite RAM). The default setting is for the output to buffer up to 10000 messages on the output side, which should be enough to manage short term peaks, but is low enough to be reasonably safe in terms of memory consumption for buffering =head1 Aggregating syslog Assuming that you've got a regular syslogd setup and working, then you probably want to keep that. Having B the log files on individual hosts can be very useful. Also, we'd like to avoid the script being a privileged user (which would be needed to get the standard port). Therefore, we'll run a syslog listener on a high port (5140), and get the regular syslogd to ship messages to it. The listener will then forward from each host to a central aggregate logger (which is setup as above). =head2 On host collector message-pass --input Syslog --output ZeroMQ --output_options '{"connect":"tcp://192.168.0.1:5558"}' =head2 Configuring your syslogd This should be easy, here's an example of what to add to rsyslogd.conf to get the syslog resent. *.* =192.168.0.1:5140 =head1 Aggregating everything If you have hosts with both applications and syslog that you want to aggregate, then you can easily do both at once. This also means that your apps ship logs to a local buffer process rather than directly across the network - which is more resilient to short network outages. =head1 AUTHOR, COPYRIGHT & LICENSE See L. =cut Message-Passing-0.116/lib/Message/Passing/Manual/Concepts.pod0000644000175000017500000001007612216011633024101 0ustar ahartmaiahartmai=head1 NAME Message::Passing::Manual::Concepts - The concepts behind the framework =head1 DESCRIPTION This framework tries to be a simplifying layer over message passing, allowing you to easily make the networking parts of message passing become just configuration. This allows you to concentrate on the hard parts (i.e. your application, not the message passing). =head1 COMPONENTS AND CHAINS There are only a few core concepts to grasp to use the framework. We'll start with the component types, and then move onto chains. There are only three types of components: =head2 OUTPUTS An output is simply a class with a C method. This will be called with a message as it's only parameter, like this: $output->consume($message); Outputs are expected to compose L. =head2 INPUTS An input is simply a class with an C attribute. Your code just calls the consume method on it's output, like this: $self->output_to->consume($message); Inputs are expected to compose L which provides this attribute, and use the C method from L to do any work needed to start listening for events. =head2 FILTER A filter is just a combination of an output and input. Some (or all) of the messages consumed by the input are sent on to the output. An optional L is supplied, allowing you to provide a simple filter method: with 'Message::Passing::Role::Filter'; sub filter { my ($self, $message) = @_; return $message; # Or return undef to drop it } However, you can write a filter manually as: with qw/ Message::Passing::Role::Input Message::Passing::Role::Output /; sub consume { my ($self, $message) = @_; # Do something to $message here $self->output_to->consume($message); } As you've hopefully guessed now, a C is just an input, outputting to zero or more filters, which output to an output. =head1 DSL So, this is all pretty easy, and you already know enough to pick up some components and use them! For example: use Message::Passing::Input::FileTail; use Message::Passing::Output::STDOUT; Message::Passing::Input::FileTail->new( filename => $ARGV[0], output_to => Message::Passing::Output::STDOUT->new, ); AnyEvent->condvar->recv; # Enter event loop There you go - you're tailing a file to screen - however you could just as easily by sending it over the network with ZeroMQ or any other output. This is, however, a bit ugly! If you're building a chain of several filters, or you have several inputs being multiplexed into one output, then the code gets ugly fast. To make it easy to build chains of processing, and your own scripts, a simple DSL is provided. The example above becomes: use Message::Passing::DSL; run_message_server message_chain { input file => ( class => 'FileTail', output_to => 'stdout', ); output stdout => ( class => 'STDOUT', ); }; =head1 Event loop L has been mentioned, and it's expected that scripts will use a supported event loop. This implies that your code is asynchronous, which is generally fine - however it should be noted that doing any long operation (non trivial database queries) will block the entire server - meaning no events will be processed. In cases such as these, running a pool of worker processes to distribute the blocking jobs is more appropriate, and easy to wire up (on one or more hosts). This is documented more fully in L =head1 ZeroMQ L is the recommended transport for messages, and L is designed to work inside a traditional synchronous application. This means that you can emit messages into ZeroMQ without blocking your application, or having to use or run the AnyEvent event loop. =head1 SEE ALSO =head2 L Recipies for achieving common tasks =head1 AUTHOR, COPYRIGHT & LICENSE See L. =cut Message-Passing-0.116/lib/Message/Passing/Output/0000755000175000017500000000000012472656214021714 5ustar ahartmaiahartmaiMessage-Passing-0.116/lib/Message/Passing/Output/File.pm0000644000175000017500000000350412015115203023110 0ustar ahartmaiahartmaipackage Message::Passing::Output::File; use Moo; use MooX::Types::MooseLike::Base qw/ Str Bool /; use namespace::clean -except => 'meta'; with 'Message::Passing::Role::Output'; has filename => ( isa => Str, is => 'ro', predicate => '_has_filename', ); has fh => ( is => 'ro', lazy => 1, builder => '_build_fh', ); has append => ( is => 'ro', isa => Bool, default => sub { 1 }, ); sub _build_fh { my $self = shift; confess("Need a filename to output to") unless $self->_has_filename; my $mode = $self->append ? '>>' : '>'; open(my $fh, $mode, $self->filename) or confess("Could not open ". $self->filename . " for writing: $!"); $fh; } sub BUILD { my $self = shift; $self->fh; } sub consume { my $self = shift; my $saved = select($self->fh); local $|=1; print shift() . "\n"; select($saved); return 1; } 1; =head1 NAME Message::Passing::Output::File - File output =head1 SYNOPSIS message-pass --input STDIN --output File --output_options '{"filename": "/tmp/my.log"}' {"foo": "bar"} {"foo":"bar"} =head1 DESCRIPTION Output messages to File =head1 METHODS =head2 append A boolean attribute for if the output file should be re-created, or appended to. Default true. =head2 filename An attribute for the file name to write to. =head2 consume Consumes a message by JSON encoding it and printing it, followed by \n =head1 SEE ALSO L =head1 SPONSORSHIP This module exists due to the wonderful people at Suretec Systems Ltd. who sponsored its development for its VoIP division called SureVoIP for use with the SureVoIP API - =head1 AUTHOR, COPYRIGHT AND LICENSE See L. =cutMessage-Passing-0.116/lib/Message/Passing/Output/Null.pm0000644000175000017500000000157312015115210023145 0ustar ahartmaiahartmaipackage Message::Passing::Output::Null; use Moo; use namespace::clean -except => 'meta'; with 'Message::Passing::Role::Output'; sub consume {} 1; =head1 NAME Message::Passing::Output::Null - /dev/null for messages =head1 SYNOPSIS message-pass --input STDIN --output Null {"foo": "bar"} # Note noting is printed... =head1 DESCRIPTION Throws away all messages passed to it. =head1 METHODS =head2 consume Takes a message and discards it silently. =head1 SEE ALSO L =head1 SPONSORSHIP This module exists due to the wonderful people at Suretec Systems Ltd. who sponsored its development for its VoIP division called SureVoIP for use with the SureVoIP API - =head1 AUTHOR, COPYRIGHT AND LICENSE See L. =cutMessage-Passing-0.116/lib/Message/Passing/Output/Test.pm0000644000175000017500000000235612015115234023160 0ustar ahartmaiahartmaipackage Message::Passing::Output::Test; use Moo; use MooX::Types::MooseLike::Base qw/ ArrayRef /; use namespace::clean -except => 'meta'; extends 'Message::Passing::Output::Callback'; has '+cb' => ( default => sub { sub {} }, ); has _messages => ( is => 'ro', isa => ArrayRef, default => sub { [] }, clearer => 'clear_messages', lazy => 1, ); sub messages { @{ $_[0]->_messages } } sub consume_test { push(@{$_[0]->_messages }, $_[1]) } sub message_count { scalar @{ $_[0]->_messages } } after consume => sub { shift()->consume_test(@_); }; 1; =head1 NAME Message::Passing::Output::Test - Output for use in unit tests =head1 SYNOPSIS You only want this if you're writing tests... See the current tests for examples.. =head1 METHODS =head2 messages =head2 consume_test =head2 message_count =head1 SEE ALSO L =head1 SPONSORSHIP This module exists due to the wonderful people at Suretec Systems Ltd. who sponsored its development for its VoIP division called SureVoIP for use with the SureVoIP API - =head1 AUTHOR, COPYRIGHT AND LICENSE See L. =cutMessage-Passing-0.116/lib/Message/Passing/Output/STDERR.pm0000644000175000017500000000165412015115217023245 0ustar ahartmaiahartmaipackage Message::Passing::Output::STDERR; use Moo; use namespace::clean -except => 'meta'; with 'Message::Passing::Role::Output'; sub consume { my $self = shift; local $|=1; print STDERR shift() . "\n"; } 1; =head1 NAME Message::Passing::Output::STDOUT - STDOUT output =head1 SYNOPSIS message-pass --input STDIN --output STDERR {"foo": "bar"} {"foo":"bar"} =head1 DESCRIPTION Output messages to STDERR =head1 METHODS =head2 consume Consumes a message by printing it, followed by \n =head1 SEE ALSO L =head1 SPONSORSHIP This module exists due to the wonderful people at Suretec Systems Ltd. who sponsored its development for its VoIP division called SureVoIP for use with the SureVoIP API - =head1 AUTHOR, COPYRIGHT AND LICENSE See L. =cutMessage-Passing-0.116/lib/Message/Passing/Output/IO/0000755000175000017500000000000012472656214022223 5ustar ahartmaiahartmaiMessage-Passing-0.116/lib/Message/Passing/Output/IO/Handle.pm0000644000175000017500000000265612015115260023745 0ustar ahartmaiahartmaipackage Message::Passing::Output::IO::Handle; use Moo; #use Moose::Util::TypeConstraints; use namespace::clean -except => 'meta'; with 'Message::Passing::Role::Output'; has fh => ( # isa => duck_type([qw/ print /]), is => 'ro', required => 1, ); has append => ( is => 'ro', default => sub { "\n" }, ); sub consume { my $self = shift; $self->fh->print(shift() . $self->append); } 1; =head1 NAME Message::Passing::Output::IO::Handle - output to an IO handle =head1 SYNOPSIS my $out = Message::Passing::Output::IO::Handle->new( fh => \*STDOUT, append => "\n", ); # $out will now act like Message::Passing::Output::STDOUT =head1 DESCRIPTION Output messages to an L like handle, i.e. any class which implements a C<< ->print($stuff) >> method. =head1 ATTRIBUTES =head2 fh The file handle object. Required. =head2 append String to append to each message. Defaults to "\n" =head1 METHODS =head2 consume Consumes a message by printing it, followed by \n =head1 SEE ALSO L =head1 SPONSORSHIP This module exists due to the wonderful people at Suretec Systems Ltd. who sponsored its development for its VoIP division called SureVoIP for use with the SureVoIP API - =head1 AUTHOR, COPYRIGHT AND LICENSE See L. =cutMessage-Passing-0.116/lib/Message/Passing/Output/STDOUT.pm0000644000175000017500000000165412015115224023262 0ustar ahartmaiahartmaipackage Message::Passing::Output::STDOUT; use Moo; use namespace::clean -except => 'meta'; with 'Message::Passing::Role::Output'; sub consume { my $self = shift; local $|=1; print STDOUT shift() . "\n"; } 1; =head1 NAME Message::Passing::Output::STDOUT - STDOUT output =head1 SYNOPSIS message-pass --input STDIN --output STDOUT {"foo": "bar"} {"foo":"bar"} =head1 DESCRIPTION Output messages to STDOUT =head1 METHODS =head2 consume Consumes a message by printing it, followed by \n =head1 SEE ALSO L =head1 SPONSORSHIP This module exists due to the wonderful people at Suretec Systems Ltd. who sponsored its development for its VoIP division called SureVoIP for use with the SureVoIP API - =head1 AUTHOR, COPYRIGHT AND LICENSE See L. =cutMessage-Passing-0.116/lib/Message/Passing/Output/Socket/0000755000175000017500000000000012472656214023144 5ustar ahartmaiahartmaiMessage-Passing-0.116/lib/Message/Passing/Output/Socket/UDP.pm0000644000175000017500000000201712015115243024113 0ustar ahartmaiahartmaipackage Message::Passing::Output::Socket::UDP; use Moo; use IO::Socket::INET; use namespace::clean -except => 'meta'; with qw/ Message::Passing::Role::Output Message::Passing::Role::HasHostnameAndPort Message::Passing::Role::HasErrorChain /; has '+port' => ( required => 1, ); sub _default_port { die "You must supply a port #" } has handle => ( is => 'ro', builder => '_build_handle', lazy => 1, ); sub BUILD { my $self = shift; $self->handle; } sub _build_handle { my $self = shift; IO::Socket::INET->new( Proto => 'udp', PeerAddr => $self->hostname, PeerPort => $self->port, ) or die "Could not create UDP socket: $!\n"; } sub consume { my ($self, $msg) = @_; $self->handle->send($msg); } 1; =head1 NAME Message::Passing::Output::Socket::UDP =head1 DESCRIPTION Outputs messages to a UDP socket. =head1 METHODS =head2 consume Consumes a message by emitting it over UDP. =head1 AUTHOR, COPYRIGHT AND LICENSE See L. =cutMessage-Passing-0.116/lib/Message/Passing/Output/Callback.pm0000644000175000017500000000213012015115174023726 0ustar ahartmaiahartmaipackage Message::Passing::Output::Callback; use Moo; use MooX::Types::MooseLike::Base qw/ CodeRef /; use namespace::clean -except => 'meta'; has cb => ( isa => CodeRef, is => 'ro', ); sub consume { my ($self, $msg) = @_; $self->cb->($msg); } with 'Message::Passing::Role::Output'; 1; =head1 NAME Message::Passing::Output::Callback - Output to call back into your code =head1 SYNOPSIS Message::Passing::Output::Callback->new( cb => sub { my $message = shift; }, ); =head1 METHODS =head2 cb The callback to be called when a message is received. =head2 consume ($msg) Calls the callback with the message as it's first parameter =head1 SEE ALSO L =head1 SPONSORSHIP This module exists due to the wonderful people at Suretec Systems Ltd. who sponsored its development for its VoIP division called SureVoIP for use with the SureVoIP API - =head1 AUTHOR, COPYRIGHT AND LICENSE See L. =cutMessage-Passing-0.116/lib/Message/Passing/Filter/0000755000175000017500000000000012472656214021641 5ustar ahartmaiahartmaiMessage-Passing-0.116/lib/Message/Passing/Filter/ToLogstash.pm0000644000175000017500000000416612175504052024265 0ustar ahartmaiahartmaipackage Message::Passing::Filter::ToLogstash; use Moo; use MooX::Types::MooseLike::Base qw/ ArrayRef /; use List::MoreUtils qw/ uniq /; use DateTime; use Sys::Hostname::Long; use namespace::clean -except => 'meta'; use constant HOSTNAME => hostname_long(); with 'Message::Passing::Role::Filter'; has default_tags => ( is => 'ro', isa => ArrayRef, default => sub { [] }, ); has add_tags => ( is => 'ro', isa => ArrayRef, default => sub { [] }, ); my %map = ( '__CLASS__' => [ 'perl:Class:', 'type' ], hostname => 'source_host', message => 'message', filename => 'source_path', date => 'timestamp', type => 'type', ); sub filter { my ($self, $message) = @_; if ('HASH' ne ref($message)) { my $line = $message; $message = { message => $line, hostname => HOSTNAME, epochtime => AnyEvent->now, type => 'generic_line', }; } $message = { '@fields' => { %$message } }; if (exists($message->{'@fields'}{epochtime})) { $message->{'@timestamp'} = DateTime->from_epoch(epoch => delete($message->{'@fields'}{epochtime})) . '' } foreach my $k (keys %map) { my $v = $map{$k}; $v = [ '', $v ] if !ref $v; my ($prefix, $field) = @$v; $field = '@' . $field; if (exists($message->{'@fields'}{$k}) && !exists($message->{$field})) { $message->{$field} = $prefix . delete $message->{'@fields'}{$k}; } } $message->{'@tags'} ||= $self->default_tags; $message->{'@tags'} = [ uniq @{ $message->{'@tags'} }, @{ $self->add_tags } ]; $message; } 1; =head1 NAME Method::Passing::Filter::ToLogstash =head1 DESCRIPTION This filter changes the message format to comply with LogStash. Duplicate tags will be removed. =head1 ATTRIBUTES =head2 default_tags This is the list of tags which get added to the messages' @tags field in case none have been included already. =head2 add_tags This is the list of tags which get added to the messages' @tags field in all cases. =head1 METHODS =head2 filter Filter the message. Message-Passing-0.116/lib/Message/Passing/Filter/Encoder/0000755000175000017500000000000012472656214023220 5ustar ahartmaiahartmaiMessage-Passing-0.116/lib/Message/Passing/Filter/Encoder/Gzip.pm0000644000175000017500000000121412015114740024447 0ustar ahartmaiahartmaipackage Message::Passing::Filter::Encoder::Gzip; use Moo; use Compress::Zlib; use namespace::clean -except => 'meta'; with 'Message::Passing::Role::Filter'; sub filter { my ($self, $message) = @_; Compress::Zlib::memGzip($message); } 1; =head1 NAME Message::Passing::Filter::Encoder::Gzip - Compresses messages with Compress::Zlib =head1 SYNOPSIS message-pass --input STDIN --encoder Gzip \ --output ZeroMQ --output_options '...' =head1 DESCRIPTION Compresses messages with Compress::Zlib. =head1 METHODS =head2 filter Compresses the message =head1 SEE ALSO =over =item L =back =cutMessage-Passing-0.116/lib/Message/Passing/Filter/Encoder/Null.pm0000644000175000017500000000152712015114721024456 0ustar ahartmaiahartmaipackage Message::Passing::Filter::Encoder::Null; use Moo; use namespace::clean -except => 'meta'; extends 'Message::Passing::Filter::Null'; 1; =head1 NAME Message::Passing::Filter::Enccoder::Null =head1 DESCRIPTION Does no Encoding =head1 ATTRIBUTES =head1 METHODS =head2 filter Returns message it's passed, verbatim =head1 SEE ALSO =over =item L =item L =item L =back =head1 SPONSORSHIP This module exists due to the wonderful people at Suretec Systems Ltd. who sponsored its development for its VoIP division called SureVoIP for use with the SureVoIP API - =head1 AUTHOR, COPYRIGHT AND LICENSE See L. =cutMessage-Passing-0.116/lib/Message/Passing/Filter/Encoder/Crypt/0000755000175000017500000000000012472656214024321 5ustar ahartmaiahartmaiMessage-Passing-0.116/lib/Message/Passing/Filter/Encoder/Crypt/CBC.pm0000644000175000017500000000150012015115122025217 0ustar ahartmaiahartmaipackage Message::Passing::Filter::Encoder::Crypt::CBC; use Moo; use Compress::Zlib; use namespace::clean -except => 'meta'; with qw/ Message::Passing::Role::Filter Message::Passing::Role::Crypt::CBC /; sub filter { my ($self, $message) = @_; $self->cbc->encrypt($message); } 1; =head1 NAME Message::Passing::Encoder::Crypt::CBC - Use Crypt::CBC to encrypt messages =head1 SYNOPSIS message-pass --input STDIN --encoder Crypt::CBC \ --encoder_options '{}' \ --output ZeroMQ --output_options '...' =head1 DESCRIPTION Encrypts messages with Crypt::CBC. =head1 SEE ALSO =over =item L =item L =back =head1 METHODS =head2 filter Encrypts the message =head1 AUTHOR, COPYRIGHT & LICENSE See L. =cutMessage-Passing-0.116/lib/Message/Passing/Filter/Encoder/Bzip2.pm0000644000175000017500000000131012015114745024526 0ustar ahartmaiahartmaipackage Message::Passing::Filter::Encoder::Bzip2; use Moo; use Compress::Bzip2; use namespace::clean -except => 'meta'; with 'Message::Passing::Role::Filter'; sub filter { my ($self, $message) = @_; Compress::Bzip2::memBzip($message); } 1; =head1 NAME Message::Passing::Encoder::Bzip2 - Use Compress:Bzip2 to encrypt messages =head1 SYNOPSIS message-pass --input STDIN --encoder Bzip2 \ --output ZeroMQ --output_options '...' =head1 DESCRIPTION Compresses messages with Compress::Bzip2. =head1 METHODS =head2 filter Compresses the message =head1 SEE ALSO =over =item L =back =head1 AUTHOR, COPYRIGHT & LICENSE See L. =cutMessage-Passing-0.116/lib/Message/Passing/Filter/Encoder/JSON.pm0000644000175000017500000000442712375127525024336 0ustar ahartmaiahartmaipackage Message::Passing::Filter::Encoder::JSON; use Moo; use MooX::Types::MooseLike::Base qw( Bool HasMethods ); use JSON::MaybeXS qw (); 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 pretty => ( isa => Bool, default => sub { 0 }, is => 'ro', ); has _json => ( is => 'lazy', isa => HasMethods [qw( encode )], default => sub { my $self = shift; return JSON::MaybeXS->new( utf8 => 1, pretty => $self->pretty ); }, ); sub filter { my ($self, $message) = @_; try { return $message unless ref($message); 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->_json->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::JSON - Encodes data structures as JSON for output =head1 DESCRIPTION This filter takes a hash ref or an object for a message, and serializes it to JSON. Plain refs work as expected, and classes generated by either: =over =item Log::Message::Structures =item MooseX::Storage =back should be correctly serialized. =head1 METHODS =head2 filter Performs the JSON encoding. =head2 pretty Attribute controlling if JSON is pretty printed. =head1 SEE ALSO =over =item L =item L =back =head1 SPONSORSHIP This module exists due to the wonderful people at Suretec Systems Ltd. who sponsored its development for its VoIP division called SureVoIP for use with the SureVoIP API - =head1 AUTHOR, COPYRIGHT AND LICENSE See L. =cut Message-Passing-0.116/lib/Message/Passing/Filter/Null.pm0000644000175000017500000000154512015115761023104 0ustar ahartmaiahartmaipackage Message::Passing::Filter::Null; use Moo; use namespace::clean -except => 'meta'; with 'Message::Passing::Role::Filter'; sub filter { $_[1] } 1; =head1 NAME Message::Passing::Filter::Null - Filter no messages out. =head1 DESCRIPTION This filter does nothing, passing all incoming messages through with no changes. You would normally never want to use this, but it can be useful for testing occasionally. =head1 METHODS =head2 filter Returns the message passed to it. =head1 SPONSORSHIP This module exists due to the wonderful people at Suretec Systems Ltd. who sponsored its development for its VoIP division called SureVoIP for use with the SureVoIP API - =head1 AUTHOR, COPYRIGHT AND LICENSE See L. =cutMessage-Passing-0.116/lib/Message/Passing/Filter/Mangle.pm0000644000175000017500000000230512175505042023372 0ustar ahartmaiahartmaipackage Message::Passing::Filter::Mangle; use Moo; use MooX::Types::MooseLike::Base qw/ CodeRef /; use namespace::clean -except => 'meta'; with 'Message::Passing::Role::Filter'; has filter_function => ( isa => CodeRef, is => 'ro', required => 1, ); sub filter { my $self = shift; return $self->filter_function->(@_); } 1; =head1 NAME Message::Passing::Filter::Mangle - Filter and/or mangle messages the way you want. =head1 DESCRIPTION This filter takes a sub which is called with the same arguments as L minus $self. It's intended for use with L when you don't want to write a named filter. =head1 ATTRIBUTES =head2 filter_function =head1 METHODS =head2 filter Calls filter_function passing on all received arguments but $self. =head1 SPONSORSHIP This module exists due to the wonderful people at Suretec Systems Ltd. who sponsored its development for its VoIP division called SureVoIP for use with the SureVoIP API - =head1 AUTHOR, COPYRIGHT AND LICENSE See L. =cut Message-Passing-0.116/lib/Message/Passing/Filter/Delay.pm0000644000175000017500000000305712015114611023221 0ustar ahartmaiahartmaipackage Message::Passing::Filter::Delay; use Moo; use MooX::Types::MooseLike::Base qw( :all ); use AnyEvent; use Scalar::Util qw/ weaken /; use namespace::clean -except => 'meta'; with qw/ Message::Passing::Role::Input Message::Passing::Role::Output /; has delay_for => ( isa => Num, is => 'ro', required => 1, ); sub consume { my ($self, $message) = @_; weaken($self); my $t; $t = AnyEvent->timer( after => $self->delay_for, cb => sub { undef $t; $self->output_to->consume($message); }, ); } 1; =head1 NAME Message::Passing::Filter::Delay - Delay messages for some time. =head1 DESCRIPTION This filter passes all incoming messages through with no changes, however not immediately - they are delayed . You would normally never want to use this, but it can be useful for testing occasionally, or avoiding race conditions. =head1 ATTRIBUTES =head2 delay_for Floating point number, indicating how many seconds to delay messages for. =head1 METHODS =head2 consume ($msg) Sets up a timed callback in the event loop, which passes the message to the output (and deletes itself) once the timeout has expired =head1 SPONSORSHIP This module exists due to the wonderful people at Suretec Systems Ltd. who sponsored its development for its VoIP division called SureVoIP for use with the SureVoIP API - =head1 AUTHOR, COPYRIGHT AND LICENSE See L. =cutMessage-Passing-0.116/lib/Message/Passing/Filter/Decoder/0000755000175000017500000000000012472656214023206 5ustar ahartmaiahartmaiMessage-Passing-0.116/lib/Message/Passing/Filter/Decoder/Gzip.pm0000644000175000017500000000122412015114555024442 0ustar ahartmaiahartmaipackage Message::Passing::Filter::Decoder::Gzip; use Moo; use Compress::Zlib; use namespace::clean -except => 'meta'; with 'Message::Passing::Role::Filter'; sub filter { my ($self, $message) = @_; Compress::Zlib::memGunzip($message); } 1; =head1 NAME Message::Passing::Filter::Decoder::Gzip - Decompresses messages with Compress::Zlib =head1 SYNOPSIS message-pass --input STDIN --decoder Gzip \ --output ZeroMQ --output_options '...' =head1 DESCRIPTION Decompresses messages with Compress::Zlib. =head1 METHODS =head2 filter Decompresses the message =head1 SEE ALSO =over =item L =back =cutMessage-Passing-0.116/lib/Message/Passing/Filter/Decoder/Null.pm0000644000175000017500000000152712015114533024445 0ustar ahartmaiahartmaipackage Message::Passing::Filter::Decoder::Null; use Moo; use namespace::clean -except => 'meta'; extends 'Message::Passing::Filter::Null'; 1; =head1 NAME Message::Passing::Filter::Deccoder::Null =head1 DESCRIPTION Does no Decoding =head1 ATTRIBUTES =head1 METHODS =head2 filter Returns message it's passed, verbatim =head1 SEE ALSO =over =item L =item L =item L =back =head1 SPONSORSHIP This module exists due to the wonderful people at Suretec Systems Ltd. who sponsored its development for its VoIP division called SureVoIP for use with the SureVoIP API - =head1 AUTHOR, COPYRIGHT AND LICENSE See L. =cutMessage-Passing-0.116/lib/Message/Passing/Filter/Decoder/Crypt/0000755000175000017500000000000012472656214024307 5ustar ahartmaiahartmaiMessage-Passing-0.116/lib/Message/Passing/Filter/Decoder/Crypt/CBC.pm0000644000175000017500000000150012015114710025207 0ustar ahartmaiahartmaipackage Message::Passing::Filter::Decoder::Crypt::CBC; use Moo; use Compress::Zlib; use namespace::clean -except => 'meta'; with qw/ Message::Passing::Role::Filter Message::Passing::Role::Crypt::CBC /; sub filter { my ($self, $message) = @_; $self->cbc->decrypt($message); } 1; =head1 NAME Message::Passing::Decoder::Crypt::CBC - Use Crypt::CBC to decrypt messages =head1 SYNOPSIS message-pass --input STDIN --decoder Crypt::CBC \ --decoder_options '{}' \ --output ZeroMQ --output_options '...' =head1 DESCRIPTION Decrypts messages with Crypt::CBC. =head1 SEE ALSO =over =item L =item L =back =head1 METHODS =head2 filter Decrypts the message =head1 AUTHOR, COPYRIGHT & LICENSE See L. =cutMessage-Passing-0.116/lib/Message/Passing/Filter/Decoder/Bzip2.pm0000644000175000017500000000131612015114564024521 0ustar ahartmaiahartmaipackage Message::Passing::Filter::Decoder::Bzip2; use Moo; use Compress::Bzip2; use namespace::clean -except => 'meta'; with 'Message::Passing::Role::Filter'; sub filter { my ($self, $message) = @_; Compress::Bzip2::memBunzip($message); } 1; =head1 NAME Message::Passing::Decoder::Bzip2 - Use Compress:Bzip2 to encrypt messages =head1 SYNOPSIS message-pass --input STDIN --decoder Bzip2 \ --output ZeroMQ --output_options '...' =head1 DESCRIPTION Uncompresses messages with Compress::Bzip2. =head1 METHODS =head2 filter Uncompresses the message =head1 SEE ALSO =over =item L =back =head1 AUTHOR, COPYRIGHT & LICENSE See L. =cutMessage-Passing-0.116/lib/Message/Passing/Filter/Decoder/JSON.pm0000644000175000017500000000247712375125670024326 0ustar ahartmaiahartmaipackage Message::Passing::Filter::Decoder::JSON; use Moo; use JSON::MaybeXS qw( decode_json ); use Try::Tiny; use Message::Passing::Exception::Decoding; use namespace::clean -except => 'meta'; with qw/ Message::Passing::Role::Filter Message::Passing::Role::HasErrorChain /; sub filter { my ($self, $message) = @_; try { ref($message) ? $message : decode_json( $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::JSON =head1 DESCRIPTION Decodes string messages from JSON into data structures. =head1 ATTRIBUTES =head1 METHODS =head2 filter JSON decodes a message supplied as a parameter. =head1 SEE ALSO =over =item L =item L =back =head1 SPONSORSHIP This module exists due to the wonderful people at Suretec Systems Ltd. who sponsored its development for its VoIP division called SureVoIP for use with the SureVoIP API - =head1 AUTHOR, COPYRIGHT AND LICENSE See L. =cut Message-Passing-0.116/lib/Message/Passing/Filter/Key.pm0000644000175000017500000000413412015114622022712 0ustar ahartmaiahartmaipackage Message::Passing::Filter::Key; use Moo; use MooX::Types::MooseLike::Base qw/ Str /; use namespace::clean -except => 'meta'; with 'Message::Passing::Role::Filter'; has key => ( isa => Str, is => 'ro', required => 1, ); has match => ( isa => Str, is => 'ro', required => 1, ); has match_type => ( is => 'ro', # isa => enum(['regex', 'eq']), default => sub { 'eq' }, ); has _re => ( is => 'ro', lazy => 1, default => sub { my $self = shift; my $match = $self->match; if ($self->match_type eq 'regex') { return qr/$match/; } else { return qr/^\Q$match\E$/; } }, ); sub filter { my ($self, $message) = @_; my $re = $self->_re; my @key_parts = split /\./, $self->key; my $m = $message; do { my $part = shift(@key_parts); $m = (ref($m) eq 'HASH' && exists($m->{$part})) ? $m->{$part} : undef; } while ($m && scalar(@key_parts)); return unless $m && !ref($m) && $m =~ /$re/; return $message; } 1; =head1 NAME Message::Passing::Filter::Key - Filter a subset of messages out. =head1 DESCRIPTION This filter just removes messages which do not have a key matching a certain value. =head1 ATTRIBUTES =head2 key The name of the key. You may use a C< foo.bar > syntax to indicate variables below the top level of the hash (i.e. the example would look in C<< $msg->{foo}->{bar} >>.). =head2 match The value to match to determine if the message should be passed onto the next stage or filtered out. =head2 match_type The type of match to perform, valid values are 'regex' or 'eq', and the latter is the default. =head1 METHODS =head2 filter Does the actual filtering work. =head1 SPONSORSHIP This module exists due to the wonderful people at Suretec Systems Ltd. who sponsored its development for its VoIP division called SureVoIP for use with the SureVoIP API - =head1 AUTHOR, COPYRIGHT AND LICENSE See L. =cutMessage-Passing-0.116/lib/Message/Passing/Filter/All.pm0000644000175000017500000000152112015114576022677 0ustar ahartmaiahartmaipackage Message::Passing::Filter::All; use Moo; use namespace::clean -except => 'meta'; with 'Message::Passing::Role::Filter'; sub filter { return; } 1; =head1 NAME Message::Passing::Filter::All - Filter all messages out. =head1 DESCRIPTION This filter just removes all messages, not passing any through. You would normally never want to use this, but it can be useful for testing occasionally. =head1 METHODS =head2 filter Universally returns undef =head1 SPONSORSHIP This module exists due to the wonderful people at Suretec Systems Ltd. who sponsored its development for its VoIP division called SureVoIP for use with the SureVoIP API - =head1 AUTHOR, COPYRIGHT AND LICENSE See L. =cutMessage-Passing-0.116/lib/Message/Passing/Filter/T.pm0000644000175000017500000000262512015114676022401 0ustar ahartmaiahartmaipackage Message::Passing::Filter::T; use Moo; use MooX::Types::MooseLike::Base qw/ ArrayRef /; use namespace::clean -except => 'meta'; with 'Message::Passing::Role::Input'; with 'Message::Passing::Role::Output'; has '+output_to' => ( # isa => ArrayRef[role_type('Message::Passing::Role::Output')], is => 'ro', required => 1, ); sub consume { my ($self, $message) = @_; foreach my $output_to (@{ $self->output_to }) { $output_to->consume($message); } } 1; =head1 NAME Message::Passing::Filter::T - Send a message stream to multiple outputs. =head1 DESCRIPTION This filter is used to duplicate a message stream to two or more outputs. All messages are duplicated to all output streams, so you may want to follow this with L to one or more of those streams. =head1 ATTRIBUTES =head2 output_to Just like a normal L class, except takes an array of outputs. =head1 METHODS =head2 consume Sends the consumed message to all output_to instances. =head1 SPONSORSHIP This module exists due to the wonderful people at Suretec Systems Ltd. who sponsored its development for its VoIP division called SureVoIP for use with the SureVoIP API - =head1 AUTHOR, COPYRIGHT AND LICENSE See L. =cutMessage-Passing-0.116/lib/Message/Passing/DSL.pm0000644000175000017500000001431412312317712021365 0ustar ahartmaiahartmaipackage Message::Passing::DSL; use Message::Passing::DSL::Factory; use Carp qw/ confess /; use Scalar::Util qw/ blessed weaken /; use AnyEvent; use Exporter qw/ import /; our @EXPORT = qw/ run_message_server message_chain input filter output decoder encoder error_log /; our $FACTORY; sub _check_factory { confess("Not inside a message_chain { block!!") unless $FACTORY; } sub message_chain (&) { my $code = shift; if ($FACTORY) { confess("Cannot chain within a chain"); } local $FACTORY = Message::Passing::DSL::Factory->new; $code->(); my %items = %{ $FACTORY->registry }; $FACTORY->clear_registry; weaken($items{$_}) for grep { blessed($items{$_}) && $items{$_}->can('consume') } keys %items; foreach my $name (keys %items) { next if $items{$name}; warn "Unused output or filter $name in chain\n"; } return [ grep { ! ( blessed($_) && $_->can('consume') ) } grep { blessed($_) && $_->can('output_to') } values %items ]; } sub error_log { my %opts = @_; _check_factory(); $FACTORY->set_error( %opts, ); } sub input { my ($name, %opts) = @_; _check_factory(); $FACTORY->make( %opts, name => $name, _type => 'Input', ); } sub filter { my ($name, %opts) = @_; _check_factory(); $FACTORY->make( %opts, name => $name, _type => 'Filter', ); } sub output { my ($name, %opts) = @_; _check_factory(); $FACTORY->make( %opts, name => $name, _type => 'Output', ); } sub decoder { my ($name, %opts) = @_; _check_factory(); $FACTORY->make( %opts, name => $name, _type => 'Filter::Decoder', ); } sub encoder { my ($name, %opts) = @_; _check_factory(); $FACTORY->make( %opts, name => $name, _type => 'Filter::Encoder', ); } sub run_message_server { my $chain = shift; AnyEvent->condvar->recv; } 1; =head1 NAME Message::Passing::DSL - An easy way to make chains of Message::Passing components. =head1 SYNOPSIS package mylogcollectorscript; use Moo; use MooX::Options; use Message::Passing::DSL; use MooX::Types::MooseLike::Base qw/ Str /; use namespace::clean -except => [qw( meta _options_data _options_config )]; with 'Message::Passing::Role::Script'; option socket_bind => ( is => 'ro', isa => Str, default => sub { 'tcp://*:5558' }, ); sub build_chain { my $self = shift; message_chain { output console => ( class => 'STDOUT', ); input zmq => ( class => 'ZeroMQ', output_to => 'console', socket_bind => $self->socket_bind, ); }; } __PACKAGE__->start unless caller; 1; =head1 DESCRIPTION This module provides a simple to use helper system for writing scripts which implement a L server, like the built in L script. Rather than having to pass instances of an output to each input in the C attribute, and full class names, you can use short names for component classes, and strings for the C attribute, the DSL resolves these and deals with instance construction for you. See example in the SYNOPSIS, and details for the exported sugar functions below. =head2 FUNCTIONS =head3 message_chain Constructs a message chain (i.e. a series of Message::Passing objects feeding into each other), warns about any unused parts of the chain, and returns an array ref to the heads of the chain (i.e. the input class(es)). Maintains a registry / factory for the log classes, which is used to allow the resolving of symbolic names in the output_to key to function. =head3 output Constructs a named output within a chain. message_chain { output foo => ( class => 'STDOUT' ); .... }; Class names will be assumed to prefixed with 'Message::Passing::Output::', unless you prefix the class with + e.g. C<< +My::Own::Output::Class >> =head3 encoder Constructs a named encoder within a chain. message_chain { encoder fooenc => ( output_to => 'out', class => 'JSON' ); .... }; Class names will be assumed to prefixed with 'Message::Passing::Filter::Encoder::', unless you prefix the class with + e.g. C<< +My::Own::Encoder::Class >> =head3 filter Constructs a named filter (which can act as both an output and an input) within a chain. message_chain { ... filter bar => ( output_to => 'fooenc', class => 'Null' ); ... }; Class names will be assumed to prefixed with 'Message::Passing::Filter::', unless you prefix the class with + e.g. C<< +My::Own::Filter::Class >> =head3 decoder Constructs a named decoder within a chain. message_chain { decoder zmq_decode => ( output_to => 'filter', class => 'JSON' ); .... }; Class names will be assumed to prefixed with 'Message::Passing::Filter::Decoder::', unless you prefix the class with + e.g. C<< +My::Own::Encoder::Class >> =head3 input The last thing in a chain - produces data which gets consumed. message_chain { ... input zmq => ( output_to => 'zmq_decode', class => 'ZeroMQ', bind => '...' ); .... } Class names will be assumed to prefixed with 'Message::Passing::Output::', unless you prefix the class with + e.g. C<< +My::Own::Output::Class >> =head3 error_log Setup the error logging output. Takes the same arguments as an C<< input xxx => () >> block, except without a name. =head3 run_message_server This enters the event loop and causes log events to be consumed and processed. Can be passed a message_chain to run, although this is entirely optional (as all chains which are still in scope will run when the event loop is entered). =head1 SPONSORSHIP This module exists due to the wonderful people at Suretec Systems Ltd. who sponsored its development for its VoIP division called SureVoIP for use with the SureVoIP API - =head1 AUTHOR, COPYRIGHT AND LICENSE See L. =cut Message-Passing-0.116/lib/Message/Passing/Role/0000755000175000017500000000000012472656214021315 5ustar ahartmaiahartmaiMessage-Passing-0.116/lib/Message/Passing/Role/HasAConnection.pm0000644000175000017500000000520712015115321024471 0ustar ahartmaiahartmaipackage Message::Passing::Role::HasAConnection; use Moo::Role; use Module::Runtime qw/ require_module /; use Carp qw/ confess /; use namespace::clean -except => 'meta'; with qw/ Message::Passing::Role::HasTimeoutAndReconnectAfter Message::Passing::Role::HasErrorChain /; # requires qw/ _connection_manager_attributes _connection_manager_class /; requires 'connected'; has connection_manager => ( is => 'ro', lazy => 1, # isa => duck_type([qw/subscribe_to_connect/]), builder => '_build_connection_manager', ); sub _build_connection_manager { my $self = shift; confess "Cannot auto-build this connection manager" unless $self->can('_connection_manager_attributes') && $self->can('_connection_manager_class'); my %attrs = map { $_ => $self->$_ } (@{ $self->_connection_manager_attributes }, qw/timeout reconnect_after error/); my $class = $self->_connection_manager_class; require_module($class); $class->new(%attrs); } sub BUILD {} after BUILD => sub { my $self = shift; $self->connection_manager->subscribe_to_connect($self); }; 1; =head1 NAME Message::Passing::Role::HasAConnection - Role for components which have a connection =head1 DESCRIPTION Provides a standard ->connection_manager attribute for inputs or outputs which need to make a network connection before they can send or receive messages. The connection manager object is assumed to have the C<< ->subscribe_to_connect >> method (from L). =head1 REQUIRED METHODS =head2 _build_connection_manager Will be called at BUILD (i.e. object construction) time, should return a connection manager object (i.e. an object that C<< ->subscribe_to_connect >> can be called on). =head2 connected ($client) Called by the connection manager when a connection is made. Usually used to do things like subscribe to queues.. =head1 OPTIONAL METHODS =head2 disconnected ($client) The client received an error or otherwise disconnected. =head1 ATTRIBUTES =head2 connection_manager Holds the connection manger returned by the C<_build_connection_manager> method. =head1 WRAPPED METHODS =head2 BUILD Is wrapped to build the connection manager object. =head1 SEE ALSO =over =item L. =back =head1 SPONSORSHIP This module exists due to the wonderful people at Suretec Systems Ltd. who sponsored its development for its VoIP division called SureVoIP for use with the SureVoIP API - =head1 AUTHOR, COPYRIGHT AND LICENSE See L. =cutMessage-Passing-0.116/lib/Message/Passing/Role/Filter.pm0000644000175000017500000000361412015115312023062 0ustar ahartmaiahartmaipackage Message::Passing::Role::Filter; use Moo::Role; use namespace::clean -except => 'meta'; requires 'filter'; with qw/ Message::Passing::Role::Input Message::Passing::Role::Output /; sub consume { my ($self, $message) = @_; my $new = $self->filter($message); return unless $new; $self->output_to->consume($new); } 1; =head1 NAME Message::Passing::Role::Filter - Simple abstraction for filtering messages =head1 SYNOPSIS package My::Filter; use Moo; use namespace::clean -except => 'meta'; with 'Message::Passing::Role::Filter'; sub filter { my ($self, $message) = @_; # Do something with $message return $message; # Or return undef to halt message! } 1; =head1 DESCRIPTION Both a producer and a consumer of messages, able to filter out messages based upon their contents, or permute the structure of messages. =head1 REQUIRED METHODS =head2 filter Called to filter the message. Returns the mangled message. Note if you return undef then the message is not propagated further up the chain, which may be used for filtering out unwanted messages. =head1 REQUIRED ATTRIBUTES =head2 output_to From L. =head1 METHODS =head2 consume Consumers a message, calling the filter method provided by the user with the message. In the case where the filter returns a message, outputs the message to the next step in the chain. =head1 SEE ALSO =over =item L =item L =back =head1 SPONSORSHIP This module exists due to the wonderful people at Suretec Systems Ltd. who sponsored its development for its VoIP division called SureVoIP for use with the SureVoIP API - =head1 AUTHOR, COPYRIGHT AND LICENSE See L. =cutMessage-Passing-0.116/lib/Message/Passing/Role/HasUsernameAndPassword.pm0000644000175000017500000000143412015115353026221 0ustar ahartmaiahartmaipackage Message::Passing::Role::HasUsernameAndPassword; use Moo::Role; use MooX::Types::MooseLike::Base qw/ Str /; use namespace::clean -except => 'meta'; foreach my $name (qw/ username password /) { has $name => ( is => 'ro', isa => Str, required => 1, ); } 1; =head1 NAME Message::Passing::Role::HasUsernameAndPassword - common username and password attributes =head1 SYNOPSIS package Message::Passing::Output::MyOutput; use Moo; use namespace::clean -except => 'meta'; with 'Message::Passing::Role::HasUsernameAndPassword'; =head1 METHODS =head2 username The username for a connection. Required, Str. =head2 password The password for a connection. Required, Str. =head1 AUTHOR, COPYRIGHT AND LICENSE See L. =cutMessage-Passing-0.116/lib/Message/Passing/Role/Input.pm0000644000175000017500000000231612015115361022736 0ustar ahartmaiahartmaipackage Message::Passing::Role::Input; use Moo::Role; use Scalar::Util qw/ blessed /; use Module::Runtime qw/ require_module /; use namespace::clean -except => 'meta'; has output_to => ( is => 'ro', required => 1, isa => sub { blessed($_[0]) && $_[0]->can('consume') }, coerce => sub { my $val = shift; if (ref($val) eq 'HASH') { my %stuff = %$val; my $class = delete($stuff{class}); require_module($class); $val = $class->new(%stuff); } $val; }, ); 1; =head1 NAME Message::Passing::Role::Input =head1 DESCRIPTION Produces messages. =head1 ATTRIBUTES =head2 output_to Required, must perform the L role. =head1 SEE ALSO =over =item L =item L =back =head1 SPONSORSHIP This module exists due to the wonderful people at Suretec Systems Ltd. who sponsored its development for its VoIP division called SureVoIP for use with the SureVoIP API - =head1 AUTHOR, COPYRIGHT AND LICENSE See L. =cutMessage-Passing-0.116/lib/Message/Passing/Role/Script.pm0000644000175000017500000001237012472654556023131 0ustar ahartmaiahartmaipackage Message::Passing::Role::Script; use Moo::Role; use MooX::Options; use MooX::Types::MooseLike::Base qw/ Bool Str /; use Getopt::Long qw(:config pass_through); use POSIX qw(setuid setgid); use Message::Passing::DSL; use Carp qw/ confess /; use namespace::clean -except => 'meta'; requires 'build_chain'; option daemonize => ( is => 'ro', isa => Bool, default => sub { 0 }, doc => 'pass 1 to daemonize', ); option io_priority => ( isa => sub { $_[0] =~ /^(none|be|rt|idle)$/ }, coerce => sub { lc $_[0] }, is => 'ro', predicate => "_has_io_priority", format => 's', doc => 'the IO priority to run the script at: none, be, rt, idle', ); option user => ( isa => Str, is => 'ro', predicate => "_has_user", format => 's', doc => 'changes the user the script is running as', ); option pid_file => ( isa => Str, is => 'ro', predicate => "_has_pid_file", format => 's', doc => 'the name of the pid file including the directory', ); sub daemonize_if_needed { my ($self) = @_; my $fh; if ($self->_has_pid_file) { open($fh, '>', $self->pid_file) or confess("Could not open pid file '". $self->pid_file . "': $?"); } if ($self->daemonize) { fork && exit; POSIX::setsid(); fork && exit; chdir '/'; umask 0; } if ($fh) { print $fh $$ . "\n"; close($fh); } } sub change_uid_if_needed { my $self = shift; my ($uid, $gid); if ($self->_has_user) { my $user = $self->user; $uid = getpwnam($user) || die("User '$user' does not exist, cannot become that user!\n"); (undef, undef, undef, $gid ) = getpwuid($uid); } if ($gid) { setgid($gid) || die("Could not setgid to '$gid' are you root? : $!\n"); } if ($uid) { setuid($uid) || die("Could not setuid to '$uid' are you root? : $!\n"); } } sub set_io_priority_if_needed { my $self = shift; return unless $self->_has_io_priority; require Linux::IO_Prio; my $sym = do { no strict 'refs'; &{"Linux::IO_Prio::IOPRIO_CLASS_" . uc($self->io_priority)}(); }; Linux::IO_Prio::ioprio_set(Linux::IO_Prio::IOPRIO_WHO_PROCESS(), $$, Linux::IO_Prio::IOPRIO_PRIO_VALUE($sym, 0) ); } sub start { my $class = shift; my $instance = $class->new_with_options(@_); $instance->set_io_priority_if_needed; $instance->change_uid_if_needed; $instance->daemonize_if_needed; run_message_server $instance->build_chain; } 1; =head1 NAME Message::Passing:Role::Script - Handy role for building messaging scripts. =head1 SYNOPSIS # my_message_passer.pl package My::Message::Passer; use Moo; use MooX::Options; use MooX::Types::MooseLike::Base qw/ Bool /; use Message::Passing::DSL; with 'Message::Passing::Role::Script'; option foo => ( is => 'ro', isa => Bool, ); sub build_chain { my $self = shift; message_chain { input example => ( output_to => 'test_out', .... ); output test_out => ( foo => $self->foo, ... ); }; } __PACKAGE__->start unless caller; 1; =head1 DESCRIPTION This role can be used to make simple message passing scripts. The user implements a L type script class, with a C method, that builds one or more L chains and returns them. __PACKAGE__->start unless caller; is then used before the end of the script. This means that when the code is run as a script, it'll parse the command line options, and start a message passing server.. =head1 REQUIRED METHODS =head1 build_chain Return a chain of message processors, or an array reference with multiple chains of message processors. =head1 ATTRIBUTES =head2 daemonize Do a double fork and lose controlling terminal. Used to run scripts in the background. =head2 io_priority The IO priority to run the script at.. Valid values for the IO priority are: =over =item none =item be =item rt =item idle =back =head2 user Changes the user the script is running as. You probably need to run the script as root for this option to work. =head2 pid_file Write a pid file out. Useful for running Message::Passing scripts as daemons and/or from init.d scripts. =head1 METHODS =head2 start Called as a class method, it will build the current class as a command line script (parsing ARGV), setup the daemonization options, call the ->build_chain method supplied by the user to build the chains needed for this application. Then enters the event loop and never returns. =head2 change_uid_if_needed Tries to change uid if the --user option has been supplied =head2 daemonize_if_needed Tires to daemonize if the --daemonize option has been supplied =head2 set_io_priority_if_needed Tries to set the process' IO priority if the --io_priority option has been supplied. =head1 SPONSORSHIP This module exists due to the wonderful people at Suretec Systems Ltd. who sponsored its development for its VoIP division called SureVoIP for use with the SureVoIP API - =head1 AUTHOR, COPYRIGHT AND LICENSE See L. =cut Message-Passing-0.116/lib/Message/Passing/Role/ConnectionManager.pm0000644000175000017500000001410712472650332025243 0ustar ahartmaiahartmaipackage Message::Passing::Role::ConnectionManager; use Moo::Role; use MooX::Types::MooseLike::Base qw/ Bool ArrayRef /; use Scalar::Util qw/ blessed weaken /; use Carp qw/ confess /; use Message::Passing::Exception::ConnectionDisconnected; use Message::Passing::Exception::ConnectionTimeout; use namespace::clean -except => 'meta'; requires '_build_connection'; sub BUILD { my $self = shift; $self->connection; } with qw/ Message::Passing::Role::HasTimeoutAndReconnectAfter Message::Passing::Role::HasErrorChain /; has _timeout_timer => ( is => 'rw', ); has connected => ( is => 'ro', isa => Bool, default => sub { 0 }, writer => '_set_connected', ); has connection => ( is => 'ro', lazy => 1, predicate => '_has_connection', builder => '_build_connection', clearer => '_clear_connection', ); after _build_connection => sub { my $self = shift; weaken($self); $self->_timeout_timer($self->_build_timeout_timer); }; sub _build_timeout_timer { my $self = shift; weaken($self); AnyEvent->timer( after => $self->timeout, cb => sub { $self->error->consume(Message::Passing::Exception::ConnectionTimeout->new( after => $self->timeout, )); $self->_timeout_timer(undef); $self->_set_connected(0); # Use public API, causing reconnect timer to be built }, ); } sub _build_reconnect_timer { my $self = shift; weaken($self); AnyEvent->timer( after => $self->reconnect_after, cb => sub { # $self->error->consume("Reconnecting to ..."); $self->_timeout_timer(undef); $self->connection; # Just rebuild the connection object }, ); } before _clear_connection => sub { my $self = shift; return unless $self->_has_connection; $self->_timeout_timer($self->_build_reconnect_timer); }; has _connect_subscribers => ( isa => ArrayRef, is => 'ro', default => sub { [] }, writer => '_set_connect_subscribers', ); sub __clean_subs { my $self = shift; my $subs = [ grep { weaken($_); defined $_ } @{$self->_connect_subscribers} ]; $self->_set_connect_subscribers($subs); } sub subscribe_to_connect { my ($self, $subscriber) = @_; confess "Subscriber '$subscriber' is not blessed" unless blessed $subscriber; confess "Subscriber '$subscriber' does not have a ->connected method" unless $subscriber->can('connected'); $self->__clean_subs; my $subs = $self->_connect_subscribers; push(@$subs, $subscriber); if ($self->connected) { $subscriber->connected($self->connection); } } after _set_connected => sub { my ($self, $connected) = @_; $self->__clean_subs; my $method = $connected ? 'connected' : 'disconnected'; foreach my $sub (@{$self->_connect_subscribers}) { $sub->$method($self->connection) if $sub->can($method); } $self->_timeout_timer(undef) if $connected; if (!$connected && $self->_has_connection) { $self->error->consume(Message::Passing::Exception::ConnectionDisconnected->new); $self->_clear_connection; } }; 1; =head1 NAME Message::Passing::Role::ConnectionManager - A simple manager for inputs and outputs that need to make network connections. =head1 DESCRIPTION This role is for components which make network connections, and need to handle the connection not starting, timeouts, disconnects etc. It provides a simple abstraction for multiple other classes to be able to use the same connection manager, and a notifies =head1 REQUIRED METHODS =head2 _build_connection Build and return the connection we're managing, start the connection process. Your connection should use the API as documented below to achieve notification of connect and disconnect events. =head1 API FOR CONNECTIONS =head2 _set_connected (1) Notify clients that the connection is now ready for use. =head2 _set_connected (0) Notify clients that the connection is no longer ready for use. Will cause the connection to be terminated and retried. =head1 API FOR CLIENTS To use a connection manager, you should register yourself like this: $manager->subscribe_to_connect($self); The manager will call C<< $self->connected($connection) >> and C<< $self->disconnected() >> when appropriate. If the manager is already connected when you subscribe, it will immediately call back into your C<< connected >> method, if it is not already connected then this will happen at a later point once the connection is established. See L for a role to help with dealing with a connection manager. =head1 ATTRIBUTES =head2 connected A Boolean indicating if the connection is currently considered fully connected =head2 connection The connection object (if we are connected, or connecting currently) - can be undefined if we are during a reconnect timeout. =head2 timeout Connections will be timed out and aborted after this time if they haven't successfully connected. Defaults to 30s =head2 reconnect_after The number of seconds to wait before starting a reconnect after a connection has timed out or been aborted. Defaults to 2s =head1 METHODS =head2 subscribe_to_connect ($subscriber) This is called by your Input or Output, as C<< $self->connection_manager->subscribe_to_connect($self) >>. This is done for you by L usually.. This arranges to store a weak reference to your component, allowing the connection manager to call the C<< ->connect >> or C<< ->disconnect >> methods for any components registered when a connection is established or destroyed. Note that if the connection manager is already connected, it will B call the C<< ->connect >> method. =head1 SPONSORSHIP This module exists due to the wonderful people at Suretec Systems Ltd. who sponsored its development for its VoIP division called SureVoIP for use with the SureVoIP API - ==head1 AUTHOR, COPYRIGHT AND LICENSE See L. =cut Message-Passing-0.116/lib/Message/Passing/Role/Output.pm0000644000175000017500000000161412015115366023144 0ustar ahartmaiahartmaipackage Message::Passing::Role::Output; use Moo::Role; use JSON qw/ to_json /; use Scalar::Util qw/ blessed /; #use namespace::clean -except => 'meta'; requires 'consume'; no Moo::Role; 1; =head1 NAME Message::Passing::Role::Output - Consumes messages =head1 DESCRIPTION This is a role for classes which consumer messages (e.g. a Message::Passing output) =head1 REQUIRED METHODS =head2 consume Consume a message =head1 SEE ALSO =over =item L =item L =back =head1 SPONSORSHIP This module exists due to the wonderful people at Suretec Systems Ltd. who sponsored its development for its VoIP division called SureVoIP for use with the SureVoIP API - =head1 AUTHOR, COPYRIGHT AND LICENSE See L. =cutMessage-Passing-0.116/lib/Message/Passing/Role/CLIComponent.pm0000644000175000017500000000516612015115272024140 0ustar ahartmaiahartmaipackage Message::Passing::Role::CLIComponent; use strict; use warnings; use Package::Variant importing => ['Moo::Role'], subs => [ qw(has around before after with) ]; use MooX::Options; use MooX::Types::MooseLike::Base qw/ Str /; use JSON (); use Try::Tiny qw/ try /; sub make_variant { my ($class, $target_package, %arguments) = @_; my $p = shift; my $name = $arguments{name}; my $has_default = exists $arguments{default}; my $default = $has_default ? $arguments{default} : undef; option "$name" => ( isa => Str, is => 'ro', # required => "$has_default" ? 0 : 1, "$has_default" ? ( default => sub { "$default" } ) : (), format => 's', ); option "${name}_options" => ( is => 'ro', default => sub { {} }, isa => sub { ref($_[0]) eq 'HASH' }, coerce => sub { my $str = shift; if (! ref $str) { try { $str = JSON->new->relaxed->decode($str) }; } $str; }, format => 's', ); } 1; =head1 NAME Message::Passing::Role::CLIComponent - Package::Variant providing 'foo' and 'foo_options' attributes =head1 SYNOPSIS package My::Message::Passing::Script; use Moo; use MooX::Options; use Message::Passing::Role::CLIComponent; use Message::Passing::DSL; use namespace::clean -except => 'meta'; with CLIComponent( name => 'input', default => 'STDIN' ), 'Message::Passing::Role::Script'; sub build_chain { my $self = shift; message_chain { input example => ( %{ $self->input_options }, output_to => 'test_out', class => $self->input, ); output test_out => ( ... ); }; } __PACKAGE__->start unless caller; 1; =head1 DESCRIPTION A L role producer, which is used to provide a pair of attributes for name/options as per the L script. =head1 ROLE PARAMETERS =head2 name The name of the main attribute. An additional attribute called C<< "${name}_options" >> will also be added, which coerces a hashref from JSON. =head2 default A default value for the main attribute. If this is not supplied, than the attribute will be required. =head1 SPONSORSHIP This module exists due to the wonderful people at Suretec Systems Ltd. who sponsored its development for its VoIP division called SureVoIP for use with the SureVoIP API - =head1 AUTHOR, COPYRIGHT AND LICENSE See L. =cutMessage-Passing-0.116/lib/Message/Passing/Role/Crypt/0000755000175000017500000000000012472656214022416 5ustar ahartmaiahartmaiMessage-Passing-0.116/lib/Message/Passing/Role/Crypt/CBC.pm0000644000175000017500000000224712015112611023325 0ustar ahartmaiahartmaipackage Message::Passing::Role::Crypt::CBC; use Moo::Role; use MooX::Types::MooseLike::Base qw/ Str /; use Crypt::CBC; use namespace::clean -except => 'meta'; foreach my $name (qw/ encryption_key encryption_cipher /) { has $name => ( isa => Str, is => 'ro', required => 1, ); } # NOTE - We need a new CBC object per message, otherwise if we _EVER_ drop # messages then we totally screw ourselves! sub cbc { my $self = shift; Crypt::CBC->new( -key => $self->encryption_key, -cipher => $self->encryption_cipher, ); } 1; =head1 NAME Message::Passing::Role::Crypt::CBC - Common attributes for encoding or decoding encrypted messages =head1 ATTRIBUTES =head2 encryption_key The key for encryption (this is a shared secret key between both sides) =head2 encryption_cipher Any cipher supported by L. =head1 METHODS =head2 cbc Returns a new L object. =head1 SEE ALSO =over =item L =item L =item L =back =head1 AUTHOR, COPYRIGHT & LICENSE See L. =cut Message-Passing-0.116/lib/Message/Passing/Role/HasTimeoutAndReconnectAfter.pm0000644000175000017500000000114412015115342027164 0ustar ahartmaiahartmaipackage Message::Passing::Role::HasTimeoutAndReconnectAfter; use Moo::Role; use MooX::Types::MooseLike::Base qw/ Num /; use namespace::clean -except => 'meta'; has timeout => ( isa => Num, is => 'ro', default => sub { 30 }, ); has reconnect_after => ( isa => Num, is => 'ro', default => sub { 2 }, ); 1; =head1 NAME Message::Passing::Role::HasTimeoutAndReconnectAfter =head1 DESCRIPTION Adds a C and a C attributes to your class. =head1 METHODS =head2 timeout =head2 reconnect_after =head1 AUTHOR, COPYRIGHT AND LICENSE See L. =cutMessage-Passing-0.116/lib/Message/Passing/Role/HasHostnameAndPort.pm0000644000175000017500000000112112015115334025332 0ustar ahartmaiahartmaipackage Message::Passing::Role::HasHostnameAndPort; use Moo::Role; use MooX::Types::MooseLike::Base qw/ Str Int /; use namespace::clean -except => 'meta'; requires '_default_port'; has hostname => ( is => 'ro', isa => Str, required => 1, ); has port => ( is => 'ro', isa => Int, builder => '_default_port', ); 1; =head1 NAME Message::Passing::Role::HasHostnameAndPort =head1 DESCRIPTION Adds a C and a C attributes to your class. =head1 METHODS =head2 hostname =head2 port =head1 AUTHOR, COPYRIGHT AND LICENSE See L. =cutMessage-Passing-0.116/lib/Message/Passing/Role/HasErrorChain.pm0000644000175000017500000000452012022141471024325 0ustar ahartmaiahartmaipackage Message::Passing::Role::HasErrorChain; use Moo::Role; use Module::Runtime qw/ require_module /; use namespace::clean -except => 'meta'; has error => ( is => 'ro', lazy => 1, builder => '_build_default_error_chain', ); sub _build_default_error_chain { require_module 'Message::Passing::Output::STDERR'; require_module 'Message::Passing::Filter::Encoder::JSON'; Message::Passing::Filter::Encoder::JSON->new( output_to => Message::Passing::Output::STDERR->new, ); } 1; =head1 NAME Message::Passing::Role::HasErrorChain - A role for components which can report errors =head1 SYNOPSIS # Note this is an example package, and does not really exist! package Message::Passing::Output::ErrorAllMessages; use Moo; use namespace::clean -except => 'meta'; with qw/ Message::Passing::Role::Output Message::Passing::Role::HasErrorChain /; sub consume { my ($self, $message) = @_; $self->error->consume($message); } =head1 DESCRIPTION Some components can create an error stream in addition to a message stream. =head1 METHODS =head2 error An attribute containing the error chain. By default, this is a chain of: =over =item Message::Passing::Filter::Encoder::JSON =item Message::Passing::Output::STDOUT =back =head1 WARNINGS =head2 ERROR CHAINS CAN LOOP If you override the error chain output, be sure that the error chain does not go into your normal log path! This is because if you suddenly have errors in your normal log path, and you then start logging these errors, this causes more errors - causing you to generate a message loop. =head2 ENCODING IN ERROR CHAINS If you emit something which cannot be encoded to an error chain then the encoding error will likely be emitted by the error chain - this can again cause loops and other issues. All components which use error chains should be very careful to output data which they are entirely certain will be able to be encoded. =head1 SPONSORSHIP This module exists due to the wonderful people at Suretec Systems Ltd. who sponsored its development for its VoIP division called SureVoIP for use with the SureVoIP API - =head1 AUTHOR, COPYRIGHT AND LICENSE See L. =cut Message-Passing-0.116/lib/Message/Passing.pm0000644000175000017500000001776512472655522020773 0ustar ahartmaiahartmaipackage Message::Passing; use Moo; use Config::Any; use Message::Passing::Role::CLIComponent; use Message::Passing::DSL; use Carp qw/ confess /; use MooX::Options flavour => [qw( pass_through )], protect_argv => 0; use namespace::clean -except => [qw/ meta new_with_options parse_options _options_data _options_config/]; use 5.008004; our $VERSION = '0.116'; $VERSION = eval $VERSION; around 'parse_options' => sub { my $orig = shift; my $class = shift; my %args = $orig->($class, @_); if (my $conf = $args{configfile}) { my $cfg = $class->get_config_from_file($conf); foreach my $k (keys %$cfg) { if (!exists $args{$k}) { $args{$k} = $cfg->{$k}; } } } return %args; }; with CLIComponent( name => 'input' ), CLIComponent( name => 'output' ), CLIComponent( name => 'filter', default => 'Null' ), CLIComponent( name => 'decoder', default => 'JSON' ), CLIComponent( name => 'encoder', default => 'JSON' ), CLIComponent( name => 'error', default => 'STDERR' ), CLIComponent( name => 'error_encoder', default => 'Message::Passing::Filter::Encoder::JSON' ), 'Message::Passing::Role::Script'; option configfile => ( is => 'ro', format => 's', ); sub get_config_from_file { my ($class, $filename) = @_; my ($fn, $cfg) = %{ Config::Any->load_files({ files => [$filename], use_ext => 1, })->[0] }; return $cfg; } sub build_chain { my $self = shift; message_chain { error_log( %{ $self->error_encoder_options }, class => $self->error_encoder, output_to => output error => ( %{ $self->error_options }, class => $self->error, ), ); output output => ( %{ $self->output_options }, class => $self->output, ); encoder("encoder", %{ $self->encoder_options }, class => $self->encoder, output_to => 'output', ); filter filter => ( %{ $self->filter_options }, class => $self->filter, output_to => 'encoder', ); decoder("decoder", %{ $self->decoder_options }, class => $self->decoder, output_to => 'filter', ); input input => ( %{ $self->input_options }, class => $self->input, output_to => 'decoder', ); }; } 1; =head1 NAME Message::Passing - a simple way of doing messaging. =head1 SYNOPSIS message-pass --input STDIN --output STDOUT {"foo": "bar"} {"foo":"bar"} =head1 DESCRIPTION A library for building high performance, loosely coupled and reliable/resilient applications, structured as small services which communicate over the network by passing messages. =head2 BASIC PREMISE You have data for discrete events, represented by a hash (and serialized as JSON). This could be a text log line, an audit record of an API event, a metric emitted from your application that you wish to aggregate and process - anything that can be a simple hash really.. You want to be able to shove these events over the network easily, and aggregate them / filter and rewrite them / split them into worker queues. This module is designed as a simple framework for writing components that let you do all of these things, in a simple and easily extensible manor. For a practical example, You generate events from a source (e.g. L output of logs and performance metrics from your L FCGI or L workers) and run one script that will give you a central application log file, or push the logs into Elasticsearch. There are a growing set of components you can plug together to make your solution. Getting started is really easy - you can just use the C command installed by the distribution. If you have a common config that you want to repeat, or you want to write your own server which does something more flexible than the normal script allows, then see L. To dive straight in, see the documentation for the command line utility L, and see the examples in L. For more about how the system works, see L. =head1 COMPONENTS Below is a non-exhaustive list of components available. =head2 INPUTS Inputs receive data from a source (usually a network protocol). They are responsible for decoding the data into a hash before passing it onto the next stage. Inputs include: =over =item L =item L =item L =item L =item L =item L =item L =back You can easily write your own input, just use L, and consume L. =head2 FILTER Filters can transform a message in any way. Examples include: =over =item L - Returns the input unchanged. =item L - Stops any messages it receives from being passed to the output. I.e. literally filters all input out. =item L - Splits the incoming message to multiple outputs. =back You can easily write your own filter, just consume L. Note that filters can be chained, and a filter can return undef to stop a message being passed to the output. =head2 OUTPUTS Outputs send data to somewhere, i.e. they consume messages. =over =item L =item L =item L =item L =item L =item L =item L =item L =back =head1 SEE ALSO =over =item L - The manual (contributions cherished) =item L - Slide deck! =item L - For creating your log messages. =item L - use Message::Passing outputs from L. =back =head1 THIS MODULE This is a simple L script, with one input, one filter and one output. To build your own similar scripts, see: =over =item L - To declare your message chains =item L - To provide C and C attribute pairs. =item L - To provide daemonization features. =back =head2 METHODS =head3 build_chain Builds and returns the configured chain of input => filter => output =head3 start Class method to call the run_message_server function with the results of having constructed an instance of this class, parsed command line options and constructed a chain. This is the entry point for the script. =head1 AUTHOR Tomas (t0m) Doran =head1 SUPPORT =head2 Bugs Please log bugs at L. Each distribution has a bug tracker link in it's L page. =head2 Discussion L<#message-passing> on L. =head2 Source code Source code for all modules is available at L and forks / patches are very welcome. =head1 SPONSORSHIP This module exists due to the wonderful people at Suretec Systems Ltd. who sponsored its development for its VoIP division called SureVoIP for use with the SureVoIP API - =head1 COPYRIGHT Copyright Suretec Systems Ltd. 2012. Logstash (upon which many ideas for this project is based, but which we do not reuse any code from) is copyright 2010 Jorden Sissel. =head1 LICENSE GNU Library General Public License, Version 2.1 =cut Message-Passing-0.116/MANIFEST.SKIP0000644000175000017500000000020112472647746016557 0ustar ahartmaiahartmai\.swp$ ^Message-Passing ^Makefile$ ^Makefile.old$ ^Log-Stash- ^MANIFEST.bak ^MYMETA.json ^MYMETA.yml ^pm_to_blib blib/ .git/ ^\. Message-Passing-0.116/Makefile.PL0000644000175000017500000000260512472655746016644 0ustar ahartmaiahartmaiuse strict; use warnings; use inc::Module::Install; use Module::Install::AuthorRequires; use Module::Install::AuthorTests; use Module::Install::Authority; all_from 'lib/Message/Passing.pm'; license 'LGPL_2_1'; authority('cpan:GHENRY'); resources( repository => "git://github.com/suretec/Message-Passing.git", ); requires 'Moo' => '0.091011'; requires 'Package::Variant' => '1.001001'; requires 'namespace::clean' => '0.23'; requires 'Module::Runtime' => '0.013'; requires 'AnyEvent'; requires 'AnyEvent::Handle::UDP'; requires 'Config::Any'; requires 'MooX::Types::MooseLike' => '0.08'; requires 'MooX::Options' => '3.71'; requires 'String::RewritePrefix'; requires 'JSON::MaybeXS' => '1.002002'; requires 'Try::Tiny'; requires 'Task::Weaken'; requires 'Sys::Hostname::Long'; requires 'DateTime'; requires 'IO::Handle'; recommends 'Linux::IO_Prio' => 0.03; install_script 'script/message-pass'; author_requires( 'Test::Pod' => '1.14', 'Test::NoTabs' => '0', 'Test::Pod::Coverage' => '1.04', 'Test::CPAN::Changes' => '0.22', 'Pod::Coverage' => '0.19', 'Pod::Coverage::TrustPod' => '0', 'Test::Spelling' => '0', 'Compress::Zlib' => '0', 'Compress::Bzip2' => '0', 'Crypt::CBC' => '0', 'Crypt::Blowfish' => '0', ); author_tests 't/author'; if ($Module::Install::AUTHOR) { system("pod2text lib/Message/Passing.pm > README") and die $!; } WriteAll; Message-Passing-0.116/Changes0000644000175000017500000001673112472656134016162 0ustar ahartmaiahartmai0.116 2015-02-23T18:00:00+01:00 - Fix link in 'Writing Filters' section of Message::Passing::Manual::Components - Fix daemonize_if_needed spelling - Add documentation for all command line options - Add Linux::IO_Prio to recommended modules for io_priority option - Recommend newer Message::Passing::Output::Search::Elasticsearch in docs 0.115 2014-08-23T09:55:00+03:00 YAPC::EU 2014 release - Fix internal and therefore undocumented type parameter swallows Output::Search::Elasticsearches type parameter - Use JSON::MaybeXS instead of JSON in Filter::De/Encoder::JSON 0.114 2013-09-17T10:30:00+02:00 - Fix test failures under Perl 5.18 - Improve documentation 0.113 2013-08-02T09:25:00+02:00 - Add Message::Passing::Filter::Mangle for use with Message::Passing::DSL when you don't want to write a named filter. 0.112 2013-04-25T23:45:39+0100 - Change to LGPL_2_1. 0.111 2013-03-03T15:54:12+0000 - Fix STDIN input to exit on EOF. 0.110 2012-10-08T16:51:49+0100 - Fix v-string to work with perl 5.8. RT#80034 - Fix issues stopping multiple FileTail inputs being used in the same process. 0.109 2012-09-27T16:11:50+0100 - Really fix test fail :( 0.108 2012-09-27T14:59:43+0100 - Fix test fail on some machines. 0.107 2012-09-27T10:03:30+0100 - Change Input::FileTail to use Sys::Hostname::Long - Fix bug causing crash with no helpful error message if PID file location is not writeable. 0.106 2012-09-12T23:59:13+0100 - Remove debug warning accidentally left in the UDP input. 0.105 2012-09-12T23:55:36+0100 - Depend on latest MooX::Options to stop install fails. 0.104 2012-09-06T18:36:27+0200 - Fix to work with MooX::Options 3.7 0.103 2012-09-05T09:07:00+0100 - Message::Passing::Input::FileTail now defaults to outputting a hash of data which contains additional metadata to the message line, such as the hostname, timestamp, filename. A 'raw => 1' option has been added which can be used to restore the original behaviour. - Add an experimental (and undocumented) Message::Passing::Filter::ToLogstash - Fix issue in JSON decoder when processing exceptions. 0.102 2012-08-26T21:12:52+0100 - Add error chain support to the JSON encoder and decoder so that an error is logged if JSON encoding or decoding fails. - Make default error chain do JSON encoding on errors so that they're readable. - Make CLI error chain have options for the error encoder. 0.101 2012-08-23T21:23:52+0100 - Fix daemonization features provided by Message::Passing::Role::Script to work on the command line again by exlicitly using MooX::Options - Fix Message::Passing::Input::FileTail to not die if the tail process is killed for any reason. It is instead re-spawned.. RT#78851 0.100 2012-08-19T08:12:32+0100 - Port the dist to Moo, so that the core of Message::Passing uses no XS code. Components can still be written using full Moose, as Moo supports upgrading classes to full Moose classes. Note however that this implies the following changes to custom scripts: - Scripts should use MooX::Options instead of MooseX::Getopt, attributes will need to be updated to use the 'option' keyword rather than 'has'. - Message::Passing::Role::CLIComponent is now built on top of Package::Variant rather than MooseX::Role::Parameterized, and so scripts should now import it and use the function provided to generate roles. - Add UDP socket Input and Output, allowing transit of arbitrary UDP packets. - Add Travis continuous integration to the project. 0.010 2012-07-11T19:17:44+0100 - Doc fix in Message::Passing::Manual::Cookbook https://github.com/suretec/Message-Passing/pull/2 - Add Crypt::CBC encoder and decoder. - Add Gzip and Bzip2 encoders and decoders. 0.009 2012-06-13T15:53:35-0500 - Add Message::Passing::Manual::Components. - Add SYNOPSIS to Message::Passing::Role::Filter. - Additional documentation in Message::Passing::Manual. - Refactor building connection managers so less duplicate code is needed in components. - Make STDIN input saner. - Add an 'error chain' concept, allowing components to have a way of reporting connection (or other) issues out of band with the message stream. This defaults to STDERR, however can be overridden per component, or for a whole chain. - Add error_log() function to the DSL for setting the error chain up for a whole chain. - Use the error chain in Message::Passing::Role::ConnectionManager to output errors when connections disconnect / timeout / reconnect. - Cleanups to Message::Passing::Input::FileTail to not leak processes and file handles if the instance of the Input class is destroyed. 0.008 2012-06-10T20:51:51+0100 - Add standard roles to unify the names of connection attributes: Message::Passing::Role::HasHostnameAndPort Message::Passing::Role::HasUsernameAndPassword - Lots of additional documentation. - Add STDERR output. - Rename the log_chain function to message_chain and run_log_server function to run_message_server, in Message::Passing::DSL to follow the general rename, as we're not just about logs. 0.007 2012-06-10T11:07:45+0100 - Documentation in the message-pass script - Add --configfile option to default script, allowing you to load config from a file, rather than supplying it on command line. - Make JSON encoder pass non refs straight through, so that if a previous filter generates a scalar, then this gets sent as-is. - Make JSON decoder pass refs straight through, to act as a no-op if the input has already decoded it's data into a hash. - Remove spurious warnings from reconnect code. 0.006 2012-06-08T01:30:53+0100 - Rip JSON encoders and decoders out of inputs and outputs, making them optional and/or replaceable. *NOTE* Current Input / Output code will need updating for this change!! - Allow Null encoders or decoders. 0.005 2012-06-01T10:07:42+0100 - Get connection timeouts and connection reconnects working in the generic ConnectionManager role. - Add link to syslog input - AMQP input/output is on CPAN - Add link to STOMP input/output. 0.004 2012-05-28T10:20:32+0100 - Fix script name - Note irc channel and bug trackers in docs. 0.003 2012-05-28T08:53:17+0100 - Updates and fixes to documentation. - Unify license/author/copyright to main file. 0.002_01 2012-05-27T08:21:31+0100 - Add more core roles for use by extensions which need to make a connection. - Rename to Message::Passing, as it's a better description of what we do, and will cause less confusion with other projects. 0.002 2012-05-13T17:34:49+0100 - Support a --daemonize option in logstash scripts. - Support a --pid_file option in logstash scripts. - Allow inputs to coerce a hash in output_to to an output, which is more verbose than the DSL, but also allows you to setup simple output chains from a simple data structure (such as you might read in from a config file). - Explicitly turn off output buffering in STDOUT output. This means that piping the STDOUT output to a file (for logging or debugging purposes) works as expected, without batching writes. - Change logstash script to use the perl interpreter it is installed with, rather than the one in $PATH right now. - Fix issue using Filter::T in the DSL - Fix multiple inputs going to the same output. 0.001 2012-03-21T22:26:21+0000 - Initial version. Message-Passing-0.116/MANIFEST0000644000175000017500000000570312472656214016014 0ustar ahartmaiahartmaiChanges inc/Module/Install.pm inc/Module/Install/Authority.pm inc/Module/Install/AuthorRequires.pm inc/Module/Install/AuthorTests.pm inc/Module/Install/Base.pm inc/Module/Install/Can.pm inc/Module/Install/Fetch.pm inc/Module/Install/Makefile.pm inc/Module/Install/Metadata.pm inc/Module/Install/Scripts.pm inc/Module/Install/Win32.pm inc/Module/Install/WriteAll.pm lib/Message/Passing.pm lib/Message/Passing/DSL.pm lib/Message/Passing/DSL/Factory.pm lib/Message/Passing/Exception.pm lib/Message/Passing/Exception/ConnectionDisconnected.pm lib/Message/Passing/Exception/ConnectionTimeout.pm lib/Message/Passing/Exception/Decoding.pm lib/Message/Passing/Exception/Encoding.pm lib/Message/Passing/Filter/All.pm lib/Message/Passing/Filter/Decoder/Bzip2.pm lib/Message/Passing/Filter/Decoder/Crypt/CBC.pm lib/Message/Passing/Filter/Decoder/Gzip.pm lib/Message/Passing/Filter/Decoder/JSON.pm lib/Message/Passing/Filter/Decoder/Null.pm lib/Message/Passing/Filter/Delay.pm lib/Message/Passing/Filter/Encoder/Bzip2.pm lib/Message/Passing/Filter/Encoder/Crypt/CBC.pm lib/Message/Passing/Filter/Encoder/Gzip.pm lib/Message/Passing/Filter/Encoder/JSON.pm lib/Message/Passing/Filter/Encoder/Null.pm lib/Message/Passing/Filter/Key.pm lib/Message/Passing/Filter/Mangle.pm lib/Message/Passing/Filter/Null.pm lib/Message/Passing/Filter/T.pm lib/Message/Passing/Filter/ToLogstash.pm lib/Message/Passing/Input/FileTail.pm lib/Message/Passing/Input/Null.pm lib/Message/Passing/Input/Socket/UDP.pm lib/Message/Passing/Input/STDIN.pm lib/Message/Passing/Manual.pod lib/Message/Passing/Manual/Components.pod lib/Message/Passing/Manual/Concepts.pod lib/Message/Passing/Manual/Cookbook.pod lib/Message/Passing/Manual/Workers.pod lib/Message/Passing/Output/Callback.pm lib/Message/Passing/Output/File.pm lib/Message/Passing/Output/IO/Handle.pm lib/Message/Passing/Output/Null.pm lib/Message/Passing/Output/Socket/UDP.pm lib/Message/Passing/Output/STDERR.pm lib/Message/Passing/Output/STDOUT.pm lib/Message/Passing/Output/Test.pm lib/Message/Passing/Role/CLIComponent.pm lib/Message/Passing/Role/ConnectionManager.pm lib/Message/Passing/Role/Crypt/CBC.pm lib/Message/Passing/Role/Filter.pm lib/Message/Passing/Role/HasAConnection.pm lib/Message/Passing/Role/HasErrorChain.pm lib/Message/Passing/Role/HasHostnameAndPort.pm lib/Message/Passing/Role/HasTimeoutAndReconnectAfter.pm lib/Message/Passing/Role/HasUsernameAndPassword.pm lib/Message/Passing/Role/Input.pm lib/Message/Passing/Role/Output.pm lib/Message/Passing/Role/Script.pm Makefile.PL MANIFEST This list of files MANIFEST.SKIP META.yml README script/message-pass t/00_compile.t t/author/cpan-changes.t t/author/notabs.t t/author/pod.t t/author/podcoverage.t t/author/spelling.t t/compress.t t/configfile.t t/crypt_cbc.t t/dsl.t t/errorchain.t t/filter.t t/filter_mangle.t t/filter_tologstash.t t/input_decode.t t/input_output_coerce.t t/logstash_script.t t/output_encode.t t/output_null.t t/output_test.t t/role_connectionmanager.t t/role_hasaconnection.t t/socket_udp.t TODO Message-Passing-0.116/TODO0000644000175000017500000000171612022141471015334 0ustar ahartmaiahartmaiCode core/general: - Generic blessed object serialize filter - Logstash compatibility filter - Global registry and DSL support for connection managers - Connection sharing - Connect timeout strategies - Better documentation for error chain. Specific adaptors - AMQP needs a lot of work Docs: Message::Passing::Manual::Concepts: - Proper script writing (after DSL example) - Other links.. in ::Concepts? Message::Passing::Manual::Workers: - Write Message::Passing::Manual::Cookbook: - Aggregating this log - Link to building own script - Note other script options - Syslog - On host collector - Explain what this is - Explain central aggregation, again - Aggregating everything - Finish - Filtering messages - Putting it all together - log processor with filtering etc. - HTTP POST notifications - Worker pools for jobs - Async notification with Web::Hippie - Updating monitoringJS not until Moo! Message-Passing-0.116/inc/0000755000175000017500000000000012472656214015427 5ustar ahartmaiahartmaiMessage-Passing-0.116/inc/Module/0000755000175000017500000000000012472656214016654 5ustar ahartmaiahartmaiMessage-Passing-0.116/inc/Module/Install/0000755000175000017500000000000012472656214020262 5ustar ahartmaiahartmaiMessage-Passing-0.116/inc/Module/Install/Makefile.pm0000644000175000017500000002743712472656164022356 0ustar ahartmaiahartmai#line 1 package Module::Install::Makefile; use strict 'vars'; use ExtUtils::MakeMaker (); use Module::Install::Base (); use Fcntl qw/:flock :seek/; use vars qw{$VERSION @ISA $ISCORE}; BEGIN { $VERSION = '1.14'; @ISA = 'Module::Install::Base'; $ISCORE = 1; } sub Makefile { $_[0] } my %seen = (); sub prompt { shift; # Infinite loop protection my @c = caller(); if ( ++$seen{"$c[1]|$c[2]|$_[0]"} > 3 ) { die "Caught an potential prompt infinite loop ($c[1]|$c[2]|$_[0])"; } # In automated testing or non-interactive session, always use defaults if ( ($ENV{AUTOMATED_TESTING} or -! -t STDIN) and ! $ENV{PERL_MM_USE_DEFAULT} ) { local $ENV{PERL_MM_USE_DEFAULT} = 1; goto &ExtUtils::MakeMaker::prompt; } else { goto &ExtUtils::MakeMaker::prompt; } } # Store a cleaned up version of the MakeMaker version, # since we need to behave differently in a variety of # ways based on the MM version. my $makemaker = eval $ExtUtils::MakeMaker::VERSION; # If we are passed a param, do a "newer than" comparison. # Otherwise, just return the MakeMaker version. sub makemaker { ( @_ < 2 or $makemaker >= eval($_[1]) ) ? $makemaker : 0 } # Ripped from ExtUtils::MakeMaker 6.56, and slightly modified # as we only need to know here whether the attribute is an array # or a hash or something else (which may or may not be appendable). my %makemaker_argtype = ( C => 'ARRAY', CONFIG => 'ARRAY', # CONFIGURE => 'CODE', # ignore DIR => 'ARRAY', DL_FUNCS => 'HASH', DL_VARS => 'ARRAY', EXCLUDE_EXT => 'ARRAY', EXE_FILES => 'ARRAY', FUNCLIST => 'ARRAY', H => 'ARRAY', IMPORTS => 'HASH', INCLUDE_EXT => 'ARRAY', LIBS => 'ARRAY', # ignore '' MAN1PODS => 'HASH', MAN3PODS => 'HASH', META_ADD => 'HASH', META_MERGE => 'HASH', PL_FILES => 'HASH', PM => 'HASH', PMLIBDIRS => 'ARRAY', PMLIBPARENTDIRS => 'ARRAY', PREREQ_PM => 'HASH', CONFIGURE_REQUIRES => 'HASH', SKIP => 'ARRAY', TYPEMAPS => 'ARRAY', XS => 'HASH', # VERSION => ['version',''], # ignore # _KEEP_AFTER_FLUSH => '', clean => 'HASH', depend => 'HASH', dist => 'HASH', dynamic_lib=> 'HASH', linkext => 'HASH', macro => 'HASH', postamble => 'HASH', realclean => 'HASH', test => 'HASH', tool_autosplit => 'HASH', # special cases where you can use makemaker_append CCFLAGS => 'APPENDABLE', DEFINE => 'APPENDABLE', INC => 'APPENDABLE', LDDLFLAGS => 'APPENDABLE', LDFROM => 'APPENDABLE', ); sub makemaker_args { my ($self, %new_args) = @_; my $args = ( $self->{makemaker_args} ||= {} ); foreach my $key (keys %new_args) { if ($makemaker_argtype{$key}) { if ($makemaker_argtype{$key} eq 'ARRAY') { $args->{$key} = [] unless defined $args->{$key}; unless (ref $args->{$key} eq 'ARRAY') { $args->{$key} = [$args->{$key}] } push @{$args->{$key}}, ref $new_args{$key} eq 'ARRAY' ? @{$new_args{$key}} : $new_args{$key}; } elsif ($makemaker_argtype{$key} eq 'HASH') { $args->{$key} = {} unless defined $args->{$key}; foreach my $skey (keys %{ $new_args{$key} }) { $args->{$key}{$skey} = $new_args{$key}{$skey}; } } elsif ($makemaker_argtype{$key} eq 'APPENDABLE') { $self->makemaker_append($key => $new_args{$key}); } } else { if (defined $args->{$key}) { warn qq{MakeMaker attribute "$key" is overriden; use "makemaker_append" to append values\n}; } $args->{$key} = $new_args{$key}; } } return $args; } # For mm args that take multiple space-separated args, # append an argument to the current list. sub makemaker_append { my $self = shift; my $name = shift; my $args = $self->makemaker_args; $args->{$name} = defined $args->{$name} ? join( ' ', $args->{$name}, @_ ) : join( ' ', @_ ); } sub build_subdirs { my $self = shift; my $subdirs = $self->makemaker_args->{DIR} ||= []; for my $subdir (@_) { push @$subdirs, $subdir; } } sub clean_files { my $self = shift; my $clean = $self->makemaker_args->{clean} ||= {}; %$clean = ( %$clean, FILES => join ' ', grep { length $_ } ($clean->{FILES} || (), @_), ); } sub realclean_files { my $self = shift; my $realclean = $self->makemaker_args->{realclean} ||= {}; %$realclean = ( %$realclean, FILES => join ' ', grep { length $_ } ($realclean->{FILES} || (), @_), ); } sub libs { my $self = shift; my $libs = ref $_[0] ? shift : [ shift ]; $self->makemaker_args( LIBS => $libs ); } sub inc { my $self = shift; $self->makemaker_args( INC => shift ); } sub _wanted_t { } sub tests_recursive { my $self = shift; my $dir = shift || 't'; unless ( -d $dir ) { die "tests_recursive dir '$dir' does not exist"; } my %tests = map { $_ => 1 } split / /, ($self->tests || ''); require File::Find; File::Find::find( sub { /\.t$/ and -f $_ and $tests{"$File::Find::dir/*.t"} = 1 }, $dir ); $self->tests( join ' ', sort keys %tests ); } sub write { my $self = shift; die "&Makefile->write() takes no arguments\n" if @_; # Check the current Perl version my $perl_version = $self->perl_version; if ( $perl_version ) { eval "use $perl_version; 1" or die "ERROR: perl: Version $] is installed, " . "but we need version >= $perl_version"; } # Make sure we have a new enough MakeMaker require ExtUtils::MakeMaker; if ( $perl_version and $self->_cmp($perl_version, '5.006') >= 0 ) { # This previous attempted to inherit the version of # ExtUtils::MakeMaker in use by the module author, but this # was found to be untenable as some authors build releases # using future dev versions of EU:MM that nobody else has. # Instead, #toolchain suggests we use 6.59 which is the most # stable version on CPAN at time of writing and is, to quote # ribasushi, "not terminally fucked, > and tested enough". # TODO: We will now need to maintain this over time to push # the version up as new versions are released. $self->build_requires( 'ExtUtils::MakeMaker' => 6.59 ); $self->configure_requires( 'ExtUtils::MakeMaker' => 6.59 ); } else { # Allow legacy-compatibility with 5.005 by depending on the # most recent EU:MM that supported 5.005. $self->build_requires( 'ExtUtils::MakeMaker' => 6.36 ); $self->configure_requires( 'ExtUtils::MakeMaker' => 6.36 ); } # Generate the MakeMaker params my $args = $self->makemaker_args; $args->{DISTNAME} = $self->name; $args->{NAME} = $self->module_name || $self->name; $args->{NAME} =~ s/-/::/g; $args->{VERSION} = $self->version or die <<'EOT'; ERROR: Can't determine distribution version. Please specify it explicitly via 'version' in Makefile.PL, or set a valid $VERSION in a module, and provide its file path via 'version_from' (or 'all_from' if you prefer) in Makefile.PL. EOT if ( $self->tests ) { my @tests = split ' ', $self->tests; my %seen; $args->{test} = { TESTS => (join ' ', grep {!$seen{$_}++} @tests), }; } elsif ( $Module::Install::ExtraTests::use_extratests ) { # Module::Install::ExtraTests doesn't set $self->tests and does its own tests via harness. # So, just ignore our xt tests here. } elsif ( -d 'xt' and ($Module::Install::AUTHOR or $ENV{RELEASE_TESTING}) ) { $args->{test} = { TESTS => join( ' ', map { "$_/*.t" } grep { -d $_ } qw{ t xt } ), }; } if ( $] >= 5.005 ) { $args->{ABSTRACT} = $self->abstract; $args->{AUTHOR} = join ', ', @{$self->author || []}; } if ( $self->makemaker(6.10) ) { $args->{NO_META} = 1; #$args->{NO_MYMETA} = 1; } if ( $self->makemaker(6.17) and $self->sign ) { $args->{SIGN} = 1; } unless ( $self->is_admin ) { delete $args->{SIGN}; } if ( $self->makemaker(6.31) and $self->license ) { $args->{LICENSE} = $self->license; } my $prereq = ($args->{PREREQ_PM} ||= {}); %$prereq = ( %$prereq, map { @$_ } # flatten [module => version] map { @$_ } grep $_, ($self->requires) ); # Remove any reference to perl, PREREQ_PM doesn't support it delete $args->{PREREQ_PM}->{perl}; # Merge both kinds of requires into BUILD_REQUIRES my $build_prereq = ($args->{BUILD_REQUIRES} ||= {}); %$build_prereq = ( %$build_prereq, map { @$_ } # flatten [module => version] map { @$_ } grep $_, ($self->configure_requires, $self->build_requires) ); # Remove any reference to perl, BUILD_REQUIRES doesn't support it delete $args->{BUILD_REQUIRES}->{perl}; # Delete bundled dists from prereq_pm, add it to Makefile DIR my $subdirs = ($args->{DIR} || []); if ($self->bundles) { my %processed; foreach my $bundle (@{ $self->bundles }) { my ($mod_name, $dist_dir) = @$bundle; delete $prereq->{$mod_name}; $dist_dir = File::Basename::basename($dist_dir); # dir for building this module if (not exists $processed{$dist_dir}) { if (-d $dist_dir) { # List as sub-directory to be processed by make push @$subdirs, $dist_dir; } # Else do nothing: the module is already present on the system $processed{$dist_dir} = undef; } } } unless ( $self->makemaker('6.55_03') ) { %$prereq = (%$prereq,%$build_prereq); delete $args->{BUILD_REQUIRES}; } if ( my $perl_version = $self->perl_version ) { eval "use $perl_version; 1" or die "ERROR: perl: Version $] is installed, " . "but we need version >= $perl_version"; if ( $self->makemaker(6.48) ) { $args->{MIN_PERL_VERSION} = $perl_version; } } if ($self->installdirs) { warn qq{old INSTALLDIRS (probably set by makemaker_args) is overriden by installdirs\n} if $args->{INSTALLDIRS}; $args->{INSTALLDIRS} = $self->installdirs; } my %args = map { ( $_ => $args->{$_} ) } grep {defined($args->{$_} ) } keys %$args; my $user_preop = delete $args{dist}->{PREOP}; if ( my $preop = $self->admin->preop($user_preop) ) { foreach my $key ( keys %$preop ) { $args{dist}->{$key} = $preop->{$key}; } } my $mm = ExtUtils::MakeMaker::WriteMakefile(%args); $self->fix_up_makefile($mm->{FIRST_MAKEFILE} || 'Makefile'); } sub fix_up_makefile { my $self = shift; my $makefile_name = shift; my $top_class = ref($self->_top) || ''; my $top_version = $self->_top->VERSION || ''; my $preamble = $self->preamble ? "# Preamble by $top_class $top_version\n" . $self->preamble : ''; my $postamble = "# Postamble by $top_class $top_version\n" . ($self->postamble || ''); local *MAKEFILE; open MAKEFILE, "+< $makefile_name" or die "fix_up_makefile: Couldn't open $makefile_name: $!"; eval { flock MAKEFILE, LOCK_EX }; my $makefile = do { local $/; }; $makefile =~ s/\b(test_harness\(\$\(TEST_VERBOSE\), )/$1'inc', /; $makefile =~ s/( -I\$\(INST_ARCHLIB\))/ -Iinc$1/g; $makefile =~ s/( "-I\$\(INST_LIB\)")/ "-Iinc"$1/g; $makefile =~ s/^(FULLPERL = .*)/$1 "-Iinc"/m; $makefile =~ s/^(PERL = .*)/$1 "-Iinc"/m; # Module::Install will never be used to build the Core Perl # Sometimes PERL_LIB and PERL_ARCHLIB get written anyway, which breaks # PREFIX/PERL5LIB, and thus, install_share. Blank them if they exist $makefile =~ s/^PERL_LIB = .+/PERL_LIB =/m; #$makefile =~ s/^PERL_ARCHLIB = .+/PERL_ARCHLIB =/m; # Perl 5.005 mentions PERL_LIB explicitly, so we have to remove that as well. $makefile =~ s/(\"?)-I\$\(PERL_LIB\)\1//g; # XXX - This is currently unused; not sure if it breaks other MM-users # $makefile =~ s/^pm_to_blib\s+:\s+/pm_to_blib :: /mg; seek MAKEFILE, 0, SEEK_SET; truncate MAKEFILE, 0; print MAKEFILE "$preamble$makefile$postamble" or die $!; close MAKEFILE or die $!; 1; } sub preamble { my ($self, $text) = @_; $self->{preamble} = $text . $self->{preamble} if defined $text; $self->{preamble}; } sub postamble { my ($self, $text) = @_; $self->{postamble} ||= $self->admin->postamble; $self->{postamble} .= $text if defined $text; $self->{postamble} } 1; __END__ #line 544 Message-Passing-0.116/inc/Module/Install/Can.pm0000644000175000017500000000615712472656164021336 0ustar ahartmaiahartmai#line 1 package Module::Install::Can; use strict; use Config (); use ExtUtils::MakeMaker (); use Module::Install::Base (); use vars qw{$VERSION @ISA $ISCORE}; BEGIN { $VERSION = '1.14'; @ISA = 'Module::Install::Base'; $ISCORE = 1; } # check if we can load some module ### Upgrade this to not have to load the module if possible sub can_use { my ($self, $mod, $ver) = @_; $mod =~ s{::|\\}{/}g; $mod .= '.pm' unless $mod =~ /\.pm$/i; my $pkg = $mod; $pkg =~ s{/}{::}g; $pkg =~ s{\.pm$}{}i; local $@; eval { require $mod; $pkg->VERSION($ver || 0); 1 }; } # Check if we can run some command sub can_run { my ($self, $cmd) = @_; my $_cmd = $cmd; return $_cmd if (-x $_cmd or $_cmd = MM->maybe_command($_cmd)); for my $dir ((split /$Config::Config{path_sep}/, $ENV{PATH}), '.') { next if $dir eq ''; require File::Spec; my $abs = File::Spec->catfile($dir, $cmd); return $abs if (-x $abs or $abs = MM->maybe_command($abs)); } return; } # Can our C compiler environment build XS files sub can_xs { my $self = shift; # Ensure we have the CBuilder module $self->configure_requires( 'ExtUtils::CBuilder' => 0.27 ); # Do we have the configure_requires checker? local $@; eval "require ExtUtils::CBuilder;"; if ( $@ ) { # They don't obey configure_requires, so it is # someone old and delicate. Try to avoid hurting # them by falling back to an older simpler test. return $self->can_cc(); } # Do we have a working C compiler my $builder = ExtUtils::CBuilder->new( quiet => 1, ); unless ( $builder->have_compiler ) { # No working C compiler return 0; } # Write a C file representative of what XS becomes require File::Temp; my ( $FH, $tmpfile ) = File::Temp::tempfile( "compilexs-XXXXX", SUFFIX => '.c', ); binmode $FH; print $FH <<'END_C'; #include "EXTERN.h" #include "perl.h" #include "XSUB.h" int main(int argc, char **argv) { return 0; } int boot_sanexs() { return 1; } END_C close $FH; # Can the C compiler access the same headers XS does my @libs = (); my $object = undef; eval { local $^W = 0; $object = $builder->compile( source => $tmpfile, ); @libs = $builder->link( objects => $object, module_name => 'sanexs', ); }; my $result = $@ ? 0 : 1; # Clean up all the build files foreach ( $tmpfile, $object, @libs ) { next unless defined $_; 1 while unlink; } return $result; } # Can we locate a (the) C compiler sub can_cc { my $self = shift; my @chunks = split(/ /, $Config::Config{cc}) or return; # $Config{cc} may contain args; try to find out the program part while (@chunks) { return $self->can_run("@chunks") || (pop(@chunks), next); } return; } # Fix Cygwin bug on maybe_command(); if ( $^O eq 'cygwin' ) { require ExtUtils::MM_Cygwin; require ExtUtils::MM_Win32; if ( ! defined(&ExtUtils::MM_Cygwin::maybe_command) ) { *ExtUtils::MM_Cygwin::maybe_command = sub { my ($self, $file) = @_; if ($file =~ m{^/cygdrive/}i and ExtUtils::MM_Win32->can('maybe_command')) { ExtUtils::MM_Win32->maybe_command($file); } else { ExtUtils::MM_Unix->maybe_command($file); } } } } 1; __END__ #line 236 Message-Passing-0.116/inc/Module/Install/Base.pm0000644000175000017500000000214712472656164021502 0ustar ahartmaiahartmai#line 1 package Module::Install::Base; use strict 'vars'; use vars qw{$VERSION}; BEGIN { $VERSION = '1.14'; } # Suspend handler for "redefined" warnings BEGIN { my $w = $SIG{__WARN__}; $SIG{__WARN__} = sub { $w }; } #line 42 sub new { my $class = shift; unless ( defined &{"${class}::call"} ) { *{"${class}::call"} = sub { shift->_top->call(@_) }; } unless ( defined &{"${class}::load"} ) { *{"${class}::load"} = sub { shift->_top->load(@_) }; } bless { @_ }, $class; } #line 61 sub AUTOLOAD { local $@; my $func = eval { shift->_top->autoload } or return; goto &$func; } #line 75 sub _top { $_[0]->{_top}; } #line 90 sub admin { $_[0]->_top->{admin} or Module::Install::Base::FakeAdmin->new; } #line 106 sub is_admin { ! $_[0]->admin->isa('Module::Install::Base::FakeAdmin'); } sub DESTROY {} package Module::Install::Base::FakeAdmin; use vars qw{$VERSION}; BEGIN { $VERSION = $Module::Install::Base::VERSION; } my $fake; sub new { $fake ||= bless(\@_, $_[0]); } sub AUTOLOAD {} sub DESTROY {} # Restore warning handler BEGIN { $SIG{__WARN__} = $SIG{__WARN__}->(); } 1; #line 159 Message-Passing-0.116/inc/Module/Install/Fetch.pm0000644000175000017500000000462712472656164021666 0ustar ahartmaiahartmai#line 1 package Module::Install::Fetch; use strict; use Module::Install::Base (); use vars qw{$VERSION @ISA $ISCORE}; BEGIN { $VERSION = '1.14'; @ISA = 'Module::Install::Base'; $ISCORE = 1; } sub get_file { my ($self, %args) = @_; my ($scheme, $host, $path, $file) = $args{url} =~ m|^(\w+)://([^/]+)(.+)/(.+)| or return; if ( $scheme eq 'http' and ! eval { require LWP::Simple; 1 } ) { $args{url} = $args{ftp_url} or (warn("LWP support unavailable!\n"), return); ($scheme, $host, $path, $file) = $args{url} =~ m|^(\w+)://([^/]+)(.+)/(.+)| or return; } $|++; print "Fetching '$file' from $host... "; unless (eval { require Socket; Socket::inet_aton($host) }) { warn "'$host' resolve failed!\n"; return; } return unless $scheme eq 'ftp' or $scheme eq 'http'; require Cwd; my $dir = Cwd::getcwd(); chdir $args{local_dir} or return if exists $args{local_dir}; if (eval { require LWP::Simple; 1 }) { LWP::Simple::mirror($args{url}, $file); } elsif (eval { require Net::FTP; 1 }) { eval { # use Net::FTP to get past firewall my $ftp = Net::FTP->new($host, Passive => 1, Timeout => 600); $ftp->login("anonymous", 'anonymous@example.com'); $ftp->cwd($path); $ftp->binary; $ftp->get($file) or (warn("$!\n"), return); $ftp->quit; } } elsif (my $ftp = $self->can_run('ftp')) { eval { # no Net::FTP, fallback to ftp.exe require FileHandle; my $fh = FileHandle->new; local $SIG{CHLD} = 'IGNORE'; unless ($fh->open("|$ftp -n")) { warn "Couldn't open ftp: $!\n"; chdir $dir; return; } my @dialog = split(/\n/, <<"END_FTP"); open $host user anonymous anonymous\@example.com cd $path binary get $file $file quit END_FTP foreach (@dialog) { $fh->print("$_\n") } $fh->close; } } else { warn "No working 'ftp' program available!\n"; chdir $dir; return; } unless (-f $file) { warn "Fetching failed: $@\n"; chdir $dir; return; } return if exists $args{size} and -s $file != $args{size}; system($args{run}) if exists $args{run}; unlink($file) if $args{remove}; print(((!exists $args{check_for} or -e $args{check_for}) ? "done!" : "failed! ($!)"), "\n"); chdir $dir; return !$?; } 1; Message-Passing-0.116/inc/Module/Install/AuthorRequires.pm0000644000175000017500000000113112472656164023602 0ustar ahartmaiahartmai#line 1 use strict; use warnings; package Module::Install::AuthorRequires; use base 'Module::Install::Base'; # cargo cult BEGIN { our $VERSION = '0.02'; our $ISCORE = 1; } sub author_requires { my $self = shift; return $self->{values}->{author_requires} unless @_; my @added; while (@_) { my $mod = shift or last; my $version = shift || 0; push @added, [$mod => $version]; } push @{ $self->{values}->{author_requires} }, @added; $self->admin->author_requires(@added); return map { @$_ } @added; } 1; __END__ #line 92 Message-Passing-0.116/inc/Module/Install/Scripts.pm0000644000175000017500000000101112472656164022244 0ustar ahartmaiahartmai#line 1 package Module::Install::Scripts; use strict 'vars'; use Module::Install::Base (); use vars qw{$VERSION @ISA $ISCORE}; BEGIN { $VERSION = '1.14'; @ISA = 'Module::Install::Base'; $ISCORE = 1; } sub install_script { my $self = shift; my $args = $self->makemaker_args; my $exe = $args->{EXE_FILES} ||= []; foreach ( @_ ) { if ( -f $_ ) { push @$exe, $_; } elsif ( -d 'script' and -f "script/$_" ) { push @$exe, "script/$_"; } else { die("Cannot find script '$_'"); } } } 1; Message-Passing-0.116/inc/Module/Install/Win32.pm0000644000175000017500000000340312472656164021526 0ustar ahartmaiahartmai#line 1 package Module::Install::Win32; use strict; use Module::Install::Base (); use vars qw{$VERSION @ISA $ISCORE}; BEGIN { $VERSION = '1.14'; @ISA = 'Module::Install::Base'; $ISCORE = 1; } # determine if the user needs nmake, and download it if needed sub check_nmake { my $self = shift; $self->load('can_run'); $self->load('get_file'); require Config; return unless ( $^O eq 'MSWin32' and $Config::Config{make} and $Config::Config{make} =~ /^nmake\b/i and ! $self->can_run('nmake') ); print "The required 'nmake' executable not found, fetching it...\n"; require File::Basename; my $rv = $self->get_file( url => 'http://download.microsoft.com/download/vc15/Patch/1.52/W95/EN-US/Nmake15.exe', ftp_url => 'ftp://ftp.microsoft.com/Softlib/MSLFILES/Nmake15.exe', local_dir => File::Basename::dirname($^X), size => 51928, run => 'Nmake15.exe /o > nul', check_for => 'Nmake.exe', remove => 1, ); die <<'END_MESSAGE' unless $rv; ------------------------------------------------------------------------------- Since you are using Microsoft Windows, you will need the 'nmake' utility before installation. It's available at: http://download.microsoft.com/download/vc15/Patch/1.52/W95/EN-US/Nmake15.exe or ftp://ftp.microsoft.com/Softlib/MSLFILES/Nmake15.exe Please download the file manually, save it to a directory in %PATH% (e.g. C:\WINDOWS\COMMAND\), then launch the MS-DOS command line shell, "cd" to that directory, and run "Nmake15.exe" from there; that will create the 'nmake.exe' file needed by this module. You may then resume the installation process described in README. ------------------------------------------------------------------------------- END_MESSAGE } 1; Message-Passing-0.116/inc/Module/Install/WriteAll.pm0000644000175000017500000000237612472656164022357 0ustar ahartmaiahartmai#line 1 package Module::Install::WriteAll; use strict; use Module::Install::Base (); use vars qw{$VERSION @ISA $ISCORE}; BEGIN { $VERSION = '1.14'; @ISA = qw{Module::Install::Base}; $ISCORE = 1; } sub WriteAll { my $self = shift; my %args = ( meta => 1, sign => 0, inline => 0, check_nmake => 1, @_, ); $self->sign(1) if $args{sign}; $self->admin->WriteAll(%args) if $self->is_admin; $self->check_nmake if $args{check_nmake}; unless ( $self->makemaker_args->{PL_FILES} ) { # XXX: This still may be a bit over-defensive... unless ($self->makemaker(6.25)) { $self->makemaker_args( PL_FILES => {} ) if -f 'Build.PL'; } } # Until ExtUtils::MakeMaker support MYMETA.yml, make sure # we clean it up properly ourself. $self->realclean_files('MYMETA.yml'); if ( $args{inline} ) { $self->Inline->write; } else { $self->Makefile->write; } # The Makefile write process adds a couple of dependencies, # so write the META.yml files after the Makefile. if ( $args{meta} ) { $self->Meta->write; } # Experimental support for MYMETA if ( $ENV{X_MYMETA} ) { if ( $ENV{X_MYMETA} eq 'JSON' ) { $self->Meta->write_mymeta_json; } else { $self->Meta->write_mymeta_yaml; } } return 1; } 1; Message-Passing-0.116/inc/Module/Install/AuthorTests.pm0000644000175000017500000000221512472656164023111 0ustar ahartmaiahartmai#line 1 package Module::Install::AuthorTests; use 5.005; use strict; use Module::Install::Base; use Carp (); #line 16 use vars qw{$VERSION $ISCORE @ISA}; BEGIN { $VERSION = '0.002'; $ISCORE = 1; @ISA = qw{Module::Install::Base}; } #line 42 sub author_tests { my ($self, @dirs) = @_; _add_author_tests($self, \@dirs, 0); } #line 56 sub recursive_author_tests { my ($self, @dirs) = @_; _add_author_tests($self, \@dirs, 1); } sub _wanted { my $href = shift; sub { /\.t$/ and -f $_ and $href->{$File::Find::dir} = 1 } } sub _add_author_tests { my ($self, $dirs, $recurse) = @_; return unless $Module::Install::AUTHOR; my @tests = $self->tests ? (split / /, $self->tests) : 't/*.t'; # XXX: pick a default, later -- rjbs, 2008-02-24 my @dirs = @$dirs ? @$dirs : Carp::confess "no dirs given to author_tests"; @dirs = grep { -d } @dirs; if ($recurse) { require File::Find; my %test_dir; File::Find::find(_wanted(\%test_dir), @dirs); $self->tests( join ' ', @tests, map { "$_/*.t" } sort keys %test_dir ); } else { $self->tests( join ' ', @tests, map { "$_/*.t" } sort @dirs ); } } #line 107 1; Message-Passing-0.116/inc/Module/Install/Metadata.pm0000644000175000017500000004330212472656164022346 0ustar ahartmaiahartmai#line 1 package Module::Install::Metadata; use strict 'vars'; use Module::Install::Base (); use vars qw{$VERSION @ISA $ISCORE}; BEGIN { $VERSION = '1.14'; @ISA = 'Module::Install::Base'; $ISCORE = 1; } my @boolean_keys = qw{ sign }; my @scalar_keys = qw{ name module_name abstract version distribution_type tests installdirs }; my @tuple_keys = qw{ configure_requires build_requires requires recommends bundles resources }; my @resource_keys = qw{ homepage bugtracker repository }; my @array_keys = qw{ keywords author }; *authors = \&author; sub Meta { shift } sub Meta_BooleanKeys { @boolean_keys } sub Meta_ScalarKeys { @scalar_keys } sub Meta_TupleKeys { @tuple_keys } sub Meta_ResourceKeys { @resource_keys } sub Meta_ArrayKeys { @array_keys } foreach my $key ( @boolean_keys ) { *$key = sub { my $self = shift; if ( defined wantarray and not @_ ) { return $self->{values}->{$key}; } $self->{values}->{$key} = ( @_ ? $_[0] : 1 ); return $self; }; } foreach my $key ( @scalar_keys ) { *$key = sub { my $self = shift; return $self->{values}->{$key} if defined wantarray and !@_; $self->{values}->{$key} = shift; return $self; }; } foreach my $key ( @array_keys ) { *$key = sub { my $self = shift; return $self->{values}->{$key} if defined wantarray and !@_; $self->{values}->{$key} ||= []; push @{$self->{values}->{$key}}, @_; return $self; }; } foreach my $key ( @resource_keys ) { *$key = sub { my $self = shift; unless ( @_ ) { return () unless $self->{values}->{resources}; return map { $_->[1] } grep { $_->[0] eq $key } @{ $self->{values}->{resources} }; } return $self->{values}->{resources}->{$key} unless @_; my $uri = shift or die( "Did not provide a value to $key()" ); $self->resources( $key => $uri ); return 1; }; } foreach my $key ( grep { $_ ne "resources" } @tuple_keys) { *$key = sub { my $self = shift; return $self->{values}->{$key} unless @_; my @added; while ( @_ ) { my $module = shift or last; my $version = shift || 0; push @added, [ $module, $version ]; } push @{ $self->{values}->{$key} }, @added; return map {@$_} @added; }; } # Resource handling my %lc_resource = map { $_ => 1 } qw{ homepage license bugtracker repository }; sub resources { my $self = shift; while ( @_ ) { my $name = shift or last; my $value = shift or next; if ( $name eq lc $name and ! $lc_resource{$name} ) { die("Unsupported reserved lowercase resource '$name'"); } $self->{values}->{resources} ||= []; push @{ $self->{values}->{resources} }, [ $name, $value ]; } $self->{values}->{resources}; } # Aliases for build_requires that will have alternative # meanings in some future version of META.yml. sub test_requires { shift->build_requires(@_) } sub install_requires { shift->build_requires(@_) } # Aliases for installdirs options sub install_as_core { $_[0]->installdirs('perl') } sub install_as_cpan { $_[0]->installdirs('site') } sub install_as_site { $_[0]->installdirs('site') } sub install_as_vendor { $_[0]->installdirs('vendor') } sub dynamic_config { my $self = shift; my $value = @_ ? shift : 1; if ( $self->{values}->{dynamic_config} ) { # Once dynamic we never change to static, for safety return 0; } $self->{values}->{dynamic_config} = $value ? 1 : 0; return 1; } # Convenience command sub static_config { shift->dynamic_config(0); } sub perl_version { my $self = shift; return $self->{values}->{perl_version} unless @_; my $version = shift or die( "Did not provide a value to perl_version()" ); # Normalize the version $version = $self->_perl_version($version); # We don't support the really old versions unless ( $version >= 5.005 ) { die "Module::Install only supports 5.005 or newer (use ExtUtils::MakeMaker)\n"; } $self->{values}->{perl_version} = $version; } sub all_from { my ( $self, $file ) = @_; unless ( defined($file) ) { my $name = $self->name or die( "all_from called with no args without setting name() first" ); $file = join('/', 'lib', split(/-/, $name)) . '.pm'; $file =~ s{.*/}{} unless -e $file; unless ( -e $file ) { die("all_from cannot find $file from $name"); } } unless ( -f $file ) { die("The path '$file' does not exist, or is not a file"); } $self->{values}{all_from} = $file; # Some methods pull from POD instead of code. # If there is a matching .pod, use that instead my $pod = $file; $pod =~ s/\.pm$/.pod/i; $pod = $file unless -e $pod; # Pull the different values $self->name_from($file) unless $self->name; $self->version_from($file) unless $self->version; $self->perl_version_from($file) unless $self->perl_version; $self->author_from($pod) unless @{$self->author || []}; $self->license_from($pod) unless $self->license; $self->abstract_from($pod) unless $self->abstract; return 1; } sub provides { my $self = shift; my $provides = ( $self->{values}->{provides} ||= {} ); %$provides = (%$provides, @_) if @_; return $provides; } sub auto_provides { my $self = shift; return $self unless $self->is_admin; unless (-e 'MANIFEST') { warn "Cannot deduce auto_provides without a MANIFEST, skipping\n"; return $self; } # Avoid spurious warnings as we are not checking manifest here. local $SIG{__WARN__} = sub {1}; require ExtUtils::Manifest; local *ExtUtils::Manifest::manicheck = sub { return }; require Module::Build; my $build = Module::Build->new( dist_name => $self->name, dist_version => $self->version, license => $self->license, ); $self->provides( %{ $build->find_dist_packages || {} } ); } sub feature { my $self = shift; my $name = shift; my $features = ( $self->{values}->{features} ||= [] ); my $mods; if ( @_ == 1 and ref( $_[0] ) ) { # The user used ->feature like ->features by passing in the second # argument as a reference. Accomodate for that. $mods = $_[0]; } else { $mods = \@_; } my $count = 0; push @$features, ( $name => [ map { ref($_) ? ( ref($_) eq 'HASH' ) ? %$_ : @$_ : $_ } @$mods ] ); return @$features; } sub features { my $self = shift; while ( my ( $name, $mods ) = splice( @_, 0, 2 ) ) { $self->feature( $name, @$mods ); } return $self->{values}->{features} ? @{ $self->{values}->{features} } : (); } sub no_index { my $self = shift; my $type = shift; push @{ $self->{values}->{no_index}->{$type} }, @_ if $type; return $self->{values}->{no_index}; } sub read { my $self = shift; $self->include_deps( 'YAML::Tiny', 0 ); require YAML::Tiny; my $data = YAML::Tiny::LoadFile('META.yml'); # Call methods explicitly in case user has already set some values. while ( my ( $key, $value ) = each %$data ) { next unless $self->can($key); if ( ref $value eq 'HASH' ) { while ( my ( $module, $version ) = each %$value ) { $self->can($key)->($self, $module => $version ); } } else { $self->can($key)->($self, $value); } } return $self; } sub write { my $self = shift; return $self unless $self->is_admin; $self->admin->write_meta; return $self; } sub version_from { require ExtUtils::MM_Unix; my ( $self, $file ) = @_; $self->version( ExtUtils::MM_Unix->parse_version($file) ); # for version integrity check $self->makemaker_args( VERSION_FROM => $file ); } sub abstract_from { require ExtUtils::MM_Unix; my ( $self, $file ) = @_; $self->abstract( bless( { DISTNAME => $self->name }, 'ExtUtils::MM_Unix' )->parse_abstract($file) ); } # Add both distribution and module name sub name_from { my ($self, $file) = @_; if ( Module::Install::_read($file) =~ m/ ^ \s* package \s* ([\w:]+) [\s|;]* /ixms ) { my ($name, $module_name) = ($1, $1); $name =~ s{::}{-}g; $self->name($name); unless ( $self->module_name ) { $self->module_name($module_name); } } else { die("Cannot determine name from $file\n"); } } sub _extract_perl_version { if ( $_[0] =~ m/ ^\s* (?:use|require) \s* v? ([\d_\.]+) \s* ; /ixms ) { my $perl_version = $1; $perl_version =~ s{_}{}g; return $perl_version; } else { return; } } sub perl_version_from { my $self = shift; my $perl_version=_extract_perl_version(Module::Install::_read($_[0])); if ($perl_version) { $self->perl_version($perl_version); } else { warn "Cannot determine perl version info from $_[0]\n"; return; } } sub author_from { my $self = shift; my $content = Module::Install::_read($_[0]); if ($content =~ m/ =head \d \s+ (?:authors?)\b \s* ([^\n]*) | =head \d \s+ (?:licen[cs]e|licensing|copyright|legal)\b \s* .*? copyright .*? \d\d\d[\d.]+ \s* (?:\bby\b)? \s* ([^\n]*) /ixms) { my $author = $1 || $2; # XXX: ugly but should work anyway... if (eval "require Pod::Escapes; 1") { # Pod::Escapes has a mapping table. # It's in core of perl >= 5.9.3, and should be installed # as one of the Pod::Simple's prereqs, which is a prereq # of Pod::Text 3.x (see also below). $author =~ s{ E<( (\d+) | ([A-Za-z]+) )> } { defined $2 ? chr($2) : defined $Pod::Escapes::Name2character_number{$1} ? chr($Pod::Escapes::Name2character_number{$1}) : do { warn "Unknown escape: E<$1>"; "E<$1>"; }; }gex; } elsif (eval "require Pod::Text; 1" && $Pod::Text::VERSION < 3) { # Pod::Text < 3.0 has yet another mapping table, # though the table name of 2.x and 1.x are different. # (1.x is in core of Perl < 5.6, 2.x is in core of # Perl < 5.9.3) my $mapping = ($Pod::Text::VERSION < 2) ? \%Pod::Text::HTML_Escapes : \%Pod::Text::ESCAPES; $author =~ s{ E<( (\d+) | ([A-Za-z]+) )> } { defined $2 ? chr($2) : defined $mapping->{$1} ? $mapping->{$1} : do { warn "Unknown escape: E<$1>"; "E<$1>"; }; }gex; } else { $author =~ s{E}{<}g; $author =~ s{E}{>}g; } $self->author($author); } else { warn "Cannot determine author info from $_[0]\n"; } } #Stolen from M::B my %license_urls = ( perl => 'http://dev.perl.org/licenses/', apache => 'http://apache.org/licenses/LICENSE-2.0', apache_1_1 => 'http://apache.org/licenses/LICENSE-1.1', artistic => 'http://opensource.org/licenses/artistic-license.php', artistic_2 => 'http://opensource.org/licenses/artistic-license-2.0.php', lgpl => 'http://opensource.org/licenses/lgpl-license.php', lgpl2 => 'http://opensource.org/licenses/lgpl-2.1.php', lgpl3 => 'http://opensource.org/licenses/lgpl-3.0.html', bsd => 'http://opensource.org/licenses/bsd-license.php', gpl => 'http://opensource.org/licenses/gpl-license.php', gpl2 => 'http://opensource.org/licenses/gpl-2.0.php', gpl3 => 'http://opensource.org/licenses/gpl-3.0.html', mit => 'http://opensource.org/licenses/mit-license.php', mozilla => 'http://opensource.org/licenses/mozilla1.1.php', open_source => undef, unrestricted => undef, restrictive => undef, unknown => undef, ); sub license { my $self = shift; return $self->{values}->{license} unless @_; my $license = shift or die( 'Did not provide a value to license()' ); $license = __extract_license($license) || lc $license; $self->{values}->{license} = $license; # Automatically fill in license URLs if ( $license_urls{$license} ) { $self->resources( license => $license_urls{$license} ); } return 1; } sub _extract_license { my $pod = shift; my $matched; return __extract_license( ($matched) = $pod =~ m/ (=head \d \s+ L(?i:ICEN[CS]E|ICENSING)\b.*?) (=head \d.*|=cut.*|)\z /xms ) || __extract_license( ($matched) = $pod =~ m/ (=head \d \s+ (?:C(?i:OPYRIGHTS?)|L(?i:EGAL))\b.*?) (=head \d.*|=cut.*|)\z /xms ); } sub __extract_license { my $license_text = shift or return; my @phrases = ( '(?:under )?the same (?:terms|license) as (?:perl|the perl (?:\d )?programming language)' => 'perl', 1, '(?:under )?the terms of (?:perl|the perl programming language) itself' => 'perl', 1, 'Artistic and GPL' => 'perl', 1, 'GNU general public license' => 'gpl', 1, 'GNU public license' => 'gpl', 1, 'GNU lesser general public license' => 'lgpl', 1, 'GNU lesser public license' => 'lgpl', 1, 'GNU library general public license' => 'lgpl', 1, 'GNU library public license' => 'lgpl', 1, 'GNU Free Documentation license' => 'unrestricted', 1, 'GNU Affero General Public License' => 'open_source', 1, '(?:Free)?BSD license' => 'bsd', 1, 'Artistic license 2\.0' => 'artistic_2', 1, 'Artistic license' => 'artistic', 1, 'Apache (?:Software )?license' => 'apache', 1, 'GPL' => 'gpl', 1, 'LGPL' => 'lgpl', 1, 'BSD' => 'bsd', 1, 'Artistic' => 'artistic', 1, 'MIT' => 'mit', 1, 'Mozilla Public License' => 'mozilla', 1, 'Q Public License' => 'open_source', 1, 'OpenSSL License' => 'unrestricted', 1, 'SSLeay License' => 'unrestricted', 1, 'zlib License' => 'open_source', 1, 'proprietary' => 'proprietary', 0, ); while ( my ($pattern, $license, $osi) = splice(@phrases, 0, 3) ) { $pattern =~ s#\s+#\\s+#gs; if ( $license_text =~ /\b$pattern\b/i ) { return $license; } } return ''; } sub license_from { my $self = shift; if (my $license=_extract_license(Module::Install::_read($_[0]))) { $self->license($license); } else { warn "Cannot determine license info from $_[0]\n"; return 'unknown'; } } sub _extract_bugtracker { my @links = $_[0] =~ m#L<( https?\Q://rt.cpan.org/\E[^>]+| https?\Q://github.com/\E[\w_]+/[\w_]+/issues| https?\Q://code.google.com/p/\E[\w_\-]+/issues/list )>#gx; my %links; @links{@links}=(); @links=keys %links; return @links; } sub bugtracker_from { my $self = shift; my $content = Module::Install::_read($_[0]); my @links = _extract_bugtracker($content); unless ( @links ) { warn "Cannot determine bugtracker info from $_[0]\n"; return 0; } if ( @links > 1 ) { warn "Found more than one bugtracker link in $_[0]\n"; return 0; } # Set the bugtracker bugtracker( $links[0] ); return 1; } sub requires_from { my $self = shift; my $content = Module::Install::_readperl($_[0]); my @requires = $content =~ m/^use\s+([^\W\d]\w*(?:::\w+)*)\s+(v?[\d\.]+)/mg; while ( @requires ) { my $module = shift @requires; my $version = shift @requires; $self->requires( $module => $version ); } } sub test_requires_from { my $self = shift; my $content = Module::Install::_readperl($_[0]); my @requires = $content =~ m/^use\s+([^\W\d]\w*(?:::\w+)*)\s+([\d\.]+)/mg; while ( @requires ) { my $module = shift @requires; my $version = shift @requires; $self->test_requires( $module => $version ); } } # Convert triple-part versions (eg, 5.6.1 or 5.8.9) to # numbers (eg, 5.006001 or 5.008009). # Also, convert double-part versions (eg, 5.8) sub _perl_version { my $v = $_[-1]; $v =~ s/^([1-9])\.([1-9]\d?\d?)$/sprintf("%d.%03d",$1,$2)/e; $v =~ s/^([1-9])\.([1-9]\d?\d?)\.(0|[1-9]\d?\d?)$/sprintf("%d.%03d%03d",$1,$2,$3 || 0)/e; $v =~ s/(\.\d\d\d)000$/$1/; $v =~ s/_.+$//; if ( ref($v) ) { # Numify $v = $v + 0; } return $v; } sub add_metadata { my $self = shift; my %hash = @_; for my $key (keys %hash) { warn "add_metadata: $key is not prefixed with 'x_'.\n" . "Use appopriate function to add non-private metadata.\n" unless $key =~ /^x_/; $self->{values}->{$key} = $hash{$key}; } } ###################################################################### # MYMETA Support sub WriteMyMeta { die "WriteMyMeta has been deprecated"; } sub write_mymeta_yaml { my $self = shift; # We need YAML::Tiny to write the MYMETA.yml file unless ( eval { require YAML::Tiny; 1; } ) { return 1; } # Generate the data my $meta = $self->_write_mymeta_data or return 1; # Save as the MYMETA.yml file print "Writing MYMETA.yml\n"; YAML::Tiny::DumpFile('MYMETA.yml', $meta); } sub write_mymeta_json { my $self = shift; # We need JSON to write the MYMETA.json file unless ( eval { require JSON; 1; } ) { return 1; } # Generate the data my $meta = $self->_write_mymeta_data or return 1; # Save as the MYMETA.yml file print "Writing MYMETA.json\n"; Module::Install::_write( 'MYMETA.json', JSON->new->pretty(1)->canonical->encode($meta), ); } sub _write_mymeta_data { my $self = shift; # If there's no existing META.yml there is nothing we can do return undef unless -f 'META.yml'; # We need Parse::CPAN::Meta to load the file unless ( eval { require Parse::CPAN::Meta; 1; } ) { return undef; } # Merge the perl version into the dependencies my $val = $self->Meta->{values}; my $perl = delete $val->{perl_version}; if ( $perl ) { $val->{requires} ||= []; my $requires = $val->{requires}; # Canonize to three-dot version after Perl 5.6 if ( $perl >= 5.006 ) { $perl =~ s{^(\d+)\.(\d\d\d)(\d*)}{join('.', $1, int($2||0), int($3||0))}e } unshift @$requires, [ perl => $perl ]; } # Load the advisory META.yml file my @yaml = Parse::CPAN::Meta::LoadFile('META.yml'); my $meta = $yaml[0]; # Overwrite the non-configure dependency hashes delete $meta->{requires}; delete $meta->{build_requires}; delete $meta->{recommends}; if ( exists $val->{requires} ) { $meta->{requires} = { map { @$_ } @{ $val->{requires} } }; } if ( exists $val->{build_requires} ) { $meta->{build_requires} = { map { @$_ } @{ $val->{build_requires} } }; } return $meta; } 1; Message-Passing-0.116/inc/Module/Install/Authority.pm0000644000175000017500000000044412472656164022616 0ustar ahartmaiahartmai#line 1 package Module::Install::Authority; use strict; use warnings; use base qw/Module::Install::Base/; our $VERSION = '0.03'; $VERSION = eval $VERSION; sub authority { my $self = shift; my $pause_id = shift; $self->Meta->{values}->{x_authority} = $pause_id; } 1; #line 69 Message-Passing-0.116/inc/Module/Install.pm0000644000175000017500000003021712472656164020627 0ustar ahartmaiahartmai#line 1 package Module::Install; # For any maintainers: # The load order for Module::Install is a bit magic. # It goes something like this... # # IF ( host has Module::Install installed, creating author mode ) { # 1. Makefile.PL calls "use inc::Module::Install" # 2. $INC{inc/Module/Install.pm} set to installed version of inc::Module::Install # 3. The installed version of inc::Module::Install loads # 4. inc::Module::Install calls "require Module::Install" # 5. The ./inc/ version of Module::Install loads # } ELSE { # 1. Makefile.PL calls "use inc::Module::Install" # 2. $INC{inc/Module/Install.pm} set to ./inc/ version of Module::Install # 3. The ./inc/ version of Module::Install loads # } use 5.006; use strict 'vars'; use Cwd (); use File::Find (); use File::Path (); use vars qw{$VERSION $MAIN}; BEGIN { # All Module::Install core packages now require synchronised versions. # This will be used to ensure we don't accidentally load old or # different versions of modules. # This is not enforced yet, but will be some time in the next few # releases once we can make sure it won't clash with custom # Module::Install extensions. $VERSION = '1.14'; # Storage for the pseudo-singleton $MAIN = undef; *inc::Module::Install::VERSION = *VERSION; @inc::Module::Install::ISA = __PACKAGE__; } sub import { my $class = shift; my $self = $class->new(@_); my $who = $self->_caller; #------------------------------------------------------------- # all of the following checks should be included in import(), # to allow "eval 'require Module::Install; 1' to test # installation of Module::Install. (RT #51267) #------------------------------------------------------------- # Whether or not inc::Module::Install is actually loaded, the # $INC{inc/Module/Install.pm} is what will still get set as long as # the caller loaded module this in the documented manner. # If not set, the caller may NOT have loaded the bundled version, and thus # they may not have a MI version that works with the Makefile.PL. This would # result in false errors or unexpected behaviour. And we don't want that. my $file = join( '/', 'inc', split /::/, __PACKAGE__ ) . '.pm'; unless ( $INC{$file} ) { die <<"END_DIE" } Please invoke ${\__PACKAGE__} with: use inc::${\__PACKAGE__}; not: use ${\__PACKAGE__}; END_DIE # This reportedly fixes a rare Win32 UTC file time issue, but # as this is a non-cross-platform XS module not in the core, # we shouldn't really depend on it. See RT #24194 for detail. # (Also, this module only supports Perl 5.6 and above). eval "use Win32::UTCFileTime" if $^O eq 'MSWin32' && $] >= 5.006; # If the script that is loading Module::Install is from the future, # then make will detect this and cause it to re-run over and over # again. This is bad. Rather than taking action to touch it (which # is unreliable on some platforms and requires write permissions) # for now we should catch this and refuse to run. if ( -f $0 ) { my $s = (stat($0))[9]; # If the modification time is only slightly in the future, # sleep briefly to remove the problem. my $a = $s - time; if ( $a > 0 and $a < 5 ) { sleep 5 } # Too far in the future, throw an error. my $t = time; if ( $s > $t ) { die <<"END_DIE" } Your installer $0 has a modification time in the future ($s > $t). This is known to create infinite loops in make. Please correct this, then run $0 again. END_DIE } # Build.PL was formerly supported, but no longer is due to excessive # difficulty in implementing every single feature twice. if ( $0 =~ /Build.PL$/i ) { die <<"END_DIE" } Module::Install no longer supports Build.PL. It was impossible to maintain duel backends, and has been deprecated. Please remove all Build.PL files and only use the Makefile.PL installer. END_DIE #------------------------------------------------------------- # To save some more typing in Module::Install installers, every... # use inc::Module::Install # ...also acts as an implicit use strict. $^H |= strict::bits(qw(refs subs vars)); #------------------------------------------------------------- unless ( -f $self->{file} ) { foreach my $key (keys %INC) { delete $INC{$key} if $key =~ /Module\/Install/; } local $^W; require "$self->{path}/$self->{dispatch}.pm"; File::Path::mkpath("$self->{prefix}/$self->{author}"); $self->{admin} = "$self->{name}::$self->{dispatch}"->new( _top => $self ); $self->{admin}->init; @_ = ($class, _self => $self); goto &{"$self->{name}::import"}; } local $^W; *{"${who}::AUTOLOAD"} = $self->autoload; $self->preload; # Unregister loader and worker packages so subdirs can use them again delete $INC{'inc/Module/Install.pm'}; delete $INC{'Module/Install.pm'}; # Save to the singleton $MAIN = $self; return 1; } sub autoload { my $self = shift; my $who = $self->_caller; my $cwd = Cwd::getcwd(); my $sym = "${who}::AUTOLOAD"; $sym->{$cwd} = sub { my $pwd = Cwd::getcwd(); if ( my $code = $sym->{$pwd} ) { # Delegate back to parent dirs goto &$code unless $cwd eq $pwd; } unless ($$sym =~ s/([^:]+)$//) { # XXX: it looks like we can't retrieve the missing function # via $$sym (usually $main::AUTOLOAD) in this case. # I'm still wondering if we should slurp Makefile.PL to # get some context or not ... my ($package, $file, $line) = caller; die <<"EOT"; Unknown function is found at $file line $line. Execution of $file aborted due to runtime errors. If you're a contributor to a project, you may need to install some Module::Install extensions from CPAN (or other repository). If you're a user of a module, please contact the author. EOT } my $method = $1; if ( uc($method) eq $method ) { # Do nothing return; } elsif ( $method =~ /^_/ and $self->can($method) ) { # Dispatch to the root M:I class return $self->$method(@_); } # Dispatch to the appropriate plugin unshift @_, ( $self, $1 ); goto &{$self->can('call')}; }; } sub preload { my $self = shift; unless ( $self->{extensions} ) { $self->load_extensions( "$self->{prefix}/$self->{path}", $self ); } my @exts = @{$self->{extensions}}; unless ( @exts ) { @exts = $self->{admin}->load_all_extensions; } my %seen; foreach my $obj ( @exts ) { while (my ($method, $glob) = each %{ref($obj) . '::'}) { next unless $obj->can($method); next if $method =~ /^_/; next if $method eq uc($method); $seen{$method}++; } } my $who = $self->_caller; foreach my $name ( sort keys %seen ) { local $^W; *{"${who}::$name"} = sub { ${"${who}::AUTOLOAD"} = "${who}::$name"; goto &{"${who}::AUTOLOAD"}; }; } } sub new { my ($class, %args) = @_; delete $INC{'FindBin.pm'}; { # to suppress the redefine warning local $SIG{__WARN__} = sub {}; require FindBin; } # ignore the prefix on extension modules built from top level. my $base_path = Cwd::abs_path($FindBin::Bin); unless ( Cwd::abs_path(Cwd::getcwd()) eq $base_path ) { delete $args{prefix}; } return $args{_self} if $args{_self}; $args{dispatch} ||= 'Admin'; $args{prefix} ||= 'inc'; $args{author} ||= ($^O eq 'VMS' ? '_author' : '.author'); $args{bundle} ||= 'inc/BUNDLES'; $args{base} ||= $base_path; $class =~ s/^\Q$args{prefix}\E:://; $args{name} ||= $class; $args{version} ||= $class->VERSION; unless ( $args{path} ) { $args{path} = $args{name}; $args{path} =~ s!::!/!g; } $args{file} ||= "$args{base}/$args{prefix}/$args{path}.pm"; $args{wrote} = 0; bless( \%args, $class ); } sub call { my ($self, $method) = @_; my $obj = $self->load($method) or return; splice(@_, 0, 2, $obj); goto &{$obj->can($method)}; } sub load { my ($self, $method) = @_; $self->load_extensions( "$self->{prefix}/$self->{path}", $self ) unless $self->{extensions}; foreach my $obj (@{$self->{extensions}}) { return $obj if $obj->can($method); } my $admin = $self->{admin} or die <<"END_DIE"; The '$method' method does not exist in the '$self->{prefix}' path! Please remove the '$self->{prefix}' directory and run $0 again to load it. END_DIE my $obj = $admin->load($method, 1); push @{$self->{extensions}}, $obj; $obj; } sub load_extensions { my ($self, $path, $top) = @_; my $should_reload = 0; unless ( grep { ! ref $_ and lc $_ eq lc $self->{prefix} } @INC ) { unshift @INC, $self->{prefix}; $should_reload = 1; } foreach my $rv ( $self->find_extensions($path) ) { my ($file, $pkg) = @{$rv}; next if $self->{pathnames}{$pkg}; local $@; my $new = eval { local $^W; require $file; $pkg->can('new') }; unless ( $new ) { warn $@ if $@; next; } $self->{pathnames}{$pkg} = $should_reload ? delete $INC{$file} : $INC{$file}; push @{$self->{extensions}}, &{$new}($pkg, _top => $top ); } $self->{extensions} ||= []; } sub find_extensions { my ($self, $path) = @_; my @found; File::Find::find( sub { my $file = $File::Find::name; return unless $file =~ m!^\Q$path\E/(.+)\.pm\Z!is; my $subpath = $1; return if lc($subpath) eq lc($self->{dispatch}); $file = "$self->{path}/$subpath.pm"; my $pkg = "$self->{name}::$subpath"; $pkg =~ s!/!::!g; # If we have a mixed-case package name, assume case has been preserved # correctly. Otherwise, root through the file to locate the case-preserved # version of the package name. if ( $subpath eq lc($subpath) || $subpath eq uc($subpath) ) { my $content = Module::Install::_read($subpath . '.pm'); my $in_pod = 0; foreach ( split /\n/, $content ) { $in_pod = 1 if /^=\w/; $in_pod = 0 if /^=cut/; next if ($in_pod || /^=cut/); # skip pod text next if /^\s*#/; # and comments if ( m/^\s*package\s+($pkg)\s*;/i ) { $pkg = $1; last; } } } push @found, [ $file, $pkg ]; }, $path ) if -d $path; @found; } ##################################################################### # Common Utility Functions sub _caller { my $depth = 0; my $call = caller($depth); while ( $call eq __PACKAGE__ ) { $depth++; $call = caller($depth); } return $call; } # Done in evals to avoid confusing Perl::MinimumVersion eval( $] >= 5.006 ? <<'END_NEW' : <<'END_OLD' ); die $@ if $@; sub _read { local *FH; open( FH, '<', $_[0] ) or die "open($_[0]): $!"; binmode FH; my $string = do { local $/; }; close FH or die "close($_[0]): $!"; return $string; } END_NEW sub _read { local *FH; open( FH, "< $_[0]" ) or die "open($_[0]): $!"; binmode FH; my $string = do { local $/; }; close FH or die "close($_[0]): $!"; return $string; } END_OLD sub _readperl { my $string = Module::Install::_read($_[0]); $string =~ s/(?:\015{1,2}\012|\015|\012)/\n/sg; $string =~ s/(\n)\n*__(?:DATA|END)__\b.*\z/$1/s; $string =~ s/\n\n=\w+.+?\n\n=cut\b.+?\n+/\n\n/sg; return $string; } sub _readpod { my $string = Module::Install::_read($_[0]); $string =~ s/(?:\015{1,2}\012|\015|\012)/\n/sg; return $string if $_[0] =~ /\.pod\z/; $string =~ s/(^|\n=cut\b.+?\n+)[^=\s].+?\n(\n=\w+|\z)/$1$2/sg; $string =~ s/\n*=pod\b[^\n]*\n+/\n\n/sg; $string =~ s/\n*=cut\b[^\n]*\n+/\n\n/sg; $string =~ s/^\n+//s; return $string; } # Done in evals to avoid confusing Perl::MinimumVersion eval( $] >= 5.006 ? <<'END_NEW' : <<'END_OLD' ); die $@ if $@; sub _write { local *FH; open( FH, '>', $_[0] ) or die "open($_[0]): $!"; binmode FH; foreach ( 1 .. $#_ ) { print FH $_[$_] or die "print($_[0]): $!"; } close FH or die "close($_[0]): $!"; } END_NEW sub _write { local *FH; open( FH, "> $_[0]" ) or die "open($_[0]): $!"; binmode FH; foreach ( 1 .. $#_ ) { print FH $_[$_] or die "print($_[0]): $!"; } close FH or die "close($_[0]): $!"; } END_OLD # _version is for processing module versions (eg, 1.03_05) not # Perl versions (eg, 5.8.1). sub _version { my $s = shift || 0; my $d =()= $s =~ /(\.)/g; if ( $d >= 2 ) { # Normalise multipart versions $s =~ s/(\.)(\d{1,3})/sprintf("$1%03d",$2)/eg; } $s =~ s/^(\d+)\.?//; my $l = $1 || 0; my @v = map { $_ . '0' x (3 - length $_) } $s =~ /(\d{1,3})\D?/g; $l = $l . '.' . join '', @v if @v; return $l + 0; } sub _cmp { _version($_[1]) <=> _version($_[2]); } # Cloned from Params::Util::_CLASS sub _CLASS { ( defined $_[0] and ! ref $_[0] and $_[0] =~ m/^[^\W\d]\w*(?:::\w+)*\z/s ) ? $_[0] : undef; } 1; # Copyright 2008 - 2012 Adam Kennedy. Message-Passing-0.116/README0000644000175000017500000001265312472656164015551 0ustar ahartmaiahartmaiNAME Message::Passing - a simple way of doing messaging. SYNOPSIS message-pass --input STDIN --output STDOUT {"foo": "bar"} {"foo":"bar"} DESCRIPTION A library for building high performance, loosely coupled and reliable/resilient applications, structured as small services which communicate over the network by passing messages. BASIC PREMISE You have data for discrete events, represented by a hash (and serialized as JSON). This could be a text log line, an audit record of an API event, a metric emitted from your application that you wish to aggregate and process - anything that can be a simple hash really.. You want to be able to shove these events over the network easily, and aggregate them / filter and rewrite them / split them into worker queues. This module is designed as a simple framework for writing components that let you do all of these things, in a simple and easily extensible manor. For a practical example, You generate events from a source (e.g. ZeroMQ output of logs and performance metrics from your Catalyst FCGI or Starman workers) and run one script that will give you a central application log file, or push the logs into Elasticsearch. There are a growing set of components you can plug together to make your solution. Getting started is really easy - you can just use the "message-passing" command installed by the distribution. If you have a common config that you want to repeat, or you want to write your own server which does something more flexible than the normal script allows, then see Message::Passing::DSL. To dive straight in, see the documentation for the command line utility message-passing, and see the examples in Message::Passing::Manual::Cookbook. For more about how the system works, see Message::Passing::Manual::Concepts. COMPONENTS Below is a non-exhaustive list of components available. INPUTS Inputs receive data from a source (usually a network protocol). They are responsible for decoding the data into a hash before passing it onto the next stage. Inputs include: Message::Passing::Input::STDIN Message::Passing::Input::ZeroMQ Message::Passing::Input::STOMP Message::Passing::Input::AMQP Message::Passing::Input::Syslog Message::Passing::Input::Redis Message::Passing::Input::Test You can easily write your own input, just use AnyEvent, and consume Message::Passing::Role::Input. FILTER Filters can transform a message in any way. Examples include: Message::Passing::Filter::Null - Returns the input unchanged. Message::Passing::Filter::All - Stops any messages it receives from being passed to the output. I.e. literally filters all input out. Message::Passing::Filter::T - Splits the incoming message to multiple outputs. You can easily write your own filter, just consume Message::Passing::Role::Filter. Note that filters can be chained, and a filter can return undef to stop a message being passed to the output. OUTPUTS Outputs send data to somewhere, i.e. they consume messages. Message::Passing::Output::STDOUT Message::Passing::Output::AMQP Message::Passing::Output::STOMP Message::Passing::Output::ZeroMQ Message::Passing::Output::WebHooks Message::Passing::Output::Search::Elasticsearch Message::Passing::Output::Redis Message::Passing::Output::Test SEE ALSO Message::Passing::Manual - The manual (contributions cherished) - Slide deck! Log::Message::Structured - For creating your log messages. Log::Dispatch::Message::Passing - use Message::Passing outputs from Log::Dispatch. THIS MODULE This is a simple MooX::Options script, with one input, one filter and one output. To build your own similar scripts, see: Message::Passing::DSL - To declare your message chains Message::Passing::Role::CLIComponent - To provide "foo" and "foo_options" attribute pairs. Message::Passing::Role::Script - To provide daemonization features. METHODS build_chain Builds and returns the configured chain of input => filter => output start Class method to call the run_message_server function with the results of having constructed an instance of this class, parsed command line options and constructed a chain. This is the entry point for the script. AUTHOR Tomas (t0m) Doran SUPPORT Bugs Please log bugs at rt.cpan.org. Each distribution has a bug tracker link in it's metacpan.org page. Discussion #message-passing on irc.perl.org. Source code Source code for all modules is available at and forks / patches are very welcome. SPONSORSHIP This module exists due to the wonderful people at Suretec Systems Ltd. who sponsored its development for its VoIP division called SureVoIP for use with the SureVoIP API - COPYRIGHT Copyright Suretec Systems Ltd. 2012. Logstash (upon which many ideas for this project is based, but which we do not reuse any code from) is copyright 2010 Jorden Sissel. LICENSE GNU Library General Public License, Version 2.1 Message-Passing-0.116/t/0000755000175000017500000000000012472656214015121 5ustar ahartmaiahartmaiMessage-Passing-0.116/t/output_encode.t0000644000175000017500000000132412015112611020140 0ustar ahartmaiahartmaiuse strict; use warnings; use Test::More; use Try::Tiny; { package Message::MXS; use strict; use warnings; sub pack { { foo => "bar" } } } { package Message::LMS; use strict; use warnings; sub to_hash { { baz => "bar" } } } use Message::Passing::Output::Test; use Message::Passing::Filter::Encoder::JSON; my $packed; my $test = Message::Passing::Output::Test->new(cb => sub { $packed = shift }); my $encoder = Message::Passing::Filter::Encoder::JSON->new(output_to => $test); $encoder->consume(bless {}, 'Message::MXS'); is $packed, '{"foo":"bar"}'; $encoder->consume(bless {}, 'Message::LMS'); is $packed, '{"baz":"bar"}'; $encoder->consume('{}'); is $packed, '{}'; done_testing; Message-Passing-0.116/t/output_test.t0000644000175000017500000000110412015112611017656 0ustar ahartmaiahartmaiuse strict; use warnings; use Test::More; use Try::Tiny; use Message::Passing::Output::Test; my $called = 0; my $test = try { Message::Passing::Output::Test->new(cb => sub { $called++ }) } catch { fail "Failed to construct $_" }; ok $test; try { $test->consume('message') } catch { fail "Failed to consume message: $_" }; is $test->message_count, 1; is_deeply [$test->messages], ['message']; is $called, 1; try { $test->clear_messages } catch { fail "Could not clear messages: $_" }; is $test->message_count, 0; is_deeply [$test->messages], []; done_testing; Message-Passing-0.116/t/role_connectionmanager.t0000644000175000017500000000466612015112611022012 0ustar ahartmaiahartmaiuse strict; use warnings; use Test::More; use AnyEvent; { package Connection::Subscriber; use Moo; use namespace::clean -except => 'meta'; has am_connected => ( is => 'rw' ); sub connected { shift->am_connected(1); } sub disconnected { shift->am_connected(0); } } { package Some::Shonky::Async::Code; use Moo; use namespace::clean -except => 'meta'; } { package My::Connection::Wrapper; use Moo; use Scalar::Util qw/ weaken /; use namespace::clean -except => 'meta'; with 'Message::Passing::Role::ConnectionManager'; has '+timeout' => ( default => sub { 0.1 }, ); has '+reconnect_after' => ( default => sub { 0.1 }, ); sub _build_connection { my $self = shift; weaken($self); my $client = Some::Shonky::Async::Code->new; # Real code now has something like: # $client->add_connect_callback(sub { # $self->_set_connected(1); # }); # instead we'll simulate that below.. return $client; } } my $sub = Connection::Subscriber->new; ok !exists($sub->{am_connected}); my $i = My::Connection::Wrapper->new; ok $i; ok $i->{connection}; isa_ok $i->{connection}, 'Some::Shonky::Async::Code'; $i->subscribe_to_connect($sub); ok !exists($sub->{am_connected}); $i->_set_connected(1); ok exists($sub->{am_connected}); ok $sub->{am_connected}; Scalar::Util::weaken($sub); my $sub2 = Connection::Subscriber->new; $i->subscribe_to_connect($sub2); ok $sub2->{am_connected}; is_deeply $i->_connect_subscribers, [$sub2]; ok !$sub; # Test connectiomn timeout $i = My::Connection::Wrapper->new; my $cv = AnyEvent->condvar; { my $t; $t = AnyEvent->timer( after => 0.11, cb => sub { undef $t; $cv->send }, ); } ok $i->{connection}; $cv->recv; ok !$i->{connection}; # Test reconnect $cv = AnyEvent->condvar; { my $t; $t = AnyEvent->timer( after => 0.11, cb => sub { undef $t; $cv->send }, ); } $cv->recv; $i->_set_connected(1); ok $i->{connection}; my ($c, $d) = (0,0); no warnings 'redefine'; *My::Connection::Wrapper::_build_timeout_timer = sub { $c++; shift->next::method(@_) }; *My::Connection::Wrapper::_build_reconnect_timer = sub { $d++; shift->next::method(@_) }; $cv = AnyEvent->condvar; { my $t; $t = AnyEvent->timer( after => 0.5, cb => sub { undef $t; $cv->send }, ); } $cv->recv; is $c, 0; is $d, 0; done_testing; Message-Passing-0.116/t/input_output_coerce.t0000644000175000017500000000044312015112611021363 0ustar ahartmaiahartmaiuse strict; use warnings; use Test::More 0.88; use Message::Passing::Input::STDIN; my $i = Message::Passing::Input::STDIN->new( output_to => { class => 'Message::Passing::Output::Test', }, ); ok $i; isa_ok($i->output_to, 'Message::Passing::Output::Test'); done_testing; Message-Passing-0.116/t/configfile.t0000644000175000017500000000121712015112611017371 0ustar ahartmaiahartmaiuse strict; use warnings; use Test::More 0.88; use File::Temp qw/ tempdir /; use JSON qw/ encode_json decode_json /; use File::Spec; my $dir = tempdir( CLEANUP => 1 ); my $path = File::Spec->catfile($dir, 'config.json'); open(my $fh, '>', $path) or die $!; print $fh encode_json({ input => 'Null', output => 'Test', input_options => { foo => 'bar', }, }); close($fh); use_ok 'Message::Passing'; my $i; { local @ARGV = ('--configfile', $path); $i = Message::Passing->new_with_options; } ok $i; is $i->input, 'Null'; is $i->output, 'Test'; is_deeply $i->input_options, { foo => 'bar', }; done_testing; Message-Passing-0.116/t/dsl.t0000644000175000017500000000316112204646036016063 0ustar ahartmaiahartmaiuse strict; use warnings; use Test::More; use Message::Passing::DSL; my $c = message_chain { output test => ( class => 'Test', ); filter t => ( class => 'T', output_to => ['test'], ); filter null => ( class => 'Null', output_to => 't', ); input stdin => ( class => 'STDIN', output_to => 'null', ); }; isa_ok $c->[0], 'Message::Passing::Input::STDIN'; isa_ok $c->[0]->output_to, 'Message::Passing::Filter::Null'; isa_ok $c->[0]->output_to->output_to, 'Message::Passing::Filter::T'; isa_ok $c->[0]->output_to->output_to->output_to->[0], 'Message::Passing::Output::Test'; $c->[0]->output_to->consume({foo => 'bar'}); my $test = $c->[0]->output_to->output_to->output_to->[0]; is $test->message_count, 1; is_deeply [$test->messages], [{foo => 'bar'}]; $c = message_chain { output logcollector_central => ( class => 'STDOUT', ); input null_in => ( class => 'Null', output_to => 'logcollector_central', ); input test_in => ( class => 'STDIN', output_to => 'logcollector_central', ); }; is ref($c), 'ARRAY'; is scalar(@$c), 2; my @chain = sort @$c; isa_ok $chain[0], 'Message::Passing::Input::Null'; isa_ok $chain[1], 'Message::Passing::Input::STDIN'; isa_ok $chain[0]->output_to, 'Message::Passing::Output::STDOUT'; isa_ok $chain[1]->output_to, 'Message::Passing::Output::STDOUT'; is $chain[0]->output_to, $chain[1]->output_to; done_testing; Message-Passing-0.116/t/role_hasaconnection.t0000644000175000017500000000131612015112611021301 0ustar ahartmaiahartmaiuse strict; use warnings; use Test::More; BEGIN { use_ok('Message::Passing::Role::HasAConnection'); } { package TestConnectionManager; use Moo; use namespace::clean -except => 'meta'; our @THINGS; sub subscribe_to_connect { my ($self, $thing) = @_; push(@THINGS, $thing); } } { package TestWithConnection; use Moo; use namespace::clean -except => 'meta'; with 'Message::Passing::Role::HasAConnection'; sub connected {} # Callback API sub _build_connection_manager { TestConnectionManager->new } } my $i = TestWithConnection->new; ok $i; is scalar(@TestConnectionManager::THINGS), 1; is $TestConnectionManager::THINGS[0], $i; done_testing; Message-Passing-0.116/t/00_compile.t0000644000175000017500000000222512022141471017217 0ustar ahartmaiahartmaiuse strict; use warnings; use Test::More; use_ok('Message::Passing::Role::HasAConnection'); use_ok('Message::Passing::Role::ConnectionManager'); use_ok('Message::Passing'); use_ok('Message::Passing::Output::STDOUT'); use_ok('Message::Passing::Input::STDIN'); use_ok('Message::Passing::Input::FileTail'); use_ok('Message::Passing::Output::Null'); use_ok('Message::Passing::Output::Callback'); use_ok('Message::Passing::Output::Test'); use_ok('Message::Passing::Output::File'); use_ok('Message::Passing::Output::IO::Handle'); use_ok('Message::Passing::Output::STDERR'); use_ok('Message::Passing::Filter::Null'); use_ok('Message::Passing::Filter::All'); use_ok('Message::Passing::Filter::Delay'); use_ok('Message::Passing::Filter::Encoder::JSON'); use_ok('Message::Passing::Filter::Encoder::Null'); use_ok('Message::Passing::Filter::Decoder::JSON'); use_ok('Message::Passing::Filter::Decoder::Null'); use_ok('Message::Passing::Role::HasHostnameAndPort'); use_ok('Message::Passing::Role::HasUsernameAndPassword'); use_ok('Message::Passing::Role::HasErrorChain'); use_ok('Message::Passing::Input::Socket::UDP'); use_ok('Message::Passing::Filter::ToLogstash'); done_testing; Message-Passing-0.116/t/compress.t0000644000175000017500000000234112015112611017116 0ustar ahartmaiahartmaiuse strict; use warnings; use Test::More; use Try::Tiny; use Message::Passing::Input::Null; use Message::Passing::Output::Test; plan skip_all => "No IO::Compress" unless try { require Message::Passing::Filter::Decoder::Bzip2; require Message::Passing::Filter::Encoder::Gzip }; use_ok 'Message::Passing::Filter::Decoder::Bzip2'; use_ok 'Message::Passing::Filter::Encoder::Bzip2'; use_ok 'Message::Passing::Filter::Encoder::Gzip'; use_ok 'Message::Passing::Filter::Decoder::Gzip'; my $gzt = Message::Passing::Output::Test->new; my $gz = Message::Passing::Input::Null->new( output_to => Message::Passing::Filter::Encoder::Gzip->new( output_to => Message::Passing::Filter::Decoder::Gzip->new( output_to => $gzt, ), ), ); $gz->output_to->consume('test'); is $gzt->message_count, 1; is_deeply [$gzt->messages], ['test']; my $bzt = Message::Passing::Output::Test->new; my $bz = Message::Passing::Input::Null->new( output_to => Message::Passing::Filter::Encoder::Gzip->new( output_to => Message::Passing::Filter::Decoder::Gzip->new( output_to => $bzt, ), ), ); $bz->output_to->consume('test'); is $bzt->message_count, 1; is_deeply [$bzt->messages], ['test']; done_testing; Message-Passing-0.116/t/output_null.t0000644000175000017500000000046612015112611017663 0ustar ahartmaiahartmaiuse strict; use warnings; use Test::More; use Try::Tiny; use Message::Passing::Output::Null; my $test = try { Message::Passing::Output::Null->new() } catch { fail "Failed to construct $_" }; ok $test; try { $test->consume('message') } catch { fail "Failed to consume message: $_" }; done_testing; Message-Passing-0.116/t/author/0000755000175000017500000000000012472656214016423 5ustar ahartmaiahartmaiMessage-Passing-0.116/t/author/cpan-changes.t0000644000175000017500000000012112176513261021124 0ustar ahartmaiahartmaiuse strict; use warnings; use Test::More; use Test::CPAN::Changes; changes_ok();Message-Passing-0.116/t/author/pod.t0000644000175000017500000000012512015112611017345 0ustar ahartmaiahartmaiuse strict; use warnings; use Test::More; use Test::Pod 1.14; all_pod_files_ok(); Message-Passing-0.116/t/author/spelling.t0000644000175000017500000000124012015112611020377 0ustar ahartmaiahartmaiuse strict; use warnings; use Test::More; use Test::Spelling; add_stopwords(qw( UDP hostname filename cb Str username decrypt decrypts Decrypts cbc Uncompresses namespace POSIX init fh privileged conf daemonize ARGV Recipies recipies multi rsyslogd syslogd AnyEvent DSL SureVoIP VoIP Starman ZeroMQ API Affero FCGI JSON Tomas Doran t0m Jorden Logstash Sissel Suretec TODO STDIN STDOUT STDERR logstash )); set_spell_cmd('aspell list -l en'); all_pod_files_spelling_ok(); done_testing(); Message-Passing-0.116/t/author/notabs.t0000644000175000017500000000017312015112611020054 0ustar ahartmaiahartmaiuse strict; use warnings; use File::Spec; use FindBin (); use Test::More; use Test::NoTabs; all_perl_files_ok(qw/lib/); Message-Passing-0.116/t/author/podcoverage.t0000644000175000017500000000141012015112611021057 0ustar ahartmaiahartmaiuse strict; use warnings; use Test::More; use Pod::Coverage 0.19; use Test::Pod::Coverage 1.04; my @modules = all_modules; our @private = ( 'BUILD' ); foreach my $module (@modules) { local @private = (@private, 'expand_class_name', 'make', 'set_error', 'registry_get', 'registry_set', 'registry_has', 'error') if $module =~ /^Message::Passing::DSL::Factory$/; local @private = (@private, qw/get_config_from_file new_with_options configfile decoder encoder error filter output/) if $module =~ /^Message::Passing$/; local @private = (@private, 'make_variant') if $module =~ /^Message::Passing::Role::CLIComponent$/; pod_coverage_ok($module, { also_private => \@private, coverage_class => 'Pod::Coverage::TrustPod', }); } done_testing; Message-Passing-0.116/t/errorchain.t0000644000175000017500000000333512022141471017427 0ustar ahartmaiahartmaiuse strict; use warnings; use Test::More 0.88; use_ok 'Message::Passing::Filter::Encoder::JSON'; use_ok 'Message::Passing::Filter::Decoder::JSON'; use_ok 'Message::Passing::Output::Test'; { my $test = Message::Passing::Output::Test->new; my $test_e = Message::Passing::Output::Test->new; my $encoder = Message::Passing::Filter::Encoder::JSON->new( output_to => $test, error => $test_e, ); $encoder->consume({ foo => bless {}, 'Bar' }); is $test->message_count, 0; is $test_e->message_count, 1; my ($m) = $test_e->messages; #{"exception":"encountered object 'Bar=HASH(0x7fab21236f30)', but neither allow_blessed nor convert_blessed settings are enabled at /Users/t0m/perl5/perlbrew/perls/perl-5.16.0/lib/site_perl/5.16.0/JSON.pm line 154.\n","class":"Message::Passing::Exception::Encoding","stringified_data":"$VAR1 = {\n 'foo' => bless( {}, 'Bar' )\n };\n"} $m = $m->as_hash; is ref($m), 'HASH'; is $m->{'class'}, 'Message::Passing::Exception::Encoding'; ok exists $m->{'exception'}; ok exists $m->{'stringified_data'}; } { my $test = Message::Passing::Output::Test->new; my $test_e = Message::Passing::Output::Test->new; my $decoder = Message::Passing::Filter::Decoder::JSON->new( output_to => $test, error => $test_e, ); $decoder->consume("{}"); is $test->message_count, 1; is $test_e->message_count, 0; $decoder->consume("{}sjdjd"); is $test->message_count, 1; is $test_e->message_count, 1; my ($m) = $test_e->messages; $m = $m->as_hash; like $m->{exception}, qr/garbage after/; is $m->{packed_data}, '{}sjdjd'; is $m->{class}, 'Message::Passing::Exception::Decoding'; } done_testing; Message-Passing-0.116/t/input_decode.t0000644000175000017500000000072512022147723017743 0ustar ahartmaiahartmaiuse strict; use warnings; use Test::More; use Try::Tiny; use Message::Passing::Output::Test; use Message::Passing::Filter::Decoder::JSON; my $unpacked; my $test = Message::Passing::Output::Test->new(cb => sub { $unpacked = shift }); my $decoder = Message::Passing::Filter::Decoder::JSON->new(output_to => $test); my $h = {}; $decoder->consume($h);; is_deeply $unpacked, $h; $decoder->consume('{"baz":"bar"}'); is_deeply $unpacked, {"baz" => "bar"}; done_testing; Message-Passing-0.116/t/logstash_script.t0000644000175000017500000000162412015112611020476 0ustar ahartmaiahartmaiuse strict; use warnings; use Test::More; use_ok 'Message::Passing'; my $i = Message::Passing->new( input => 'STDIN', input_options => '{"foo":"bar"}', filter_options => '{"baz":"quux"}', output => 'Test', output_options => '{"x":"m"}', ); is_deeply $i->input_options, {"foo" => "bar"}; is_deeply $i->filter_options, {"baz" => "quux"}; is_deeply $i->output_options, {"x" => "m"}; my $chain = $i->build_chain; my $input = $chain->[0]; my $decoder = $input->output_to; isa_ok $decoder, 'Message::Passing::Filter::Decoder::JSON'; my $filter = $decoder->output_to; isa_ok $filter, 'Message::Passing::Filter::Null'; my $encoder = $filter->output_to; isa_ok $encoder, 'Message::Passing::Filter::Encoder::JSON'; my $output = $encoder->output_to; isa_ok $output, 'Message::Passing::Output::Test'; $filter->consume({ foo => "bar" }); is_deeply [$output->messages], ['{"foo":"bar"}']; done_testing; Message-Passing-0.116/t/filter.t0000644000175000017500000000737312015112611016562 0ustar ahartmaiahartmaiuse strict; use warnings; use Test::More; use Try::Tiny; use Message::Passing::Filter::Null; use Message::Passing::Output::Test; use Message::Passing::Filter::All; use Message::Passing::Filter::T; use Message::Passing::Filter::Key; use Message::Passing::Filter::Delay; my $called = 0; my $test; my $ob = try { $test = Message::Passing::Output::Test->new( cb => sub { $called++ } ); Message::Passing::Filter::Null->new(output_to => $test) } catch { fail "Failed to construct $_" }; ok $test; try { $ob->consume('message') } catch { fail "Failed to consume message: $_" }; is $test->message_count, 1; is_deeply [$test->messages], ['message']; is $called, 1; try { $test->clear_messages } catch { fail "Could not clear messages: $_" }; is $test->message_count, 0; is_deeply [$test->messages], []; $ob = try { $test = Message::Passing::Output::Test->new( cb => sub { $called++ } ); Message::Passing::Filter::All->new(output_to => $test) } catch { fail "Failed to construct $_" }; ok $test; try { $ob->consume('message') } catch { fail "Failed to consume message: $_" }; is $test->message_count, 0; $called = 0; my $called2 = 0; my $test2; $ob = try { $test = Message::Passing::Output::Test->new( cb => sub { $called++ } ); $test2 = Message::Passing::Output::Test->new( cb => sub { $called2++ } ); Message::Passing::Filter::T->new(output_to => [$test, $test2]) } catch { fail "Failed to construct $_" }; ok $test; try { $ob->consume('message') } catch { fail "Failed to consume message: $_" }; is $test->message_count, 1; is_deeply [$test->messages], ['message']; is $called, 1; is $test2->message_count, 1; is_deeply [$test2->messages], ['message']; is $called2, 1; $ob = try { $test = Message::Passing::Output::Test->new( cb => sub { $called++ } ); Message::Passing::Filter::Key->new( output_to => $test, key => 'foo', match => 'bar', ); } catch { fail "Failed to construct $_" }; ok $test; try { $ob->consume({foo => 'bar', baz => 'quux'}) } catch { fail "Failed to consume message: $_" }; try { $ob->consume({foo => 'blam', baz => 'quux'}) } catch { fail "Failed to consume message: $_" }; is_deeply [$test->messages], [{foo => 'bar', baz => 'quux'}]; $ob = try { $test = Message::Passing::Output::Test->new( cb => sub { $called++ } ); Message::Passing::Filter::Key->new( output_to => $test, key => 'foo.inner.inner', match => 'bar', ); } catch { fail "Failed to construct $_" }; ok $test; try { $ob->consume({foo => 'bar', baz => 'quux'}) } catch { fail "Failed to consume message: $_" }; try { $ob->consume({foo => { inner => 'blam' }, baz => 'quux'}) } catch { fail "Failed to consume message: $_" }; try { $ob->consume({foo => { inner => { inner => 'blam' } }, baz => 'quux'}) } catch { fail "Failed to consume message: $_" }; try { $ob->consume({foo => { inner => { inner => 'bar' } }, baz => 'quux'}) } catch { fail "Failed to consume message: $_" }; is_deeply [$test->messages], [{foo => { inner => { inner => 'bar' } }, baz => 'quux'}]; $ob = try { $test = Message::Passing::Output::Test->new(); Message::Passing::Filter::Delay->new( delay_for => 0.1, output_to => $test, ); } catch { fail "Failed to construct $_" }; ok $test; $ob->consume({}); is_deeply [$test->messages], []; my $cv = AnyEvent->condvar; my $idle; $idle = AnyEvent->idle(cb => sub { $cv->send; undef $idle; }); $cv->recv; is_deeply [$test->messages], []; $cv = AnyEvent->condvar; my $timer; $timer = AnyEvent->timer( after => 0.2, cb => sub { $cv->send; undef $timer; }, ); $cv->recv; is_deeply [$test->messages], [{}]; done_testing; Message-Passing-0.116/t/filter_tologstash.t0000644000175000017500000000325012135535427021040 0ustar ahartmaiahartmaiuse strict; use warnings; use Test::More; use Data::Dumper; use Message::Passing::Filter::ToLogstash; use Message::Passing::Output::Test; use Sys::Hostname::Long; no warnings 'redefine'; sub AnyEvent::now { 1346706534 } use warnings 'redefine'; my @data = ( [ 'Simple empty hash', {}, { '@fields' => {}, '@tags' => [] } ], [ 'MX::Storage', { '__CLASS__' => 'Moo', foo => 'bar' }, { '@fields' => { foo => 'bar' }, '@tags' => [], '@type' => 'perl:Class:Moo' }, ], [ 'timestamp from epoch', { epochtime => 1346706534 }, { '@fields' => {}, '@tags' => [], '@timestamp' => '2012-09-03T21:08:54' }, ], [ 'raw message', 'foo', { '@fields' => {}, '@tags' => [], '@message' => 'foo', '@source_host' => hostname_long(), '@timestamp' => '2012-09-03T21:08:54', '@type' => 'generic_line' }, ], [ 'filename', { filename => '/foo/bar', 'message' => 'foo' }, { '@fields' => {}, '@tags' => [], '@message' => 'foo', '@source_path' => '/foo/bar' }, ], [ 'date field, no epoch', { date => '2012-09-03T21:08:54', message => 'foo',}, { '@fields' => {}, '@tags' => [], '@message' => 'foo', '@timestamp' => '2012-09-03T21:08:54' }, ], ); foreach my $datum (@data) { my ($name, $input, $exp) = @$datum; my $out = Message::Passing::Output::Test->new; my $in = Message::Passing::Filter::ToLogstash->new( output_to => $out, ); $in->consume($input); my ($output) = $out->messages; is_deeply $output, $exp, $name or diag "Got " . Dumper($output) . " expected " . Dumper($exp); } done_testing; Message-Passing-0.116/t/socket_udp.t0000644000175000017500000000222512015112611017424 0ustar ahartmaiahartmaiuse strict; use warnings; no warnings 'once'; use Test::More; use AnyEvent; use Message::Passing::Output::Test; use Message::Passing::Input::Socket::UDP; use Message::Passing::Output::Socket::UDP; plan skip_all => "Need Net::Statsd for this test" unless eval { require Net::Statsd; 1; }; my $t = Message::Passing::Output::Test->new; my $chain = Message::Passing::Input::Socket::UDP->new( hostname => "localhost", port => "52552", output_to => $t, ); $Net::Statsd::PORT = 52552; is $t->message_count, 0; Net::Statsd::increment('site.logins'); my $cv = AnyEvent->condvar; my $timer = AnyEvent->timer(after => 0.1, cb => sub { $cv->send }); $cv->recv; is $t->message_count, 1; my $out = Message::Passing::Output::Socket::UDP->new( hostname => "localhost", port => '52552', ); $cv = AnyEvent->condvar; $timer = AnyEvent->timer(after => 0.1, cb => sub { $cv->send }); $cv->recv; $out->consume("foo:bar"); $cv = AnyEvent->condvar; $timer = AnyEvent->timer(after => 0.1, cb => sub { $cv->send }); $cv->recv; is $t->message_count, 2; is_deeply [$t->messages], [ 'site.logins:1|c', 'foo:bar' ]; done_testing; Message-Passing-0.116/t/crypt_cbc.t0000644000175000017500000000241212015112611017232 0ustar ahartmaiahartmaiuse strict; use warnings; use Test::More; use Try::Tiny; plan skip_all => "No Crypt::CBC or no Crypt::Blowfish" unless try { require Message::Passing::Filter::Decoder::Crypt::CBC; require Crypt::Blowfish; }; use_ok 'Message::Passing::Filter::Decoder::Crypt::CBC'; use_ok 'Message::Passing::Filter::Encoder::Crypt::CBC'; use_ok 'Message::Passing::Output::Test'; use_ok 'Message::Passing::Input::Null'; use_ok 'Message::Passing::Output::Null'; my $cbct = Message::Passing::Output::Test->new; my $cbc = Message::Passing::Input::Null->new( output_to => Message::Passing::Filter::Encoder::Crypt::CBC->new( encryption_cipher => 'Blowfish', encryption_key => 'test', output_to => Message::Passing::Filter::Decoder::Crypt::CBC->new( output_to => $cbct, encryption_cipher => 'Blowfish', encryption_key => 'test', ), ), ); $cbc->output_to->consume('test'); is $cbct->message_count, 1; is_deeply [$cbct->messages], ['test']; # Simulate dropping a message! { local $cbc->output_to->{output_to} = Message::Passing::Output::Null->new; $cbc->output_to->consume('fooo'); } $cbc->output_to->consume('bar'); is $cbct->message_count, 2; is_deeply [$cbct->messages], ['test', 'bar']; done_testing; Message-Passing-0.116/t/filter_mangle.t0000644000175000017500000000326012175504570020114 0ustar ahartmaiahartmaiuse strict; use warnings; use Test::More; use Data::Dumper; use Message::Passing::Filter::Mangle; use Message::Passing::Output::Test; my @data = ( [ 'Passthrough filter of scalar messages', sub { return shift; }, 'test message', 'test message', ], [ 'Passthrough filter of hashref message', sub { return shift; }, { message => 'test message' }, { message => 'test message' }, ], [ 'All filter of scalar messages', sub { return; }, 'test message', undef, ], [ 'All filter of hashref message', sub { return; }, { message => 'test message' }, undef, ], [ 'Mangle filter of scalar messages', sub { my $message = shift; return $message . ' from me'; }, 'test message', 'test message from me', ], [ 'Mangle filter of hashref message', sub { my $message = shift; $message->{from} = 'me'; return $message; }, { message => 'test message' }, { message => 'test message', from => 'me' }, ], ); foreach my $datum (@data) { my ( $name, $filter_function, $input, $exp ) = @$datum; my $out = Message::Passing::Output::Test->new; my $in = Message::Passing::Filter::Mangle->new( filter_function => $filter_function, output_to => $out, ); $in->consume($input); my ($output) = $out->messages; is_deeply $output, $exp, $name or diag "Got " . Dumper($output) . " expected " . Dumper($exp); } done_testing; Message-Passing-0.116/script/0000755000175000017500000000000012472656214016162 5ustar ahartmaiahartmaiMessage-Passing-0.116/script/message-pass0000755000175000017500000000561412015112611020463 0ustar ahartmaiahartmai#!perl use strict; use warnings; use Message::Passing; Message::Passing->start; 1; =head1 NAME message-pass - command line Message::Passing runner script =head1 SYNOPSIS message-pass [options] Options: --input - Input short name (required) --output - Output short name (required) --filter - Filter short name (default Null) --decoder - Decoder short name (default JSON) --encoder - Encoder short name (default JSON) --input_options - JSON options string for input --output_options - JSON options string for output --filter_options - JSON options string for filter --decoder_options - JSON options string for decoder --encoder_options - JSON options string for encoder OR: --configfile - Config file (to load with Config::Any) supplying the above options =head1 DESCRIPTION Builds a simple chain of L components, looking like this: Input => Decoder => Filter => Encoder => Output This allows you to input a message from one protocol, decode it, process it and then output it again having encoded it. The simplest example of doing this is: message-pass --input STDIN --output STDOUT Which will echo JSON strings you type back to the terminal. =head1 CLASS NAME EXPANSION All short class names undergo expansion as detailed below, except for names which are prefixed with a '+', which implies a full class name. E.g. message-pass --input '+My::Example::Input' --output STDOUT The expansions are: =over =item input Message::Passing::Input::XXX =item output Message::Passing::Output::XXX =item filter Message::Passing::Filter::XXX =item encoder Message::Passing::Filter::Encoder::XXX =item decoder Message::Passing::Filter::Decoder::XXX =back =head1 CONFIG FILE If the C<< --configfile >> option is supplied, then a config file will be used. The format of data in this config file matches that required of the command line options, e.g. { "input":"XXX", "input_options":{}, "output":"XXX", "output_options":{}, "filter":"XXX", "filter_options":{}, "encoder":"XXX", "encoder_options":{}, "decoder":"XXX", "decoder_options":{} } Any config format supported by L can be used, however JSON is the only format which is certain to work without additional dependencies which are not required by this module. =head1 SEE ALSO =over =item L =item L =back =head1 SPONSORSHIP This module exists due to the wonderful people at Suretec Systems Ltd. who sponsored its development for its VoIP division called SureVoIP for use with the SureVoIP API - =head1 AUTHOR, COPYRIGHT AND LICENSE See L. =cut