Build.PL100664001750001750 45513527056003 15645 0ustar00sebaseba000000000000Mojo-RabbitMQ-Client-0.3.1# ========================================================================= # THIS FILE IS AUTOMATICALLY GENERATED BY MINILLA. # DO NOT EDIT DIRECTLY. # ========================================================================= use 5.008_001; use strict; use Module::Build::Tiny 0.035; Build_PL(); Changes100664001750001750 446013527056003 15664 0ustar00sebaseba000000000000Mojo-RabbitMQ-Client-0.3.10.3.1 2019-08-20T20:45:53Z - Re-apply licensing note from #37 - now in proper place 0.3.0 2019-08-20T20:35:39Z - Allow EXTERNAL as well as AMQPLAIN auth #35 (@AdamWill) - fixes legal issues with AMQP specs licensing #37 0.2.4 2019-08-20T00:49:27Z - Prevent warning about undefined object on closed channels #36 (@okurz) 0.2.3 2019-07-24T21:06:16Z - Clarified documentation #33, #34 (@AdamWill) 0.2.2 2019-05-23T11:20:22Z - Minor documentation fixes #32 (@sjn) - fix around 30 memory leaks #31 (@kraih) 0.2.1 2018-07-29T14:17:43Z - Fixed POD syntax, spelling & grammar errors #27,#28 (@gregoa) - Fixed POD error #26 (@manwar) 0.2.0 2018-07-25T13:23:26Z - Remove internal frame buffer handling, use Net::AMQP #11 (@kraih) 0.1.0 2018-02-16T10:15:32Z - Make Mojo::RabbitMQ::Client::Consumer use promises #23 (@christopherraa) - Fix circular includes by #20 (@christopherraa) - Start implementing Mojo::Promise, drop support for Mojolicious <7.53 - Implement DEBUG on Client as suggested in #11 - Fix early success event from ->publish #16 - Fix query parameter naming in Publisher - Fix missing imports in Publisher #15 - Fix #14 - Implement Publisher API #5 0.0.9 2017-02-18T11:07:56Z - Proper implementation of URI parser PR#8 & #9 - Support for query parameter with aliases - Add max_channels attribute to force maximum number of channels active - Additional developer test for quick consumer - Documentation changes 0.0.8 2017-01-30T12:13:18Z - Fix issues with UTF-8 data corruption on SSL sockets PR#7 - Drop List::MoreUtils `none` in favour of core List::Util PR#4 0.0.7 2016-12-02T20:52:17Z - Fix missing dependencies 0.0.6 2016-11-24T00:45:01Z - First CPAN release 0.0.5 2016-11-23 - First Minilla release - Drop support for Module::Install 0.0.4 2016-11-23 - Moved all utility packages to Mojo::RabbitMQ::Client::* namespace - Added shorthand static methods for consumer & publisher 0.0.3 2016-11-18 - Draft specs for new Publisher API 0.0.2 2016-10-25 - Change the way how channels are opened - Deprecate _open method for channels - Show proper project url in client_properties - Support connect url according to spec - Include Module::Install for cleaner use in Docker containers - Docs updates & cleanups 0.0.1 2015-06-29 - Initial release. Most things work. LICENSE100664001750001750 2133713527056003 15420 0ustar00sebaseba000000000000Mojo-RabbitMQ-Client-0.3.1 The Artistic License 2.0 Copyright (c) 2015 InWay Open Source code Everyone is permitted to copy and distribute verbatim copies of this license document, but changing it is not allowed. Preamble This license establishes the terms under which a given free software Package may be copied, modified, distributed, and/or redistributed. The intent is that the Copyright Holder maintains some artistic control over the development of that Package while still keeping the Package available as open source and free software. You are always permitted to make arrangements wholly outside of this license directly with the Copyright Holder of a given Package. If the terms of this license do not permit the full use that you propose to make of the Package, you should contact the Copyright Holder and seek a different licensing arrangement. Definitions "Copyright Holder" means the individual(s) or organization(s) named in the copyright notice for the entire Package. "Contributor" means any party that has contributed code or other material to the Package, in accordance with the Copyright Holder's procedures. "You" and "your" means any person who would like to copy, distribute, or modify the Package. "Package" means the collection of files distributed by the Copyright Holder, and derivatives of that collection and/or of those files. A given Package may consist of either the Standard Version, or a Modified Version. "Distribute" means providing a copy of the Package or making it accessible to anyone else, or in the case of a company or organization, to others outside of your company or organization. "Distributor Fee" means any fee that you charge for Distributing this Package or providing support for this Package to another party. It does not mean licensing fees. "Standard Version" refers to the Package if it has not been modified, or has been modified only in ways explicitly requested by the Copyright Holder. "Modified Version" means the Package, if it has been changed, and such changes were not explicitly requested by the Copyright Holder. "Original License" means this Artistic License as Distributed with the Standard Version of the Package, in its current version or as it may be modified by The Perl Foundation in the future. "Source" form means the source code, documentation source, and configuration files for the Package. "Compiled" form means the compiled bytecode, object code, binary, or any other form resulting from mechanical transformation or translation of the Source form. Permission for Use and Modification Without Distribution (1) You are permitted to use the Standard Version and create and use Modified Versions for any purpose without restriction, provided that you do not Distribute the Modified Version. Permissions for Redistribution of the Standard Version (2) You may Distribute verbatim copies of the Source form of the Standard Version of this Package in any medium without restriction, either gratis or for a Distributor Fee, provided that you duplicate all of the original copyright notices and associated disclaimers. At your discretion, such verbatim copies may or may not include a Compiled form of the Package. (3) You may apply any bug fixes, portability changes, and other modifications made available from the Copyright Holder. The resulting Package will still be considered the Standard Version, and as such will be subject to the Original License. Distribution of Modified Versions of the Package as Source (4) You may Distribute your Modified Version as Source (either gratis or for a Distributor Fee, and with or without a Compiled form of the Modified Version) provided that you clearly document how it differs from the Standard Version, including, but not limited to, documenting any non-standard features, executables, or modules, and provided that you do at least ONE of the following: (a) make the Modified Version available to the Copyright Holder of the Standard Version, under the Original License, so that the Copyright Holder may include your modifications in the Standard Version. (b) ensure that installation of your Modified Version does not prevent the user installing or running the Standard Version. In addition, the Modified Version must bear a name that is different from the name of the Standard Version. (c) allow anyone who receives a copy of the Modified Version to make the Source form of the Modified Version available to others under (i) the Original License or (ii) a license that permits the licensee to freely copy, modify and redistribute the Modified Version using the same licensing terms that apply to the copy that the licensee received, and requires that the Source form of the Modified Version, and of any works derived from it, be made freely available in that license fees are prohibited but Distributor Fees are allowed. Distribution of Compiled Forms of the Standard Version or Modified Versions without the Source (5) You may Distribute Compiled forms of the Standard Version without the Source, provided that you include complete instructions on how to get the Source of the Standard Version. Such instructions must be valid at the time of your distribution. If these instructions, at any time while you are carrying out such distribution, become invalid, you must provide new instructions on demand or cease further distribution. If you provide valid instructions or cease distribution within thirty days after you become aware that the instructions are invalid, then you do not forfeit any of your rights under this license. (6) You may Distribute a Modified Version in Compiled form without the Source, provided that you comply with Section 4 with respect to the Source of the Modified Version. Aggregating or Linking the Package (7) You may aggregate the Package (either the Standard Version or Modified Version) with other packages and Distribute the resulting aggregation provided that you do not charge a licensing fee for the Package. Distributor Fees are permitted, and licensing fees for other components in the aggregation are permitted. The terms of this license apply to the use and Distribution of the Standard or Modified Versions as included in the aggregation. (8) You are permitted to link Modified and Standard Versions with other works, to embed the Package in a larger work of your own, or to build stand-alone binary or bytecode versions of applications that include the Package, and Distribute the result without restriction, provided the result does not expose a direct interface to the Package. Items That are Not Considered Part of a Modified Version (9) Works (including, but not limited to, modules and scripts) that merely extend or make use of the Package, do not, by themselves, cause the Package to be a Modified Version. In addition, such works are not considered parts of the Package itself, and are not subject to the terms of this license. General Provisions (10) Any use, modification, and distribution of the Standard or Modified Versions is governed by this Artistic License. By using, modifying or distributing the Package, you accept this license. Do not use, modify, or distribute the Package, if you do not accept this license. (11) If your Modified Version has been derived from a Modified Version made by someone other than you, you are nevertheless required to ensure that your Modified Version complies with the requirements of this license. (12) This license does not grant you the right to use any trademark, service mark, tradename, or logo of the Copyright Holder. (13) This license includes the non-exclusive, worldwide, free-of-charge patent license to make, have made, use, offer to sell, sell, import and otherwise transfer the Package with respect to any patent claims licensable by the Copyright Holder that are necessarily infringed by the Package. If you institute patent litigation (including a cross-claim or counterclaim) against any party alleging that the Package constitutes direct or contributory patent infringement, then this Artistic License to you shall terminate on the date that such litigation is filed. (14) Disclaimer of Warranty: THE PACKAGE IS PROVIDED BY THE COPYRIGHT HOLDER AND CONTRIBUTORS "AS IS' AND WITHOUT ANY EXPRESS OR IMPLIED WARRANTIES. THE IMPLIED WARRANTIES OF MERCHANTABILITY, FITNESS FOR A PARTICULAR PURPOSE, OR NON-INFRINGEMENT ARE DISCLAIMED TO THE EXTENT PERMITTED BY YOUR LOCAL LAW. UNLESS REQUIRED BY LAW, NO COPYRIGHT HOLDER OR CONTRIBUTOR WILL BE LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, OR CONSEQUENTIAL DAMAGES ARISING IN ANY WAY OUT OF THE USE OF THE PACKAGE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE. META.json100664001750001750 636713527056003 16022 0ustar00sebaseba000000000000Mojo-RabbitMQ-Client-0.3.1{ "abstract" : "Mojo::IOLoop based RabbitMQ client", "author" : [ "-2019, Sebastian Podjasek and others" ], "dynamic_config" : 0, "generated_by" : "Minilla/v3.0.14", "license" : [ "artistic_2" ], "meta-spec" : { "url" : "http://search.cpan.org/perldoc?CPAN::Meta::Spec", "version" : "2" }, "name" : "Mojo-RabbitMQ-Client", "no_index" : { "directory" : [ "t", "xt", "inc", "share", "eg", "examples", "author", "builder" ] }, "prereqs" : { "configure" : { "requires" : { "Module::Build::Tiny" : "0.035" } }, "develop" : { "requires" : { "Test::CPAN::Meta" : "0", "Test::MinimumVersion::Fast" : "0.04", "Test::PAUSE::Permissions" : "0.04", "Test::Pod" : "1.41", "Test::Spellunker" : "v0.2.7" } }, "runtime" : { "requires" : { "File::ShareDir" : "0", "List::Util" : "1.33", "Mojolicious" : "7.53", "Net::AMQP" : "0.06", "perl" : "5.010" } }, "test" : { "requires" : { "Test::Exception" : "0.43", "Test::More" : "0.98" } } }, "provides" : { "Mojo::RabbitMQ::Client" : { "file" : "lib/Mojo/RabbitMQ/Client.pm", "version" : "v0.3.1" }, "Mojo::RabbitMQ::Client::Channel" : { "file" : "lib/Mojo/RabbitMQ/Client/Channel.pm" }, "Mojo::RabbitMQ::Client::Consumer" : { "file" : "lib/Mojo/RabbitMQ/Client/Consumer.pm" }, "Mojo::RabbitMQ::Client::LocalQueue" : { "file" : "lib/Mojo/RabbitMQ/Client/LocalQueue.pm" }, "Mojo::RabbitMQ::Client::Method" : { "file" : "lib/Mojo/RabbitMQ/Client/Method.pm" }, "Mojo::RabbitMQ::Client::Method::Publish" : { "file" : "lib/Mojo/RabbitMQ/Client/Method/Publish.pm" }, "Mojo::RabbitMQ::Client::Publisher" : { "file" : "lib/Mojo/RabbitMQ/Client/Publisher.pm" } }, "release_status" : "stable", "resources" : { "bugtracker" : { "web" : "https://github.com/inway/mojo-rabbitmq-client/issues" }, "homepage" : "https://github.com/inway/mojo-rabbitmq-client", "repository" : { "url" : "git://github.com/inway/mojo-rabbitmq-client.git", "web" : "https://github.com/inway/mojo-rabbitmq-client" } }, "version" : "0.3.1", "x_contributors" : [ "Adam Williamson ", "Adam Williamson ", "Christopher Rasch-Olsen Raa ", "Mohammad S Anwar ", "Oliver Kurz ", "Patrick Goldmann ", "Richard Lippmann ", "Salve J. Nilsen ", "Sebastian Podjasek ", "Sebastian Riedel ", "Stephan Kulow ", "Vidar Tyldum ", "gregor herrmann " ], "x_serialization_backend" : "JSON::PP version 2.97000" } README.md100664001750001750 2401013527056003 15661 0ustar00sebaseba000000000000Mojo-RabbitMQ-Client-0.3.1[![Build Status](https://travis-ci.org/inway/mojo-rabbitmq-client.svg?branch=master)](https://travis-ci.org/inway/mojo-rabbitmq-client) [![MetaCPAN Release](https://badge.fury.io/pl/Mojo-RabbitMQ-Client.svg)](https://metacpan.org/release/Mojo-RabbitMQ-Client) # NAME Mojo::RabbitMQ::Client - Mojo::IOLoop based RabbitMQ client # SYNOPSIS ```perl use Mojo::RabbitMQ::Client; # Supply URL according to (https://www.rabbitmq.com/uri-spec.html) my $client = Mojo::RabbitMQ::Client->new( url => 'amqp://guest:guest@127.0.0.1:5672/'); # Catch all client related errors $client->catch(sub { warn "Some error caught in client"; }); # When connection is in Open state, open new channel $client->on( open => sub { my ($client) = @_; # Create a new channel with auto-assigned id my $channel = Mojo::RabbitMQ::Client::Channel->new(); $channel->catch(sub { warn "Error on channel received"; }); $channel->on( open => sub { my ($channel) = @_; $channel->qos(prefetch_count => 1)->deliver; # Publish some example message to test_queue my $publish = $channel->publish( exchange => 'test', routing_key => 'test_queue', body => 'Test message', mandatory => 0, immediate => 0, header => {} ); # Deliver this message to server $publish->deliver; # Start consuming messages from test_queue my $consumer = $channel->consume(queue => 'test_queue'); $consumer->on(message => sub { say "Got a message" }); $consumer->deliver; } ); $channel->on(close => sub { $log->error('Channel closed') }); $client->open_channel($channel); } ); # Start connection $client->connect(); # Start Mojo::IOLoop if not running already Mojo::IOLoop->start unless Mojo::IOLoop->is_running; ``` ## CONSUMER ```perl use Mojo::RabbitMQ::Client; my $consumer = Mojo::RabbitMQ::Client->consumer( url => 'amqp://guest:guest@127.0.0.1:5672/?exchange=mojo&queue=mojo', defaults => { qos => {prefetch_count => 1}, queue => {durable => 1}, consumer => {no_ack => 0}, } ); $consumer->catch(sub { die "Some error caught in Consumer" } ); $consumer->on('success' => sub { say "Consumer ready" }); $consumer->on( 'message' => sub { my ($consumer, $message) = @_; $consumer->channel->ack($message)->deliver; } ); $consumer->start(); Mojo::IOLoop->start unless Mojo::IOLoop->is_running; ``` ## PUBLISHER ```perl use Mojo::RabbitMQ::Client; my $publisher = Mojo::RabbitMQ::Client->publisher( url => 'amqp://guest:guest@127.0.0.1:5672/?exchange=mojo&routing_key=mojo' ); $publisher->publish('plain text'); $publisher->publish( {encode => { to => 'json'}}, routing_key => 'mojo_mq' )->then(sub { say "Message published"; })->catch(sub { die "Publishing failed" })->wait; ``` # DESCRIPTION [Mojo::RabbitMQ::Client](https://metacpan.org/pod/Mojo::RabbitMQ::Client) is a rewrite of [AnyEvent::RabbitMQ](https://metacpan.org/pod/AnyEvent::RabbitMQ) to work on top of [Mojo::IOLoop](https://metacpan.org/pod/Mojo::IOLoop). # EVENTS [Mojo::RabbitMQ::Client](https://metacpan.org/pod/Mojo::RabbitMQ::Client) inherits all events from [Mojo::EventEmitter](https://metacpan.org/pod/Mojo::EventEmitter) and can emit the following new ones. ## connect ```perl $client->on(connect => sub { my ($client, $stream) = @_; ... }); ``` Emitted when TCP/IP connection with RabbitMQ server is established. ## open ```perl $client->on(open => sub { my ($client) = @_; ... }); ``` Emitted AMQP protocol Connection.Open-Ok method is received. ## close ```perl $client->on(close => sub { my ($client) = @_; ... }); ``` Emitted on reception of Connection.Close-Ok method. ## disconnect ```perl $client->on(close => sub { my ($client) = @_; ... }); ``` Emitted when TCP/IP connection gets disconnected. # ATTRIBUTES [Mojo::RabbitMQ::Client](https://metacpan.org/pod/Mojo::RabbitMQ::Client) has following attributes. ## tls ```perl my $tls = $client->tls; $client = $client->tls(1) ``` Force secure connection. Default is disabled (`0`). ## user ```perl my $user = $client->user; $client = $client->user('guest') ``` Sets username for authorization, by default it's not defined. ## pass ```perl my $pass = $client->pass; $client = $client->pass('secret') ``` Sets user password for authorization, by default it's not defined. ## host ```perl my $host = $client->host; $client = $client->host('localhost') ``` Hostname or IP address of RabbitMQ server. Defaults to `localhost`. ## port ```perl my $port = $client->port; $client = $client->port(1234) ``` Port on which RabbitMQ server listens for new connections. Defaults to `5672`, which is standard RabbitMQ server listen port. ## vhost ```perl my $vhost = $client->vhost; $client = $client->vhost('/') ``` RabbitMQ virtual server to user. Default is `/`. ## params ```perl my $params = $client->params; $client = $client->params(Mojo::Parameters->new('verify=1')) ``` Sets additional parameters for connection. Default is not defined. For list of supported parameters see ["SUPPORTED QUERY PARAMETERS"](#supported-query-parameters). ## url ```perl my $url = $client->url; $client = $client->url('amqp://...'); ``` Sets all connection parameters in one string, according to specification from [https://www.rabbitmq.com/uri-spec.html](https://www.rabbitmq.com/uri-spec.html). ```perl amqp_URI = "amqp[s]://" amqp_authority [ "/" vhost ] [ "?" query ] amqp_authority = [ amqp_userinfo "@" ] host [ ":" port ] amqp_userinfo = username [ ":" password ] username = *( unreserved / pct-encoded / sub-delims ) password = *( unreserved / pct-encoded / sub-delims ) vhost = segment ``` ## heartbeat\_timeout ```perl my $timeout = $client->heartbeat_timeout; $client = $client->heartbeat_timeout(180); ``` Heartbeats are use to monitor peer reachability in AMQP. Default value is `60` seconds, if set to `0` no heartbeats will be sent. ## connect\_timeout ```perl my $timeout = $client->connect_timeout; $client = $client->connect_timeout(5); ``` Connection timeout used by [Mojo::IOLoop::Client](https://metacpan.org/pod/Mojo::IOLoop::Client). Defaults to environment variable `MOJO_CONNECT_TIMEOUT` or `10` seconds if nothing else is set. ## max\_channels ```perl my $max_channels = $client->max_channels; $client = $client->max_channels(10); ``` Maximum number of channels allowed to be active. Defaults to `0` which means no implicit limit. When you try to call `add_channel` over limit an `error` will be emitted on channel saying that: _Maximum number of channels reached_. # STATIC METHODS ## consumer ```perl my $client = Mojo::RabbitMQ::Client->consumer(...) ``` Shortcut for creating [Mojo::RabbitMQ::Client::Consumer](https://metacpan.org/pod/Mojo::RabbitMQ::Client::Consumer). ## publisher ```perl my $client = Mojo::RabbitMQ::Client->publisher(...) ``` Shortcut for creating [Mojo::RabbitMQ::Client::Publisher](https://metacpan.org/pod/Mojo::RabbitMQ::Client::Publisher). # METHODS [Mojo::RabbitMQ::Client](https://metacpan.org/pod/Mojo::RabbitMQ::Client) inherits all methods from [Mojo::EventEmitter](https://metacpan.org/pod/Mojo::EventEmitter) and implements the following new ones. ## connect ``` $client->connect(); ``` Tries to connect to RabbitMQ server and negotiate AMQP protocol. ## close ``` $client->close(); ``` ## param ```perl my $param = $client->param('name'); $client = $client->param(name => 'value'); ``` ## add\_channel ```perl my $channel = Mojo::RabbitMQ::Client::Channel->new(); ... $channel = $client->add_channel($channel); $channel->open; ``` ## open\_channel ```perl my $channel = Mojo::RabbitMQ::Client::Channel->new(); ... $client->open_channel($channel); ``` ## delete\_channel ```perl my $removed = $client->delete_channel($channel->id); ``` # SUPPORTED QUERY PARAMETERS There's no formal specification, nevertheless a list of common parameters recognized by officially supported RabbitMQ clients is maintained here: [https://www.rabbitmq.com/uri-query-parameters.html](https://www.rabbitmq.com/uri-query-parameters.html). Some shortcuts are also supported, you'll find them in parenthesis. Aliases are less significant, so when both are specified only primary value will be used. ## cacertfile (_ca_) Path to Certificate Authority file for TLS. ## certfile (_cert_) Path to the client certificate file for TLS. ## keyfile (_key_) Path to the client certificate private key file for TLS. ## fail\_if\_no\_peer\_cert (_verify_) TLS verification mode, defaults to 0x01 on the client-side if a certificate authority file has been provided, or 0x00 otherwise. ## auth\_mechanism Sets the AMQP authentication mechanism. Defaults to AMQPLAIN. AMQPLAIN and EXTERNAL are supported; EXTERNAL will only work if [Mojo::RabbitMQ::Client](https://metacpan.org/pod/Mojo::RabbitMQ::Client) does not need to do anything beyond passing along a username and password if specified. ## heartbeat Sets requested heartbeat timeout, just like `heartbeat_timeout` attribute. ## connection\_timeout (_timeout_) Sets connection timeout - see [connection\_timeout](https://metacpan.org/pod/connection_timeout) attribute. ## channel\_max Sets maximum number of channels - see [max\_channels](https://metacpan.org/pod/max_channels) attribute. # SEE ALSO [Mojo::RabbitMQ::Client::Channel](https://metacpan.org/pod/Mojo::RabbitMQ::Client::Channel), [Mojo::RabbitMQ::Client::Consumer](https://metacpan.org/pod/Mojo::RabbitMQ::Client::Consumer), [Mojo::RabbitMQ::Client::Publisher](https://metacpan.org/pod/Mojo::RabbitMQ::Client::Publisher) # COPYRIGHT AND LICENSE Copyright (C) 2015-2019, Sebastian Podjasek and others Based on [AnyEvent::RabbitMQ](https://metacpan.org/pod/AnyEvent::RabbitMQ) - Copyright (C) 2010 Masahito Ikuta, maintained by `bobtfish@bobtfish.net` This program is free software, you can redistribute it and/or modify it under the terms of the Artistic License version 2.0. Contains AMQP specification (`shared/amqp0-9-1.stripped.extended.xml`) licensed under BSD-style license. cpanfile100664001750001750 41713527056003 16053 0ustar00sebaseba000000000000Mojo-RabbitMQ-Client-0.3.1requires 'perl', '5.010'; requires 'Mojolicious', '7.53'; requires 'Net::AMQP', '0.06'; requires 'File::ShareDir'; requires 'List::Util', '1.33'; requires 'File::ShareDir'; on 'test' => sub { requires 'Test::More', '0.98'; requires 'Test::Exception', '0.43'; }; chat-monitor.pl100664001750001750 222713527056003 21147 0ustar00sebaseba000000000000Mojo-RabbitMQ-Client-0.3.1/examplesuse Mojo::RabbitMQ::Client; $|++; my $amqp = Mojo::RabbitMQ::Client->new( url => ($ENV{MOJO_RABBITMQ_URL} || 'rabbitmq://guest:guest@127.0.0.1:5672/') ); $amqp->on( open => sub { my ($self) = @_; my $channel = Mojo::RabbitMQ::Channel->new(); $channel->on( open => sub { my $queue = $channel->declare_queue(exclusive => 1); $queue->on( success => sub { my $method = $_[1]->method_frame; my $bind = $channel->bind_queue( exchange => 'mojo', queue => $method->queue, routing_key => '', ); $bind->on( success => sub { my $consumer = $channel->consume(queue => $method->queue); $consumer->on( message => sub { print "<<< " . $_[1]->{body}->payload . " <<<\n"; } ); $consumer->deliver(); } ); $bind->deliver(); } ); $queue->deliver(); } ); $self->open_channel($channel); } ); $amqp->connect(); $amqp->start(); chat.pl100664001750001750 564313527056003 17467 0ustar00sebaseba000000000000Mojo-RabbitMQ-Client-0.3.1/examplesuse Mojolicious::Lite; use Mojo::EventEmitter; use Mojo::RabbitMQ::Client; use Mojo::RabbitMQ::Client::Channel; helper events => sub { state $events = Mojo::EventEmitter->new }; get '/' => 'chat'; websocket '/channel' => sub { my $c = shift; $c->inactivity_timeout(3600); # Forward messages from the browser $c->on(message => sub { shift->events->emit(mojochat => ['browser', shift]) } ); # Forward messages to the browser my $cb = $c->events->on(mojochat => sub { $c->send(join(': ', @{$_[1]})) }); $c->on(finish => sub { shift->events->unsubscribe(mojochat => $cb) }); }; my $amqp = Mojo::RabbitMQ::Client->new( url => ($ENV{MOJO_RABBITMQ_URL} || 'amqp://guest:guest@127.0.0.1:5672/') ); $amqp->on( open => sub { my ($client) = @_; warn "client connected"; my $channel = Mojo::RabbitMQ::Client::Channel->new(); $channel->catch(sub { warn 'Error on channel received'; }); $channel->on( open => sub { # Forward every message from browser to message queue app->events->on( mojochat => sub { return unless $_[1]->[0] eq 'browser'; $channel->publish( exchange => 'mojo', routing_key => '', body => $_[1]->[1], mandatory => 0, immediate => 0, header => {} )->deliver(); } ); # Create anonymous queue and bind it to fanout exchange named mojo my $queue = $channel->declare_queue(exclusive => 1); $queue->on( success => sub { my $method = $_[1]->method_frame; my $bind = $channel->bind_queue( exchange => 'mojo', queue => $method->queue, routing_key => '', ); $bind->on( success => sub { my $consumer = $channel->consume(queue => $method->queue); # Forward every received messsage to browser $consumer->on( message => sub { app->events->emit( mojochat => ['amqp', $_[1]->{body}->payload]); } ); $consumer->deliver(); } ); $bind->deliver(); } ); $queue->deliver(); } ); $channel->on(close => sub { warn 'Channel closed'; }); $client->open_channel($channel); } ); $amqp->connect(); # Minimal single-process WebSocket chat application for browser testing app->start; __DATA__ @@ chat.html.ep
simple.pl100664001750001750 356513527056003 20042 0ustar00sebaseba000000000000Mojo-RabbitMQ-Client-0.3.1/examples#!/usr/bin/perl use Mojo::Base -strict; use Mojo::Log; use Mojo::RabbitMQ::Client; my $log = Mojo::Log->new(threshold => 'trace'); my $amqp = Mojo::RabbitMQ::Client->new( url => 'rabbitmq://guest:guest@127.0.0.1:5672/'); $amqp->catch(sub { $log->error("Error connecting to RabbitMQ") }); $amqp->on(connect => sub { $log->debug("Connected to RabbitMQ host") }); $amqp->on( open => sub { my ($self) = @_; $log->debug("Openned connection to RabbitMQ host"); my $channel = Mojo::RabbitMQ::Channel->new(); $channel->catch(sub { $log->debug("Failed to open channel") }); $channel->on( open => sub { my ($channel) = @_; $log->debug("Opened channel to RabbitMQ host"); $log->debug("Publish sample message to `test_queue` queue"); my $publish = $channel->publish( exchange => 'test', routing_key => 'test_queue', body => 'Test message', mandatory => 0, immediate => 0, header => {} ); $publish->catch(sub { $log->error("Message publish failure") }); $publish->on(success => sub { $log->debug("Message published") }); $publish->on(return => sub { $log->warn("Message returned to us") }); $publish->deliver(); my $consumer = $channel->consume(queue => 'test_queue'); $consumer->catch(sub { $log->error("Error while consuming queue") }); $consumer->on(success => sub { $log->debug("Consumed") }); $consumer->on(message => sub { $log->debug("Received a message") }); $consumer->deliver; } ); $channel->on(close => sub { $log->error('Channel closed') }); $self->open_channel($channel); } ); $amqp->on(close => sub { $log->error("RabbitMQ connection closed") }); $amqp->on(disconnect => sub { $log->error("RabbitMQ disconnected") }); $amqp->connect(); $amqp->start(); AutoInstall.pm100664001750001750 6231213527056003 21204 0ustar00sebaseba000000000000Mojo-RabbitMQ-Client-0.3.1/inc/Module#line 1 package Module::AutoInstall; use strict; use Cwd (); use File::Spec (); use ExtUtils::MakeMaker (); use vars qw{$VERSION}; BEGIN { $VERSION = '0.3.1'; } # special map on pre-defined feature sets my %FeatureMap = ( '' => 'Core Features', # XXX: deprecated '-core' => 'Core Features', ); # various lexical flags my ( @Missing, @Existing, %DisabledTests, $UnderCPAN, $InstallDepsTarget, $HasCPANPLUS ); my ( $Config, $CheckOnly, $SkipInstall, $AcceptDefault, $TestOnly, $AllDeps, $UpgradeDeps ); my ( $PostambleActions, $PostambleActionsNoTest, $PostambleActionsUpgradeDeps, $PostambleActionsUpgradeDepsNoTest, $PostambleActionsListDeps, $PostambleActionsListAllDeps, $PostambleUsed, $NoTest); # See if it's a testing or non-interactive session _accept_default( $ENV{AUTOMATED_TESTING} or ! -t STDIN ); _init(); sub _accept_default { $AcceptDefault = shift; } sub _installdeps_target { $InstallDepsTarget = shift; } sub missing_modules { return @Missing; } sub do_install { __PACKAGE__->install( [ $Config ? ( UNIVERSAL::isa( $Config, 'HASH' ) ? %{$Config} : @{$Config} ) : () ], @Missing, ); } # initialize various flags, and/or perform install sub _init { foreach my $arg ( @ARGV, split( /[\s\t]+/, $ENV{PERL_AUTOINSTALL} || $ENV{PERL_EXTUTILS_AUTOINSTALL} || '' ) ) { if ( $arg =~ /^--config=(.*)$/ ) { $Config = [ split( ',', $1 ) ]; } elsif ( $arg =~ /^--installdeps=(.*)$/ ) { __PACKAGE__->install( $Config, @Missing = split( /,/, $1 ) ); exit 0; } elsif ( $arg =~ /^--upgradedeps=(.*)$/ ) { $UpgradeDeps = 1; __PACKAGE__->install( $Config, @Missing = split( /,/, $1 ) ); exit 0; } elsif ( $arg =~ /^--default(?:deps)?$/ ) { $AcceptDefault = 1; } elsif ( $arg =~ /^--check(?:deps)?$/ ) { $CheckOnly = 1; } elsif ( $arg =~ /^--skip(?:deps)?$/ ) { $SkipInstall = 1; } elsif ( $arg =~ /^--test(?:only)?$/ ) { $TestOnly = 1; } elsif ( $arg =~ /^--all(?:deps)?$/ ) { $AllDeps = 1; } } } # overrides MakeMaker's prompt() to automatically accept the default choice sub _prompt { goto &ExtUtils::MakeMaker::prompt unless $AcceptDefault; my ( $prompt, $default ) = @_; my $y = ( $default =~ /^[Yy]/ ); print $prompt, ' [', ( $y ? 'Y' : 'y' ), '/', ( $y ? 'n' : 'N' ), '] '; print "$default\n"; return $default; } # the workhorse sub import { my $class = shift; my @args = @_ or return; my $core_all; print "*** $class version " . $class->VERSION . "\n"; print "*** Checking for Perl dependencies...\n"; my $cwd = Cwd::getcwd(); $Config = []; my $maxlen = length( ( sort { length($b) <=> length($a) } grep { /^[^\-]/ } map { ref($_) ? ( ( ref($_) eq 'HASH' ) ? keys(%$_) : @{$_} ) : '' } map { +{@args}->{$_} } grep { /^[^\-]/ or /^-core$/i } keys %{ +{@args} } )[0] ); # We want to know if we're under CPAN early to avoid prompting, but # if we aren't going to try and install anything anyway then skip the # check entirely since we don't want to have to load (and configure) # an old CPAN just for a cosmetic message $UnderCPAN = _check_lock(1) unless $SkipInstall || $InstallDepsTarget; while ( my ( $feature, $modules ) = splice( @args, 0, 2 ) ) { my ( @required, @tests, @skiptests ); my $default = 1; my $conflict = 0; if ( $feature =~ m/^-(\w+)$/ ) { my $option = lc($1); # check for a newer version of myself _update_to( $modules, @_ ) and return if $option eq 'version'; # sets CPAN configuration options $Config = $modules if $option eq 'config'; # promote every features to core status $core_all = ( $modules =~ /^all$/i ) and next if $option eq 'core'; next unless $option eq 'core'; } print "[" . ( $FeatureMap{ lc($feature) } || $feature ) . "]\n"; $modules = [ %{$modules} ] if UNIVERSAL::isa( $modules, 'HASH' ); unshift @$modules, -default => &{ shift(@$modules) } if ( ref( $modules->[0] ) eq 'CODE' ); # XXX: bugward compatibility while ( my ( $mod, $arg ) = splice( @$modules, 0, 2 ) ) { if ( $mod =~ m/^-(\w+)$/ ) { my $option = lc($1); $default = $arg if ( $option eq 'default' ); $conflict = $arg if ( $option eq 'conflict' ); @tests = @{$arg} if ( $option eq 'tests' ); @skiptests = @{$arg} if ( $option eq 'skiptests' ); next; } printf( "- %-${maxlen}s ...", $mod ); if ( $arg and $arg =~ /^\D/ ) { unshift @$modules, $arg; $arg = 0; } # XXX: check for conflicts and uninstalls(!) them. my $cur = _version_of($mod); if (_version_cmp ($cur, $arg) >= 0) { print "loaded. ($cur" . ( $arg ? " >= $arg" : '' ) . ")\n"; push @Existing, $mod => $arg; $DisabledTests{$_} = 1 for map { glob($_) } @skiptests; } else { if (not defined $cur) # indeed missing { print "missing." . ( $arg ? " (would need $arg)" : '' ) . "\n"; } else { # no need to check $arg as _version_cmp ($cur, undef) would satisfy >= above print "too old. ($cur < $arg)\n"; } push @required, $mod => $arg; } } next unless @required; my $mandatory = ( $feature eq '-core' or $core_all ); if ( !$SkipInstall and ( $CheckOnly or ($mandatory and $UnderCPAN) or $AllDeps or $InstallDepsTarget or _prompt( qq{==> Auto-install the } . ( @required / 2 ) . ( $mandatory ? ' mandatory' : ' optional' ) . qq{ module(s) from CPAN?}, $default ? 'y' : 'n', ) =~ /^[Yy]/ ) ) { push( @Missing, @required ); $DisabledTests{$_} = 1 for map { glob($_) } @skiptests; } elsif ( !$SkipInstall and $default and $mandatory and _prompt( qq{==> The module(s) are mandatory! Really skip?}, 'n', ) =~ /^[Nn]/ ) { push( @Missing, @required ); $DisabledTests{$_} = 1 for map { glob($_) } @skiptests; } else { $DisabledTests{$_} = 1 for map { glob($_) } @tests; } } if ( @Missing and not( $CheckOnly or $UnderCPAN) ) { require Config; my $make = $Config::Config{make}; if ($InstallDepsTarget) { print "*** To install dependencies type '$make installdeps' or '$make installdeps_notest'.\n"; } else { print "*** Dependencies will be installed the next time you type '$make'.\n"; } # make an educated guess of whether we'll need root permission. print " (You may need to do that as the 'root' user.)\n" if eval '$>'; } print "*** $class configuration finished.\n"; chdir $cwd; # import to main:: no strict 'refs'; *{'main::WriteMakefile'} = \&Write if caller(0) eq 'main'; return (@Existing, @Missing); } sub _running_under { my $thing = shift; print <<"END_MESSAGE"; *** Since we're running under ${thing}, I'll just let it take care of the dependency's installation later. END_MESSAGE return 1; } # Check to see if we are currently running under CPAN.pm and/or CPANPLUS; # if we are, then we simply let it taking care of our dependencies sub _check_lock { return unless @Missing or @_; if ($ENV{PERL5_CPANM_IS_RUNNING}) { return _running_under('cpanminus'); } my $cpan_env = $ENV{PERL5_CPAN_IS_RUNNING}; if ($ENV{PERL5_CPANPLUS_IS_RUNNING}) { return _running_under($cpan_env ? 'CPAN' : 'CPANPLUS'); } require CPAN; if ($CPAN::VERSION > '1.89') { if ($cpan_env) { return _running_under('CPAN'); } return; # CPAN.pm new enough, don't need to check further } # last ditch attempt, this -will- configure CPAN, very sorry _load_cpan(1); # force initialize even though it's already loaded # Find the CPAN lock-file my $lock = MM->catfile( $CPAN::Config->{cpan_home}, ".lock" ); return unless -f $lock; # Check the lock local *LOCK; return unless open(LOCK, $lock); if ( ( $^O eq 'MSWin32' ? _under_cpan() : == getppid() ) and ( $CPAN::Config->{prerequisites_policy} || '' ) ne 'ignore' ) { print <<'END_MESSAGE'; *** Since we're running under CPAN, I'll just let it take care of the dependency's installation later. END_MESSAGE return 1; } close LOCK; return; } sub install { my $class = shift; my $i; # used below to strip leading '-' from config keys my @config = ( map { s/^-// if ++$i; $_ } @{ +shift } ); my ( @modules, @installed, @modules_to_upgrade ); while (my ($pkg, $ver) = splice(@_, 0, 2)) { # grep out those already installed if (_version_cmp(_version_of($pkg), $ver) >= 0) { push @installed, $pkg; if ($UpgradeDeps) { push @modules_to_upgrade, $pkg, $ver; } } else { push @modules, $pkg, $ver; } } if ($UpgradeDeps) { push @modules, @modules_to_upgrade; @installed = (); @modules_to_upgrade = (); } return @installed unless @modules; # nothing to do return @installed if _check_lock(); # defer to the CPAN shell print "*** Installing dependencies...\n"; return unless _connected_to('cpan.org'); my %args = @config; my %failed; local *FAILED; if ( $args{do_once} and open( FAILED, '.#autoinstall.failed' ) ) { while () { chomp; $failed{$_}++ } close FAILED; my @newmod; while ( my ( $k, $v ) = splice( @modules, 0, 2 ) ) { push @newmod, ( $k => $v ) unless $failed{$k}; } @modules = @newmod; } if ( _has_cpanplus() and not $ENV{PERL_AUTOINSTALL_PREFER_CPAN} ) { _install_cpanplus( \@modules, \@config ); } else { _install_cpan( \@modules, \@config ); } print "*** $class installation finished.\n"; # see if we have successfully installed them while ( my ( $pkg, $ver ) = splice( @modules, 0, 2 ) ) { if ( _version_cmp( _version_of($pkg), $ver ) >= 0 ) { push @installed, $pkg; } elsif ( $args{do_once} and open( FAILED, '>> .#autoinstall.failed' ) ) { print FAILED "$pkg\n"; } } close FAILED if $args{do_once}; return @installed; } sub _install_cpanplus { my @modules = @{ +shift }; my @config = _cpanplus_config( @{ +shift } ); my $installed = 0; require CPANPLUS::Backend; my $cp = CPANPLUS::Backend->new; my $conf = $cp->configure_object; return unless $conf->can('conf') # 0.05x+ with "sudo" support or _can_write($conf->_get_build('base')); # 0.04x # if we're root, set UNINST=1 to avoid trouble unless user asked for it. my $makeflags = $conf->get_conf('makeflags') || ''; if ( UNIVERSAL::isa( $makeflags, 'HASH' ) ) { # 0.03+ uses a hashref here $makeflags->{UNINST} = 1 unless exists $makeflags->{UNINST}; } else { # 0.02 and below uses a scalar $makeflags = join( ' ', split( ' ', $makeflags ), 'UNINST=1' ) if ( $makeflags !~ /\bUNINST\b/ and eval qq{ $> eq '0' } ); } $conf->set_conf( makeflags => $makeflags ); $conf->set_conf( prereqs => 1 ); while ( my ( $key, $val ) = splice( @config, 0, 2 ) ) { $conf->set_conf( $key, $val ); } my $modtree = $cp->module_tree; while ( my ( $pkg, $ver ) = splice( @modules, 0, 2 ) ) { print "*** Installing $pkg...\n"; MY::preinstall( $pkg, $ver ) or next if defined &MY::preinstall; my $success; my $obj = $modtree->{$pkg}; if ( $obj and _version_cmp( $obj->{version}, $ver ) >= 0 ) { my $pathname = $pkg; $pathname =~ s/::/\\W/; foreach my $inc ( grep { m/$pathname.pm/i } keys(%INC) ) { delete $INC{$inc}; } my $rv = $cp->install( modules => [ $obj->{module} ] ); if ( $rv and ( $rv->{ $obj->{module} } or $rv->{ok} ) ) { print "*** $pkg successfully installed.\n"; $success = 1; } else { print "*** $pkg installation cancelled.\n"; $success = 0; } $installed += $success; } else { print << "."; *** Could not find a version $ver or above for $pkg; skipping. . } MY::postinstall( $pkg, $ver, $success ) if defined &MY::postinstall; } return $installed; } sub _cpanplus_config { my @config = (); while ( @_ ) { my ($key, $value) = (shift(), shift()); if ( $key eq 'prerequisites_policy' ) { if ( $value eq 'follow' ) { $value = CPANPLUS::Internals::Constants::PREREQ_INSTALL(); } elsif ( $value eq 'ask' ) { $value = CPANPLUS::Internals::Constants::PREREQ_ASK(); } elsif ( $value eq 'ignore' ) { $value = CPANPLUS::Internals::Constants::PREREQ_IGNORE(); } else { die "*** Cannot convert option $key = '$value' to CPANPLUS version.\n"; } push @config, 'prereqs', $value; } elsif ( $key eq 'force' ) { push @config, $key, $value; } elsif ( $key eq 'notest' ) { push @config, 'skiptest', $value; } else { die "*** Cannot convert option $key to CPANPLUS version.\n"; } } return @config; } sub _install_cpan { my @modules = @{ +shift }; my @config = @{ +shift }; my $installed = 0; my %args; _load_cpan(); require Config; if (CPAN->VERSION < 1.80) { # no "sudo" support, probe for writableness return unless _can_write( MM->catfile( $CPAN::Config->{cpan_home}, 'sources' ) ) and _can_write( $Config::Config{sitelib} ); } # if we're root, set UNINST=1 to avoid trouble unless user asked for it. my $makeflags = $CPAN::Config->{make_install_arg} || ''; $CPAN::Config->{make_install_arg} = join( ' ', split( ' ', $makeflags ), 'UNINST=1' ) if ( $makeflags !~ /\bUNINST\b/ and eval qq{ $> eq '0' } ); # don't show start-up info $CPAN::Config->{inhibit_startup_message} = 1; # set additional options while ( my ( $opt, $arg ) = splice( @config, 0, 2 ) ) { ( $args{$opt} = $arg, next ) if $opt =~ /^(?:force|notest)$/; # pseudo-option $CPAN::Config->{$opt} = $opt eq 'urllist' ? [$arg] : $arg; } if ($args{notest} && (not CPAN::Shell->can('notest'))) { die "Your version of CPAN is too old to support the 'notest' pragma"; } local $CPAN::Config->{prerequisites_policy} = 'follow'; while ( my ( $pkg, $ver ) = splice( @modules, 0, 2 ) ) { MY::preinstall( $pkg, $ver ) or next if defined &MY::preinstall; print "*** Installing $pkg...\n"; my $obj = CPAN::Shell->expand( Module => $pkg ); my $success = 0; if ( $obj and _version_cmp( $obj->cpan_version, $ver ) >= 0 ) { my $pathname = $pkg; $pathname =~ s/::/\\W/; foreach my $inc ( grep { m/$pathname.pm/i } keys(%INC) ) { delete $INC{$inc}; } my $rv = do { if ($args{force}) { CPAN::Shell->force( install => $pkg ) } elsif ($args{notest}) { CPAN::Shell->notest( install => $pkg ) } else { CPAN::Shell->install($pkg) } }; $rv ||= eval { $CPAN::META->instance( 'CPAN::Distribution', $obj->cpan_file, ) ->{install} if $CPAN::META; }; if ( $rv eq 'YES' ) { print "*** $pkg successfully installed.\n"; $success = 1; } else { print "*** $pkg installation failed.\n"; $success = 0; } $installed += $success; } else { print << "."; *** Could not find a version $ver or above for $pkg; skipping. . } MY::postinstall( $pkg, $ver, $success ) if defined &MY::postinstall; } return $installed; } sub _has_cpanplus { return ( $HasCPANPLUS = ( $INC{'CPANPLUS/Config.pm'} or _load('CPANPLUS::Shell::Default') ) ); } # make guesses on whether we're under the CPAN installation directory sub _under_cpan { require Cwd; require File::Spec; my $cwd = File::Spec->canonpath( Cwd::getcwd() ); my $cpan = File::Spec->canonpath( $CPAN::Config->{cpan_home} ); return ( index( $cwd, $cpan ) > -1 ); } sub _update_to { my $class = __PACKAGE__; my $ver = shift; return if _version_cmp( _version_of($class), $ver ) >= 0; # no need to upgrade if ( _prompt( "==> A newer version of $class ($ver) is required. Install?", 'y' ) =~ /^[Nn]/ ) { die "*** Please install $class $ver manually.\n"; } print << "."; *** Trying to fetch it from CPAN... . # install ourselves _load($class) and return $class->import(@_) if $class->install( [], $class, $ver ); print << '.'; exit 1; *** Cannot bootstrap myself. :-( Installation terminated. . } # check if we're connected to some host, using inet_aton sub _connected_to { my $site = shift; return ( ( _load('Socket') and Socket::inet_aton($site) ) or _prompt( qq( *** Your host cannot resolve the domain name '$site', which probably means the Internet connections are unavailable. ==> Should we try to install the required module(s) anyway?), 'n' ) =~ /^[Yy]/ ); } # check if a directory is writable; may create it on demand sub _can_write { my $path = shift; mkdir( $path, 0755 ) unless -e $path; return 1 if -w $path; print << "."; *** You are not allowed to write to the directory '$path'; the installation may fail due to insufficient permissions. . if ( eval '$>' and lc(`sudo -V`) =~ /version/ and _prompt( qq( ==> Should we try to re-execute the autoinstall process with 'sudo'?), ((-t STDIN) ? 'y' : 'n') ) =~ /^[Yy]/ ) { # try to bootstrap ourselves from sudo print << "."; *** Trying to re-execute the autoinstall process with 'sudo'... . my $missing = join( ',', @Missing ); my $config = join( ',', UNIVERSAL::isa( $Config, 'HASH' ) ? %{$Config} : @{$Config} ) if $Config; return unless system( 'sudo', $^X, $0, "--config=$config", "--installdeps=$missing" ); print << "."; *** The 'sudo' command exited with error! Resuming... . } return _prompt( qq( ==> Should we try to install the required module(s) anyway?), 'n' ) =~ /^[Yy]/; } # load a module and return the version it reports sub _load { my $mod = pop; # method/function doesn't matter my $file = $mod; $file =~ s|::|/|g; $file .= '.pm'; local $@; return eval { require $file; $mod->VERSION } || ( $@ ? undef: 0 ); } # report version without loading a module sub _version_of { my $mod = pop; # method/function doesn't matter my $file = $mod; $file =~ s|::|/|g; $file .= '.pm'; foreach my $dir ( @INC ) { next if ref $dir; my $path = File::Spec->catfile($dir, $file); next unless -e $path; require ExtUtils::MM_Unix; return ExtUtils::MM_Unix->parse_version($path); } return undef; } # Load CPAN.pm and it's configuration sub _load_cpan { return if $CPAN::VERSION and $CPAN::Config and not @_; require CPAN; # CPAN-1.82+ adds CPAN::Config::AUTOLOAD to redirect to # CPAN::HandleConfig->load. CPAN reports that the redirection # is deprecated in a warning printed at the user. # CPAN-1.81 expects CPAN::HandleConfig->load, does not have # $CPAN::HandleConfig::VERSION but cannot handle # CPAN::Config->load # Which "versions expect CPAN::Config->load? if ( $CPAN::HandleConfig::VERSION || CPAN::HandleConfig->can('load') ) { # Newer versions of CPAN have a HandleConfig module CPAN::HandleConfig->load; } else { # Older versions had the load method in Config directly CPAN::Config->load; } } # compare two versions, either use Sort::Versions or plain comparison # return values same as <=> sub _version_cmp { my ( $cur, $min ) = @_; return -1 unless defined $cur; # if 0 keep comparing return 1 unless $min; $cur =~ s/\s+$//; # check for version numbers that are not in decimal format if ( ref($cur) or ref($min) or $cur =~ /v|\..*\./ or $min =~ /v|\..*\./ ) { if ( ( $version::VERSION or defined( _load('version') )) and version->can('new') ) { # use version.pm if it is installed. return version->new($cur) <=> version->new($min); } elsif ( $Sort::Versions::VERSION or defined( _load('Sort::Versions') ) ) { # use Sort::Versions as the sorting algorithm for a.b.c versions return Sort::Versions::versioncmp( $cur, $min ); } warn "Cannot reliably compare non-decimal formatted versions.\n" . "Please install version.pm or Sort::Versions.\n"; } # plain comparison local $^W = 0; # shuts off 'not numeric' bugs return $cur <=> $min; } # nothing; this usage is deprecated. sub main::PREREQ_PM { return {}; } sub _make_args { my %args = @_; $args{PREREQ_PM} = { %{ $args{PREREQ_PM} || {} }, @Existing, @Missing } if $UnderCPAN or $TestOnly; if ( $args{EXE_FILES} and -e 'MANIFEST' ) { require ExtUtils::Manifest; my $manifest = ExtUtils::Manifest::maniread('MANIFEST'); $args{EXE_FILES} = [ grep { exists $manifest->{$_} } @{ $args{EXE_FILES} } ]; } $args{test}{TESTS} ||= 't/*.t'; $args{test}{TESTS} = join( ' ', grep { !exists( $DisabledTests{$_} ) } map { glob($_) } split( /\s+/, $args{test}{TESTS} ) ); my $missing = join( ',', @Missing ); my $config = join( ',', UNIVERSAL::isa( $Config, 'HASH' ) ? %{$Config} : @{$Config} ) if $Config; $PostambleActions = ( ($missing and not $UnderCPAN) ? "\$(PERL) $0 --config=$config --installdeps=$missing" : "\$(NOECHO) \$(NOOP)" ); my $deps_list = join( ',', @Missing, @Existing ); $PostambleActionsUpgradeDeps = "\$(PERL) $0 --config=$config --upgradedeps=$deps_list"; my $config_notest = join( ',', (UNIVERSAL::isa( $Config, 'HASH' ) ? %{$Config} : @{$Config}), 'notest', 1 ) if $Config; $PostambleActionsNoTest = ( ($missing and not $UnderCPAN) ? "\$(PERL) $0 --config=$config_notest --installdeps=$missing" : "\$(NOECHO) \$(NOOP)" ); $PostambleActionsUpgradeDepsNoTest = "\$(PERL) $0 --config=$config_notest --upgradedeps=$deps_list"; $PostambleActionsListDeps = '@$(PERL) -le "print for @ARGV" ' . join(' ', map $Missing[$_], grep $_ % 2 == 0, 0..$#Missing); my @all = (@Missing, @Existing); $PostambleActionsListAllDeps = '@$(PERL) -le "print for @ARGV" ' . join(' ', map $all[$_], grep $_ % 2 == 0, 0..$#all); return %args; } # a wrapper to ExtUtils::MakeMaker::WriteMakefile sub Write { require Carp; Carp::croak "WriteMakefile: Need even number of args" if @_ % 2; if ($CheckOnly) { print << "."; *** Makefile not written in check-only mode. . return; } my %args = _make_args(@_); no strict 'refs'; $PostambleUsed = 0; local *MY::postamble = \&postamble unless defined &MY::postamble; ExtUtils::MakeMaker::WriteMakefile(%args); print << "." unless $PostambleUsed; *** WARNING: Makefile written with customized MY::postamble() without including contents from Module::AutoInstall::postamble() -- auto installation features disabled. Please contact the author. . return 1; } sub postamble { $PostambleUsed = 1; my $fragment; $fragment .= <<"AUTO_INSTALL" if !$InstallDepsTarget; config :: installdeps \t\$(NOECHO) \$(NOOP) AUTO_INSTALL $fragment .= <<"END_MAKE"; checkdeps :: \t\$(PERL) $0 --checkdeps installdeps :: \t$PostambleActions installdeps_notest :: \t$PostambleActionsNoTest upgradedeps :: \t$PostambleActionsUpgradeDeps upgradedeps_notest :: \t$PostambleActionsUpgradeDepsNoTest listdeps :: \t$PostambleActionsListDeps listalldeps :: \t$PostambleActionsListAllDeps END_MAKE return $fragment; } 1; __END__ #line 1197 Client.pm100664001750001750 5771613527056003 21314 0ustar00sebaseba000000000000Mojo-RabbitMQ-Client-0.3.1/lib/Mojo/RabbitMQpackage Mojo::RabbitMQ::Client; use Mojo::Base 'Mojo::EventEmitter'; use Carp qw(croak confess); use Mojo::URL; use Mojo::Home; use Mojo::IOLoop; use Mojo::Parameters; use Mojo::Promise; use Mojo::Util qw(url_unescape dumper); use List::Util qw(none); use Scalar::Util qw(blessed weaken); use File::Basename 'dirname'; use File::ShareDir qw(dist_file); use Net::AMQP; use Net::AMQP::Common qw(:all); use Mojo::RabbitMQ::Client::Channel; use Mojo::RabbitMQ::Client::LocalQueue; require Mojo::RabbitMQ::Client::Consumer; require Mojo::RabbitMQ::Client::Publisher; our $VERSION = "0.3.1"; use constant DEBUG => $ENV{MOJO_RABBITMQ_DEBUG} // 0; has is_open => 0; has url => undef; has tls => sub { shift->_uri_handler('tls') }; has user => sub { shift->_uri_handler('user') }; has pass => sub { shift->_uri_handler('pass') }; has host => sub { shift->_uri_handler('host') }; has port => sub { shift->_uri_handler('port') }; has vhost => sub { shift->_uri_handler('vhost') }; has params => sub { shift->_uri_handler('params') // Mojo::Parameters->new }; has connect_timeout => sub { $ENV{MOJO_CONNECT_TIMEOUT} // 10 }; has heartbeat_timeout => 60; has heartbeat_received => 0; # When did we receive last heartbeat has heartbeat_sent => 0; # When did we sent last heartbeat has ioloop => sub { Mojo::IOLoop->singleton }; has max_buffer_size => 16384; has max_channels => 0; has queue => sub { Mojo::RabbitMQ::Client::LocalQueue->new }; has channels => sub { {} }; has stream_id => undef; sub connect { my $self = shift; $self->{buffer} = ''; my $id; $id = $self->_connect(sub { $self->_connected($id) }); $self->stream_id($id); return $id; } sub connect_p { my $self = shift; my $promise = Mojo::Promise->new; my $id; weaken $self; my $handler = sub { my ($err) = @_; if (defined $err) { return $promise->reject($err); } return $promise->resolve($self); }; $id = $self->_connect(sub { $self->_connected($id, $handler) }); $self->stream_id($id); return $promise; } sub consumer { my ($class, @params) = @_; croak "consumer is a static method" if ref $class; return Mojo::RabbitMQ::Client::Consumer->new(@params); } sub publisher { my ($class, @params) = @_; croak "publisher is a static method" if ref $class; return Mojo::RabbitMQ::Client::Publisher->new(@params); } sub param { my $self = shift; return undef unless defined $self->params; return $self->params->param(@_); } sub add_channel { my $self = shift; my $channel = shift; my $id = $channel->id; if ($id and $self->channels->{$id}) { return $channel->emit( error => 'Channel with id: ' . $id . ' already defined'); } if ($self->max_channels > 0 and scalar keys %{$self->channels} >= $self->max_channels) { return $channel->emit(error => 'Maximum number of channels reached'); } if (not $id) { for my $candidate_id (1 .. (2**16 - 1)) { next if defined $self->channels->{$candidate_id}; $id = $candidate_id; last; } unless ($id) { return $channel->emit(error => 'Ran out of channel ids'); } } $self->channels->{$id} = $channel->id($id)->client($self); weaken $channel->{client}; return $channel; } sub acquire_channel_p { my $self = shift; my $promise = Mojo::Promise->new; my $channel = Mojo::RabbitMQ::Client::Channel->new(); $channel->catch(sub { $promise->reject(@_); undef $promise }); $channel->on(close => sub { warn "Channel closed" }); $channel->on(open => sub { $promise->resolve(@_); undef $promise }); $self->open_channel($channel); return $promise; } sub open_channel { my $self = shift; my $channel = shift; return $channel->emit(error => 'Client connection not opened') unless $self->is_open; $self->add_channel($channel)->open; return $self; } sub delete_channel { my $self = shift; return delete $self->channels->{shift}; } sub close { my $self = shift; weaken $self; $self->_write_expect( 'Connection::Close' => {}, 'Connection::CloseOk' => sub { warn "-- Connection::CloseOk\n" if DEBUG; $self->emit('close'); $self->_close; }, sub { $self->_close; } ); } sub _loop { $_[0]->ioloop } sub _error { my ($self, $id, $err) = @_; $self->emit(error => $err); } sub _uri_handler { my $self = shift; my $attr = shift; return undef unless defined $self->url; $self->url(Mojo::URL->new($self->url)) unless blessed $self->url && $self->url->isa('Mojo::URL'); # Set some defaults my %defaults = ( tls => 0, user => undef, pass => undef, host => 'localhost', port => 5672, vhost => '/', params => undef ); # Check secure scheme in url $defaults{tls} = 1 if $self->url->scheme =~ /^(amqp|rabbitmq)s$/; # Fallback support for rabbitmq scheme name $defaults{port} = 5671 if $defaults{tls}; # Get host & port $defaults{host} = $self->url->host if defined $self->url->host && $self->url->host ne ''; $defaults{port} = $self->url->port if defined $self->url->port; # Get user & password my $userinfo = $self->url->userinfo; if (defined $userinfo) { my ($user, $pass) = split /:/, $userinfo; $defaults{user} = $user; $defaults{pass} = $pass; } my $vhost = url_unescape $self->url->path; $vhost =~ s|^/(.+)$|$1|; $defaults{vhost} = $vhost if defined $vhost && $vhost ne ''; # Query params my $params = $defaults{params} = $self->url->query; # Handle common aliases to internal names my %aliases = ( cacertfile => 'ca', certfile => 'cert', keyfile => 'key', fail_if_no_peer_cert => 'verify', connection_timeout => 'timeout' ); $params->param($aliases{$_}, $params->param($_)) foreach grep { defined $params->param($_) } keys %aliases; # Some query parameters are translated to attribute values my %attributes = ( heartbeat_timeout => 'heartbeat', connect_timeout => 'timeout', max_channels => 'channel_max' ); $self->$_($params->param($attributes{$_})) foreach grep { defined $params->param($attributes{$_}) } keys %attributes; # Set all $self->$_($defaults{$_}) foreach keys %defaults; return $self->$attr; } sub _close { my $self = shift; $self->_loop->stream($self->stream_id)->close_gracefully; } sub _handle { my ($self, $id, $close) = @_; $self->emit('disconnect'); $self->_loop->remove($id); } sub _read { my ($self, $id, $chunk) = @_; warn "<- @{[dumper $chunk]}" if DEBUG; $self->{buffer} .= $chunk; $self->_parse_frames; return; } sub _parse_frames { my $self = shift; for my $frame (Net::AMQP->parse_raw_frames(\$self->{buffer})) { if ($frame->isa('Net::AMQP::Frame::Heartbeat')) { $self->heartbeat_received(time()); } elsif ($frame->isa('Net::AMQP::Frame::Method') and $frame->method_frame->isa('Net::AMQP::Protocol::Connection::Close')) { $self->is_open(0); $self->_write_frame(Net::AMQP::Protocol::Connection::CloseOk->new()); $self->emit(disconnect => "Server side disconnection: " . $frame->method_frame->{reply_text}); } elsif ($frame->channel == 0) { $self->queue->push($frame); } else { my $channel = $self->channels->{$frame->channel}; if (defined $channel) { $channel->_push_queue_or_consume($frame); } else { $self->emit( error => "Unknown channel id received: " . ($frame->channel // '(undef)'), $frame ); } } } } sub _connect { my ($self, $cb) = @_; # Options # Parse according to (https://www.rabbitmq.com/uri-spec.html) my $options = { address => $self->host, port => $self->port, timeout => $self->connect_timeout, tls => $self->tls, tls_ca => scalar $self->param('ca'), tls_cert => scalar $self->param('cert'), tls_key => scalar $self->param('key') }; my $verify = $self->param('verify'); $options->{tls_verify} = hex $verify if defined $verify; # Connect weaken $self; my $id; return $id = $self->_loop->client( $options => sub { my ($loop, $err, $stream) = @_; # Connection error return unless $self; return $self->_error($id, $err) if $err; $self->emit(connect => $stream); # Connection established $stream->on(timeout => sub { $self->_error($id, 'Inactivity timeout') }); $stream->on(close => sub { $self && $self->_handle($id, 1) }); $stream->on(error => sub { $self && $self->_error($id, pop) }); $stream->on(read => sub { $self && $self->_read($id, pop) }); $cb->(); } ); } sub _connected { my ($self, $id, $cb) = @_; # Inactivity timeout my $stream = $self->_loop->stream($id)->timeout(0); # Store connection information in transaction my $handle = $stream->handle; # Detect that xml spec was already loaded my $loaded = eval { Net::AMQP::Protocol::Connection::StartOk->new; 1 }; unless ($loaded) { # Load AMQP specs my $file = "amqp0-9-1.stripped.extended.xml"; # Original spec is in "fixed_amqp0-8.xml" my $share = dist_file('Mojo-RabbitMQ-Client', $file); Net::AMQP::Protocol->load_xml_spec($share); } $self->_write($id => Net::AMQP::Protocol->header); weaken $self; $self->_expect( 'Connection::Start' => sub { my $frame = shift; my @server_mechanisms = split /\s/, $frame->method_frame->mechanisms; my $param_mechanism = $self->param('auth_mechanism') // ''; my @client_mechanisms = ('AMQPLAIN', 'EXTERNAL'); @client_mechanisms = ($param_mechanism) if ($param_mechanism); warn "-- Server mechanisms: @server_mechanisms\n" if DEBUG; warn "-- Client mechanisms: @client_mechanisms\n" if DEBUG; my $mechanism; for my $cand (@client_mechanisms) { if (grep { $_ eq $cand } @server_mechanisms) { $mechanism = $cand; last; } } return $self->emit(error => 'No authentication mechanism could be negotiated') unless $mechanism; my @locales = split /\s/, $frame->method_frame->locales; return $self->emit(error => 'en_US is not found in locales') if none { $_ eq 'en_US' } @locales; $self->{_server_properties} = $frame->method_frame->server_properties; warn "-- Connection::Start {product: " . $self->{_server_properties}->{product} . ", version: " . $self->{_server_properties}->{version} . "}\n" if DEBUG; $self->_write_frame( Net::AMQP::Protocol::Connection::StartOk->new( client_properties => { platform => 'Perl', product => __PACKAGE__, information => 'https://github.com/inway/mojo-rabbitmq-client', version => __PACKAGE__->VERSION, }, mechanism => $mechanism, response => {LOGIN => $self->user, PASSWORD => $self->pass}, locale => 'en_US', ), ); $self->_tune($id, $cb); }, sub { $self->emit(error => 'Unable to start connection: ' . shift); } ); } sub _tune { my ($self, $id, $cb) = @_; weaken $self; $self->_expect( 'Connection::Tune' => sub { my $frame = shift; my $method_frame = $frame->method_frame; $self->max_buffer_size($method_frame->frame_max); my $heartbeat = $self->heartbeat_timeout || $method_frame->heartbeat; warn "-- Connection::Tune {frame_max: " . $method_frame->frame_max . ", heartbeat: " . $method_frame->heartbeat . "}\n" if DEBUG; # Confirm $self->_write_frame( Net::AMQP::Protocol::Connection::TuneOk->new( channel_max => $method_frame->channel_max, frame_max => $method_frame->frame_max, heartbeat => $heartbeat, ), ); # According to https://www.rabbitmq.com/amqp-0-9-1-errata.html # The client should start sending heartbeats after receiving a Connection.Tune # method, and start monitoring heartbeats after sending Connection.Open. # -and- # Heartbeat frames are sent about every timeout / 2 seconds. After two missed # heartbeats, the peer is considered to be unreachable. $self->{heartbeat_tid} = $self->_loop->recurring( $heartbeat / 2 => sub { return unless time() - $self->heartbeat_sent > $heartbeat / 2; $self->_write_frame(Net::AMQP::Frame::Heartbeat->new()); $self->heartbeat_sent(time()); } ) if $heartbeat; $self->_write_expect( 'Connection::Open' => {virtual_host => $self->vhost, capabilities => '', insist => 1,}, 'Connection::OpenOk' => sub { warn "-- Connection::OpenOk\n" if DEBUG; $self->is_open(1); $self->emit('open'); $cb->() if defined $cb; }, sub { my $err = shift; $self->emit(error => 'Unable to open connection: ' . $err); $cb->($err) if defined $cb; } ); }, sub { $self->emit(error => 'Unable to tune connection: ' . shift); } ); } sub _write_expect { my $self = shift; my ($method, $args, $exp, $cb, $failure_cb, $channel_id) = @_; $method = 'Net::AMQP::Protocol::' . $method; $channel_id ||= 0; my $method_frame = Net::AMQP::Frame::Method->new( method_frame => $method->new(%$args) ); $self->_write_frame( $method_frame, $channel_id ); return $self->_expect($exp, $cb, $failure_cb, $channel_id); } sub _expect { my $self = shift; my ($exp, $cb, $failure_cb, $channel_id) = @_; my @expected = ref($exp) eq 'ARRAY' ? @$exp : ($exp); $channel_id ||= 0; my $queue; if (!$channel_id) { $queue = $self->queue; } else { my $channel = $self->channels->{$channel_id}; if (defined $channel) { $queue = $channel->queue; } else { $failure_cb->( "Unknown channel id received: " . ($channel_id // '(undef)')); } } return unless $queue; $queue->get( sub { my $frame = shift; return $failure_cb->("Received data is not method frame") if not $frame->isa("Net::AMQP::Frame::Method"); my $method_frame = $frame->method_frame; for my $exp (@expected) { return $cb->($frame) if $method_frame->isa("Net::AMQP::Protocol::" . $exp); } $failure_cb->("Method is not " . join(', ', @expected) . ". It's " . ref($method_frame)); } ); } sub _write_frame { my $self = shift; my $id = $self->stream_id; my ($out, $channel, $cb) = @_; if ($out->isa('Net::AMQP::Protocol::Base')) { $out = $out->frame_wrap; } $out->channel($channel // 0); return $self->_write($id, $out->to_raw_frame, $cb); } sub _write { my $self = shift @_; my $id = shift @_; my $frame = shift @_; my $cb = shift @_; warn "-> @{[dumper $frame]}" if DEBUG; utf8::downgrade($frame); $self->_loop->stream($id)->write($frame => $cb) if defined $self->_loop->stream($id); } sub DESTROY { my $self = shift; my $ioloop = $self->ioloop or return; my $heartbeat_tid = $self->{heartbeat_tid}; $ioloop->remove($heartbeat_tid) if $heartbeat_tid; } 1; =encoding utf8 =head1 NAME Mojo::RabbitMQ::Client - Mojo::IOLoop based RabbitMQ client =head1 SYNOPSIS use Mojo::RabbitMQ::Client; # Supply URL according to (https://www.rabbitmq.com/uri-spec.html) my $client = Mojo::RabbitMQ::Client->new( url => 'amqp://guest:guest@127.0.0.1:5672/'); # Catch all client related errors $client->catch(sub { warn "Some error caught in client"; }); # When connection is in Open state, open new channel $client->on( open => sub { my ($client) = @_; # Create a new channel with auto-assigned id my $channel = Mojo::RabbitMQ::Client::Channel->new(); $channel->catch(sub { warn "Error on channel received"; }); $channel->on( open => sub { my ($channel) = @_; $channel->qos(prefetch_count => 1)->deliver; # Publish some example message to test_queue my $publish = $channel->publish( exchange => 'test', routing_key => 'test_queue', body => 'Test message', mandatory => 0, immediate => 0, header => {} ); # Deliver this message to server $publish->deliver; # Start consuming messages from test_queue my $consumer = $channel->consume(queue => 'test_queue'); $consumer->on(message => sub { say "Got a message" }); $consumer->deliver; } ); $channel->on(close => sub { $log->error('Channel closed') }); $client->open_channel($channel); } ); # Start connection $client->connect(); # Start Mojo::IOLoop if not running already Mojo::IOLoop->start unless Mojo::IOLoop->is_running; =head2 CONSUMER use Mojo::RabbitMQ::Client; my $consumer = Mojo::RabbitMQ::Client->consumer( url => 'amqp://guest:guest@127.0.0.1:5672/?exchange=mojo&queue=mojo', defaults => { qos => {prefetch_count => 1}, queue => {durable => 1}, consumer => {no_ack => 0}, } ); $consumer->catch(sub { die "Some error caught in Consumer" } ); $consumer->on('success' => sub { say "Consumer ready" }); $consumer->on( 'message' => sub { my ($consumer, $message) = @_; $consumer->channel->ack($message)->deliver; } ); $consumer->start(); Mojo::IOLoop->start unless Mojo::IOLoop->is_running; =head2 PUBLISHER use Mojo::RabbitMQ::Client; my $publisher = Mojo::RabbitMQ::Client->publisher( url => 'amqp://guest:guest@127.0.0.1:5672/?exchange=mojo&routing_key=mojo' ); $publisher->publish('plain text'); $publisher->publish( {encode => { to => 'json'}}, routing_key => 'mojo_mq' )->then(sub { say "Message published"; })->catch(sub { die "Publishing failed" })->wait; =head1 DESCRIPTION L is a rewrite of L to work on top of L. =head1 EVENTS L inherits all events from L and can emit the following new ones. =head2 connect $client->on(connect => sub { my ($client, $stream) = @_; ... }); Emitted when TCP/IP connection with RabbitMQ server is established. =head2 open $client->on(open => sub { my ($client) = @_; ... }); Emitted AMQP protocol Connection.Open-Ok method is received. =head2 close $client->on(close => sub { my ($client) = @_; ... }); Emitted on reception of Connection.Close-Ok method. =head2 disconnect $client->on(close => sub { my ($client) = @_; ... }); Emitted when TCP/IP connection gets disconnected. =head1 ATTRIBUTES L has following attributes. =head2 tls my $tls = $client->tls; $client = $client->tls(1) Force secure connection. Default is disabled (C<0>). =head2 user my $user = $client->user; $client = $client->user('guest') Sets username for authorization, by default it's not defined. =head2 pass my $pass = $client->pass; $client = $client->pass('secret') Sets user password for authorization, by default it's not defined. =head2 host my $host = $client->host; $client = $client->host('localhost') Hostname or IP address of RabbitMQ server. Defaults to C. =head2 port my $port = $client->port; $client = $client->port(1234) Port on which RabbitMQ server listens for new connections. Defaults to C<5672>, which is standard RabbitMQ server listen port. =head2 vhost my $vhost = $client->vhost; $client = $client->vhost('/') RabbitMQ virtual server to user. Default is C. =head2 params my $params = $client->params; $client = $client->params(Mojo::Parameters->new('verify=1')) Sets additional parameters for connection. Default is not defined. For list of supported parameters see L. =head2 url my $url = $client->url; $client = $client->url('amqp://...'); Sets all connection parameters in one string, according to specification from L. amqp_URI = "amqp[s]://" amqp_authority [ "/" vhost ] [ "?" query ] amqp_authority = [ amqp_userinfo "@" ] host [ ":" port ] amqp_userinfo = username [ ":" password ] username = *( unreserved / pct-encoded / sub-delims ) password = *( unreserved / pct-encoded / sub-delims ) vhost = segment =head2 heartbeat_timeout my $timeout = $client->heartbeat_timeout; $client = $client->heartbeat_timeout(180); Heartbeats are use to monitor peer reachability in AMQP. Default value is C<60> seconds, if set to C<0> no heartbeats will be sent. =head2 connect_timeout my $timeout = $client->connect_timeout; $client = $client->connect_timeout(5); Connection timeout used by L. Defaults to environment variable C or C<10> seconds if nothing else is set. =head2 max_channels my $max_channels = $client->max_channels; $client = $client->max_channels(10); Maximum number of channels allowed to be active. Defaults to C<0> which means no implicit limit. When you try to call C over limit an C will be emitted on channel saying that: I. =head1 STATIC METHODS =head2 consumer my $client = Mojo::RabbitMQ::Client->consumer(...) Shortcut for creating L. =head2 publisher my $client = Mojo::RabbitMQ::Client->publisher(...) Shortcut for creating L. =head1 METHODS L inherits all methods from L and implements the following new ones. =head2 connect $client->connect(); Tries to connect to RabbitMQ server and negotiate AMQP protocol. =head2 close $client->close(); =head2 param my $param = $client->param('name'); $client = $client->param(name => 'value'); =head2 add_channel my $channel = Mojo::RabbitMQ::Client::Channel->new(); ... $channel = $client->add_channel($channel); $channel->open; =head2 open_channel my $channel = Mojo::RabbitMQ::Client::Channel->new(); ... $client->open_channel($channel); =head2 delete_channel my $removed = $client->delete_channel($channel->id); =head1 SUPPORTED QUERY PARAMETERS There's no formal specification, nevertheless a list of common parameters recognized by officially supported RabbitMQ clients is maintained here: L. Some shortcuts are also supported, you'll find them in parenthesis. Aliases are less significant, so when both are specified only primary value will be used. =head2 cacertfile (I) Path to Certificate Authority file for TLS. =head2 certfile (I) Path to the client certificate file for TLS. =head2 keyfile (I) Path to the client certificate private key file for TLS. =head2 fail_if_no_peer_cert (I) TLS verification mode, defaults to 0x01 on the client-side if a certificate authority file has been provided, or 0x00 otherwise. =head2 auth_mechanism Sets the AMQP authentication mechanism. Defaults to AMQPLAIN. AMQPLAIN and EXTERNAL are supported; EXTERNAL will only work if L does not need to do anything beyond passing along a username and password if specified. =head2 heartbeat Sets requested heartbeat timeout, just like C attribute. =head2 connection_timeout (I) Sets connection timeout - see L attribute. =head2 channel_max Sets maximum number of channels - see L attribute. =head1 SEE ALSO L, L, L =head1 COPYRIGHT AND LICENSE Copyright (C) 2015-2019, Sebastian Podjasek and others Based on L - Copyright (C) 2010 Masahito Ikuta, maintained by C<< bobtfish@bobtfish.net >> This program is free software, you can redistribute it and/or modify it under the terms of the Artistic License version 2.0. Contains AMQP specification (F) licensed under BSD-style license. =cut Channel.pm100664001750001750 10437413527056003 22675 0ustar00sebaseba000000000000Mojo-RabbitMQ-Client-0.3.1/lib/Mojo/RabbitMQ/Clientpackage Mojo::RabbitMQ::Client::Channel; use Mojo::Base 'Mojo::EventEmitter'; use Mojo::Promise; use Mojo::RabbitMQ::Client::LocalQueue; use Mojo::RabbitMQ::Client::Method; use Mojo::RabbitMQ::Client::Method::Publish; use Scalar::Util qw(isweak weaken); use constant DEBUG => $ENV{MOJO_RABBITMQ_DEBUG} // 0; has id => 0; has is_open => 0; has is_active => 0; has client => undef; has queue => sub { Mojo::RabbitMQ::Client::LocalQueue->new }; has content_queue => sub { Mojo::RabbitMQ::Client::LocalQueue->new }; has consumer_cbs => sub { {} }; has return_cbs => sub { {} }; sub _open { warn "Deprecated call to _open on channel"; return shift->open(@_); } sub open { my $self = shift; if ($self->is_open) { $self->emit(error => 'Channel has already been opened'); return $self; } weaken $self; $self->client->_write_expect( 'Channel::Open' => {}, 'Channel::OpenOk' => sub { warn "-- Channel::OpenOk\n" if DEBUG; $self->is_open(1)->is_active(1)->emit('open'); }, sub { $self->emit( error => 'Invalid response received while trying to open channel: ' . shift); }, $self->id, ); return $self; } sub _push_queue_or_consume { my $self = shift; my ($frame) = @_; weaken $self; if ($frame->isa('Net::AMQP::Frame::Method')) { my $method_frame = $frame->method_frame; if ($method_frame->isa('Net::AMQP::Protocol::Channel::Close')) { $self->client->_write_frame(Net::AMQP::Protocol::Channel::CloseOk->new(), $self->id); $self->is_open(0)->is_active(0); $self->client->delete_channel($self->id); $self->emit(close => $frame); return $self; } elsif ($method_frame->isa('Net::AMQP::Protocol::Basic::Deliver')) { my $cb = $self->consumer_cbs->{$method_frame->consumer_tag} || sub { }; $self->_push_read_header_and_body( 'deliver', $frame => sub { $cb->emit(message => @_); }, sub { $self->emit(error => 'Consumer callback failure: ' . shift); } ); return $self; } elsif ($method_frame->isa('Net::AMQP::Protocol::Basic::Return')) { my $cb = $self->return_cbs->{$method_frame->exchange . '_' . $method_frame->routing_key} || sub { }; $self->_push_read_header_and_body( 'return', $frame => sub { $cb->emit(reject => @_); }, sub { $self->emit(error => 'Return callback failure: ' . shift); } ); return $self; } elsif ($method_frame->isa('Net::AMQP::Protocol::Channel::Flow')) { $self->is_active($method_frame->active); $self->client->_write_frame( Net::AMQP::Protocol::Channel::FlowOk->new( active => $method_frame->active ), $self->id ); return $self; } $self->queue->push($frame); } else { $self->content_queue->push($frame); } return $self; } sub close { my $self = shift; my $connection = $self->client or return; return $self if !$self->is_open; return $self->_close() if 0 == scalar keys %{$self->consumer_cbs}; for my $consumer_tag (keys %{$self->consumer_cbs}) { my $method = $self->cancel(consumer_tag => $consumer_tag); weaken $self unless isweak $self; $method->on( success => sub { $self->_close(); } ); $method->catch( sub { $self->_close(); $self->emit(error => 'Error canceling consumption: ' . shift, @_); } ); $method->deliver(); } return $self; } sub _close { my $self = shift; my %args = @_; return unless 0 == scalar keys %{$self->consumer_cbs}; $self->client->_write_expect( 'Channel::Close' => {}, 'Channel::CloseOk' => sub { warn "-- Channel::CloseOk\n" if DEBUG; $self->is_open(0)->is_active(0); $self->client->delete_channel($self->id); $self->emit('close'); }, sub { $self->is_open(0)->is_active(0); $self->client->delete_channel($self->id); $self->emit(error => 'Failed closing channel: ' . shift); }, $self->id, ); return $self; } sub _assert_open { my $self = shift; return 0 unless $self->is_open and $self->is_active; return 1; } sub _prepare_method { my $self = shift; my $method = Mojo::RabbitMQ::Client::Method->new( client => $self->client, channel => $self ); weaken $method->{channel}; weaken $method->{client}; return $method->setup(@_); } sub declare_exchange { my $self = shift; return $self->_prepare_method( 'Exchange::Declare' => { type => 'direct', passive => 0, durable => 0, auto_delete => 0, internal => 0, @_, # exchange ticket => 0, nowait => 0, # FIXME }, 'Exchange::DeclareOk' => sub { warn "-- Exchange::DeclareOk\n" if DEBUG; } ); } sub declare_exchange_p { my $self = shift; my $promise = Mojo::Promise->new; my $method = $self->declare_exchange(@_); weaken $self; $method->on('success' => sub { shift; $promise->resolve($self, @_) }); $method->on('error' => sub { shift; $promise->reject($self, @_) }); $method->deliver; return $promise; } sub delete_exchange { my $self = shift; return $self->_prepare_method( 'Exchange::Delete' => { if_unused => 0, @_, # exchange ticket => 0, nowait => 0, # FIXME }, 'Exchange::DeleteOk' => sub { warn "-- Exchange::DeleteOk\n" if DEBUG; } ); } sub delete_exchange_p { my $self = shift; my $promise = Mojo::Promise->new; my $method = $self->delete_exchange(@_); weaken $self; $method->on('success' => sub { shift; $promise->resolve($self, @_) }); $method->on('error' => sub { shift; $promise->reject($self, @_) }); $method->deliver; return $promise; } sub declare_queue { my $self = shift; return $self->_prepare_method( 'Queue::Declare' => { queue => '', passive => 0, durable => 0, exclusive => 0, auto_delete => 0, no_ack => 1, @_, ticket => 0, nowait => 0, # FIXME }, 'Queue::DeclareOk' => sub { warn "-- Queue::DeclareOk\n" if DEBUG; } ); } sub declare_queue_p { my $self = shift; my $promise = Mojo::Promise->new; my $method = $self->declare_queue(@_); weaken $self; $method->on('success' => sub { shift; $promise->resolve($self, @_) }); $method->on('error' => sub { shift; $promise->reject($self, @_) }); $method->deliver; return $promise; } sub bind_queue { my $self = shift; return $self->_prepare_method( 'Queue::Bind' => { @_, # queue, exchange, routing_key ticket => 0, nowait => 0, # FIXME }, 'Queue::BindOk' => sub { warn "-- Queue::BindOk\n" if DEBUG; } ); } sub bind_queue_p { my $self = shift; my $promise = Mojo::Promise->new; my $method = $self->bind_queue(@_); $method->on('success' => sub { shift; $promise->resolve($self, @_) }); $method->on('error' => sub { shift; $promise->reject($self, @_) }); $method->deliver; return $promise; } sub unbind_queue { my $self = shift; return $self->_prepare_method( 'Queue::Unbind' => { @_, # queue, exchange, routing_key ticket => 0, }, 'Queue::UnbindOk' => sub { warn "-- Queue::UnbindOk\n" if DEBUG; } ); } sub unbind_queue_p { my $self = shift; my $promise = Mojo::Promise->new; my $method = $self->unbind_queue(@_); weaken $self; $method->on('success' => sub { shift; $promise->resolve($self, @_) }); $method->on('error' => sub { shift; $promise->reject($self, @_) }); $method->deliver; return $promise; } sub purge_queue { my $self = shift; return $self->_prepare_method( 'Queue::Purge' => { @_, # queue ticket => 0, nowait => 0, # FIXME }, 'Queue::PurgeOk' => sub { warn "-- Queue::PurgeOk\n" if DEBUG; } ); } sub purge_queue_p { my $self = shift; my $promise = Mojo::Promise->new; my $method = $self->purge_queue(@_); weaken $self; $method->on('success' => sub { shift; $promise->resolve($self, @_) }); $method->on('error' => sub { shift; $promise->reject($self, @_) }); $method->deliver; return $promise; } sub delete_queue { my $self = shift; return $self->_prepare_method( 'Queue::Delete' => { if_unused => 0, if_empty => 0, @_, # queue ticket => 0, nowait => 0, # FIXME }, 'Queue::DeleteOk' => sub { warn "-- Queue::DeleteOk\n" if DEBUG; } ); } sub delete_queue_p { my $self = shift; my $promise = Mojo::Promise->new; my $method = $self->delete_queue(@_); weaken $self; $method->on('success' => sub { shift; $promise->resolve($self, @_) }); $method->on('error' => sub { shift; $promise->reject($self, @_) }); $method->deliver; return $promise; } sub publish { my $self = shift; return Mojo::RabbitMQ::Client::Method::Publish->new( client => $self->client, channel => $self )->setup(@_); } sub publish_p { my $self = shift; my $promise = Mojo::Promise->new; my $method = Mojo::RabbitMQ::Client::Method::Publish->new( client => $self->client, channel => $self ); weaken $method->{client}; weaken $method->{channel}; $method->setup(@_); weaken $self; $method->on('success' => sub { shift; $promise->resolve($self, @_) }); $method->on('error' => sub { shift; $promise->reject($self, @_) }); $method->deliver; return $promise; } sub consume { my $self = shift; my $method = $self->_prepare_method( 'Basic::Consume' => { consumer_tag => '', no_local => 0, no_ack => 1, exclusive => 0, @_, ticket => 0, nowait => 0 }, 'Basic::ConsumeOk' => sub { warn "-- Basic::ConsumeOk\n" if DEBUG; } ); weaken $self; $method->on( success => sub { my $this = shift; my $frame = shift; my $tag = $frame->method_frame->consumer_tag; $self->consumer_cbs->{$tag} = $this; } ); return $method; } sub cancel { my $self = shift; my $method = $self->_prepare_method( 'Basic::Cancel', { @_, # consumer_tag nowait => 0, }, 'Basic::CancelOk' => sub { warn "-- Basic::CancelOk\n" if DEBUG; } ); weaken $self; $method->on( success => sub { my $this = shift; my $frame = shift; delete $self->consumer_cbs->{$frame->method_frame->consumer_tag}; } ); return $method; } sub get { my $self = shift; my $method = $self->_prepare_method( 'Basic::Get', { no_ack => 1, @_, # queue ticket => 0, }, [qw(Basic::GetOk Basic::GetEmpty)] ); weaken $self; $method->on( success => sub { warn "-- Basic::GetOk|GetEmpty\n" if DEBUG; my $this = shift; my $frame = shift; $this->emit(empty => $frame) if $frame->method_frame->isa('Net::AMQP::Protocol::Basic::GetEmpty'); $self->_push_read_header_and_body( 'ok', $frame, sub { $this->emit(message => $frame, @_); }, sub { $this->emit(error => 'Failed to get messages from queue'); } ); } ); return $method; } sub get_p { my $self = shift; my $promise = Mojo::Promise->new; my $method = $self->get(@_); weaken $self; $method->on('message' => sub { shift; $promise->resolve($self, @_) }); $method->on('empty' => sub { shift; $promise->resolve($self, @_) }); $method->on('error' => sub { shift; $promise->reject($self, @_) }); $method->deliver; return $promise; } sub ack { my $self = shift; my %args = (); if (ref($_[0]) eq 'HASH') { if (defined $_[0]->{ok}) { $args{delivery_tag} = $_[0]->{ok}->method_frame->delivery_tag; } elsif (defined $_[0]->{deliver}) { $args{delivery_tag} = $_[0]->{deliver}->method_frame->delivery_tag; } } else { %args = @_; } die "ack requires delivery_tag in arguments" unless defined $args{delivery_tag}; return $self->_prepare_method( 'Basic::Ack' => { delivery_tag => 0, multiple => (defined $args{delivery_tag} && $args{delivery_tag} != 0 ? 0 : 1), %args, } ); } sub ack_p { my $self = shift; my $promise = Mojo::Promise->new; my $method = $self->ack(@_); weaken $self; $method->on('success' => sub { shift; $promise->resolve($self, @_) }); $method->on('error' => sub { shift; $promise->reject($self, @_) }); $method->deliver; return $promise; } sub qos { my $self = shift; return $self->_prepare_method('Basic::Qos', {prefetch_count => 1, @_, prefetch_size => 0, global => 0,}, 'Basic::QosOk'); } sub recover { my $self = shift; return $self->_prepare_method('Basic::Recover' => {requeue => 1, @_,}); } sub reject { my $self = shift; return $self->_prepare_method( 'Basic::Reject' => {delivery_tag => 0, requeue => 0, @_,}); } sub select_tx { my $self = shift; return $self->_prepare_method('Tx::Select', {}, 'Tx::SelectOk'); } sub commit_tx { my $self = shift; return $self->_prepare_method('Tx::Commit', {}, 'Tx::CommitOk'); } sub rollback_tx { my $self = shift; return $self->_prepare_method('Tx::Rollback', {}, 'Tx::RollbackOk'); } sub _push_read_header_and_body { my $self = shift; my ($type, $frame, $cb, $failure_cb) = @_; my $response = {$type => $frame}; my $body_size = 0; $self->content_queue->get( sub { my $frame = shift; return $failure_cb->('Received data is not header frame') if !$frame->isa('Net::AMQP::Frame::Header'); my $header_frame = $frame->header_frame; return $failure_cb->('Header is not Protocol::Basic::ContentHeader' . 'Header was ' . ref $header_frame) if !$header_frame->isa('Net::AMQP::Protocol::Basic::ContentHeader'); $response->{header} = $header_frame; $body_size = $frame->body_size; } ); my $body_payload = ""; my $next_frame; $next_frame = sub { my $frame = shift; return $failure_cb->('Received data is not body frame') if !$frame->isa('Net::AMQP::Frame::Body'); $body_payload .= $frame->payload; if (length($body_payload) < $body_size) { # More to come $self->content_queue->get($next_frame); } else { $frame->payload($body_payload); $response->{body} = $frame; $cb->($response); } }; $self->content_queue->get($next_frame); return $self; } sub DESTROY { my $self = shift; $self->close() if defined $self; return; } 1; =encoding utf8 =head1 NAME Mojo::RabbitMQ::Client::Channel - handles all channel related methods =head1 SYNOPSIS use Mojo::RabbitMQ::Client::Channel; my $channel = Mojo::RabbitMQ::Client::Channel->new(); $channel->catch(sub { warn "Some channel error occurred: " . $_[1] }); $channel->on( open => sub { my ($channel) = @_; ... } ); $channel->on(close => sub { warn "Channel closed" }); $client->open_channel($channel); =head1 DESCRIPTION L allows one to call all channel related methods. =head1 EVENTS L inherits all events from L and can emit the following new ones. =head2 open $channel->on(open => sub { my ($channel) = @_; ... }); Emitted when channel receives Open-Ok. =head2 close $channel->on(close=> sub { my ($channel, $frame) = @_; ... }); Emitted when channel gets closed, C<$frame> contains close reason. =head1 ATTRIBUTES L has following attributes. =head2 id my $id = $channel->id; $channel->id(20810); If not set, L sets it to next free number when channel is opened. =head2 is_open $channel->is_open ? "Channel is open" : "Channel is closed"; =head2 is_active $channel->is_active ? "Channel is active" : "Channel is not active"; This can be modified on reception of Channel-Flow. =head2 client my $client = $channel->client; $channel->client($client); =head1 METHODS L inherits all methods from L and implements the following new ones. =head2 close $channel->close; Cancels all consumers and closes channel afterwards. =head2 declare_exchange my $exchange = $channel->declare_exchange( exchange => 'mojo', type => 'fanout', durable => 1, ... )->deliver; Verify exchange exists, create if needed. This method creates an exchange if it does not already exist, and if the exchange exists, verifies that it is of the correct and expected class. Following arguments are accepted: =over 2 =item exchange Unique exchange name =item type Each exchange belongs to one of a set of exchange types implemented by the server. The exchange types define the functionality of the exchange - i.e. how messages are routed through it. It is not valid or meaningful to attempt to change the type of an existing exchange. =item passive If set, the server will reply with Declare-Ok if the exchange already exists with the same name, and raise an error if not. The client can use this to check whether an exchange exists without modifying the server state. When set, all other method fields except name and no-wait are ignored. A declare with both passive and no-wait has no effect. Arguments are compared for semantic equivalence. =item durable If set when creating a new exchange, the exchange will be marked as durable. Durable exchanges remain active when a server restarts. Non-durable exchanges (transient exchanges) are purged if/when a server restarts. =item auto_delete If set, the exchange is deleted when all queues have finished using it. =item internal If set, the exchange may not be used directly by publishers, but only when bound to other exchanges. Internal exchanges are used to construct wiring that is not visible to applications. =back =head2 declare_exchange_p Same as L but auto-delivers method and returns a L object. $channel->declare_exchange_p( exchange => 'mojo', type => 'fanout', durable => 1, ... )->then(sub { say "Exchange declared..."; })->catch(sub { my $err = shift; warn "Exchange declaration error: $err"; })->wait; =head2 delete_exchange $channel->delete_exchange(exchange => 'mojo')->deliver; Delete an exchange. This method deletes an exchange. When an exchange is deleted all queue bindings on the exchange are cancelled. Following arguments are accepted: =over 2 =item exchange Exchange name. =item if_unused If set, the server will only delete the exchange if it has no queue bindings. If the exchange has queue bindings the server does not delete it but raises a channel exception instead. =back =head2 delete_exchange_p Same as L but auto-delivers method and returns a L object. $channel->delete_exchange_p( exchange => 'mojo' )->then(sub { say "Exchange deleted..."; })->catch(sub { my $err = shift; warn "Exchange removal error: $err"; })->wait; =head2 declare_queue my $queue = $channel->declare_queue(queue => 'mq', durable => 1)->deliver Declare queue, create if needed. This method creates or checks a queue. When creating a new queue the client can specify various properties that control the durability of the queue and its contents, and the level of sharing for the queue. Following arguments are accepted: =over 2 =item queue The queue name MAY be empty, in which case the server MUST create a new queue with a unique generated name and return this to the client in the Declare-Ok method. =item passive If set, the server will reply with Declare-Ok if the queue already exists with the same name, and raise an error if not. The client can use this to check whether a queue exists without modifying the server state. When set, all other method fields except name and no-wait are ignored. A declare with both passive and no-wait has no effect. Arguments are compared for semantic equivalence. =item durable If set when creating a new queue, the queue will be marked as durable. Durable queues remain active when a server restarts. Non-durable queues (transient queues) are purged if/when a server restarts. Note that durable queues do not necessarily hold persistent messages, although it does not make sense to send persistent messages to a transient queue. =item exclusive Exclusive queues may only be accessed by the current connection, and are deleted when that connection closes. Passive declaration of an exclusive queue by other connections are not allowed. =item auto_delete If set, the queue is deleted when all consumers have finished using it. The last consumer can be cancelled either explicitly or because its channel is closed. If there was no consumer ever on the queue, it won't be deleted. Applications can explicitly delete auto-delete queues using the Delete method as normal. =back =head2 declare_queue_p Same as L but auto-delivers method and returns a L object. $channel->declare_queue_p( queue => 'mq', durable => 1 )->then(sub { say "Queue declared..."; })->catch(sub { my $err = shift; warn "Queue declaration error: $err"; })->wait; =head2 bind_queue $channel->bind_queue( exchange => 'mojo', queue => 'mq', routing_key => '' )->deliver; Bind queue to an exchange. This method binds a queue to an exchange. Until a queue is bound it will not receive any messages. In a classic messaging model, store-and-forward queues are bound to a direct exchange and subscription queues are bound to a topic exchange. Following arguments are accepted: =over 2 =item queue Specifies the name of the queue to bind. =item exchange Name of the exchange to bind to. =item routing_key Specifies the routing key for the binding. The routing key is used for routing messages depending on the exchange configuration. Not all exchanges use a routing key - refer to the specific exchange documentation. If the queue name is empty, the server uses the last queue declared on the channel. If the routing key is also empty, the server uses this queue name for the routing key as well. If the queue name is provided but the routing key is empty, the server does the binding with that empty routing key. The meaning of empty routing keys depends on the exchange implementation. =back =head2 bind_queue_p Same as L but auto-delivers method and returns a L object. $channel->bind_queue_p( exchange => 'mojo', queue => 'mq', routing_key => '' )->then(sub { say "Queue bound..."; })->catch(sub { my $err = shift; warn "Queue binding error: $err"; })->wait; =head2 unbind_queue $channel->unbind_queue( exchange => 'mojo', queue => 'mq', routing_key => '' )->deliver; Unbind a queue from an exchange. This method unbinds a queue from an exchange. Following arguments are accepted: =over 2 =item queue Specifies the name of the queue to unbind. =item exchange The name of the exchange to unbind from. =item routing_key Specifies the routing key of the binding to unbind. =back =head2 unbind_queue_p Same as L but auto-delivers method and returns a L object. $channel->unbind_queue_p( exchange => 'mojo', queue => 'mq', routing_key => '' )->then(sub { say "Queue unbound..."; })->catch(sub { my $err = shift; warn "Queue unbinding error: $err"; })->wait; =head2 purge_queue $channel->purge_queue(queue => 'mq')->deliver; Purge a queue. This method removes all messages from a queue which are not awaiting acknowledgment. Following arguments are accepted: =over 2 =item queue Specifies the name of the queue to purge. =back =head2 purge_queue_p Same as L but auto-delivers method and returns a L object. $channel->purge_queue_p( queue => 'mq', )->then(sub { say "Queue purged..."; })->catch(sub { my $err = shift; warn "Queue purging error: $err"; })->wait; =head2 delete_queue $channel->delete_queue(queue => 'mq', if_empty => 1)->deliver; Delete a queue. This method deletes a queue. When a queue is deleted any pending messages are sent to a dead-letter queue if this is defined in the server configuration, and all consumers on the queue are cancelled. Following arguments are accepted: =over 2 =item queue Specifies the name of the queue to delete. =item if_unused If set, the server will only delete the queue if it has no consumers. If the queue has consumers the server does does not delete it but raises a channel exception instead. =item if_empty If set, the server will only delete the queue if it has no messages. =back =head2 delete_queue_p Same as L but auto-delivers method and returns a L object. $channel->delete_queue_p( queue => 'mq', if_empty => 1 )->then(sub { say "Queue removed..."; })->catch(sub { my $err = shift; warn "Queue removal error: $err"; })->wait; =head2 publish my $message = $channel->publish( exchange => 'mojo', routing_key => 'mq', body => 'simple text body', ); $message->deliver(); Publish a message. This method publishes a message to a specific exchange. The message will be routed to queues as defined by the exchange configuration and distributed to any active consumers when the transaction, if any, is committed. Following arguments are accepted: =over 2 =item exchange Specifies the name of the exchange to publish to. The exchange name can be empty, meaning the default exchange. If the exchange name is specified, and that exchange does not exist, the server will raise a channel exception. =item routing_key Specifies the routing key for the message. The routing key is used for routing messages depending on the exchange configuration. =item mandatory This flag tells the server how to react if the message cannot be routed to a queue. If this flag is set, the server will return an unroutable message with a Return method. If this flag is zero, the server silently drops the message. All rejections are emitted as C event. $message->on(reject => sub { my $message = shift; my $frame = shift; my $method_frame = $frame->method_frame; my $reply_code = $method_frame->reply_code; my $reply_text = $method_frame->reply_text; }); =item immediate This flag tells the server how to react if the message cannot be routed to a queue consumer immediately. If this flag is set, the server will return an undeliverable message with a Return method. If this flag is zero, the server will queue the message, but with no guarantee that it will ever be consumed. As said above, all rejections are emitted as C event. $message->on(reject => sub { ... }); =back =head2 consume my $consumer = $channel->consume(queue => 'mq'); $consumer->on(message => sub { ... }); $consumer->deliver; This method asks the server to start a "consumer", which is a transient request for messages from a specific queue. Consumers last as long as the channel they were declared on, or until the client cancels them. Following arguments are accepted: =over 2 =item queue Specifies the name of the queue to consume from. =item consumer_tag Specifies the identifier for the consumer. The consumer tag is local to a channel, so two clients can use the same consumer tags. If this field is empty the server will generate a unique tag. $consumer->on(success => sub { my $consumer = shift; my $frame = shift; my $consumer_tag = $frame->method_frame->consumer_tag; }); =item no_local (not implemented in RabbitMQ!) If the no-local field is set the server will not send messages to the connection that published them. See L =item no_ack If this field is set the server does not expect acknowledgements for messages. That is, when a message is delivered to the client the server assumes the delivery will succeed and immediately dequeues it. This functionality may increase performance but at the cost of reliability. Messages can get lost if a client dies before they are delivered to the application. =item exclusive Request exclusive consumer access, meaning only this consumer can access the queue. =back =head2 cancel $channel->cancel(consumer_tag => 'amq.ctag....')->deliver; End a queue consumer. This method cancels a consumer. This does not affect already delivered messages, but it does mean the server will not send any more messages for that consumer. The client may receive an arbitrary number of messages in between sending the cancel method and receiving the cancel-ok reply. Following arguments are accepted: =over 2 =item consumer_tag Holds the consumer tag specified by the client or provided by the server. =back =head2 get my $get = $channel->get(queue => 'mq') $get->deliver; Direct access to a queue. This method provides a direct access to the messages in a queue using a synchronous dialogue that is designed for specific types of application where synchronous functionality is more important than performance. This is simple event emitter to which you have to subscribe. It can emit: =over 2 =item message Provide client with a message. This method delivers a message to the client following a get method. A message delivered by 'get-ok' must be acknowledged unless the no-ack option was set in the get method. You can access all get-ok reply parameters as below: $get->on(message => sub { my $get = shift; my $get_ok = shift; my $message = shift; say "Still got: " . $get_ok->method_frame->message_count; }); =item empty Indicate no messages available. This method tells the client that the queue has no messages available for the client. =back Following arguments are accepted: =over 2 =item queue Specifies the name of the queue to get a message from. =item no_ack If this field is set the server does not expect acknowledgements for messages. That is, when a message is delivered to the client the server assumes the delivery will succeed and immediately dequeues it. This functionality may increase performance but at the cost of reliability. Messages can get lost if a client dies before they are delivered to the application. =back =head2 ack $channel->ack(delivery_tag => 1); Acknowledge one or more messages. When sent by the client, this method acknowledges one or more messages delivered via the Deliver or Get-Ok methods. When sent by server, this method acknowledges one or more messages published with the Publish method on a channel in confirm mode. The acknowledgement can be for a single message or a set of messages up to and including a specific message. Following arguments are accepted: =over 2 =item delivery_tag Server assigned delivery tag that was received with a message. =item multiple If set to 1, the delivery tag is treated as "up to and including", so that multiple messages can be acknowledged with a single method. If set to zero, the delivery tag refers to a single message. If the multiple field is 1, and the delivery tag is zero, this indicates acknowledgement of all outstanding messages. =back =head2 qos $channel->qos(prefetch_count => 1)->deliver; Sets specified Quality of Service to channel, or entire connection. Accepts following arguments: =over 2 =item prefetch_size Prefetch window size in octets. =item prefetch_count Prefetch window in complete messages. =item global If set all settings will be applied connection wide. =back =head2 recover $channel->recover(requeue => 0)->deliver; Redeliver unacknowledged messages. This method asks the server to redeliver all unacknowledged messages on a specified channel. Zero or more messages may be redelivered. =over 2 =item requeue If this field is zero, the message will be redelivered to the original recipient. If this bit is 1, the server will attempt to requeue the message, potentially then delivering it to an alternative subscriber. =back =head2 reject $channel->reject(delivery_tag => 1, requeue => 0)->deliver; Reject an incoming message. This method allows a client to reject a message. It can be used to interrupt and cancel large incoming messages, or return untreatable messages to their original queue. Following arguments are accepted: =over 2 =item delivery_tag Server assigned delivery tag that was received with a message. =item requeue If requeue is true, the server will attempt to requeue the message. If requeue is false or the requeue attempt fails the messages are discarded or dead-lettered. =back =head2 select_tx Work with transactions. The Tx class allows publish and ack operations to be batched into atomic units of work. The intention is that all publish and ack requests issued within a transaction will complete successfully or none of them will. Servers SHOULD implement atomic transactions at least where all publish or ack requests affect a single queue. Transactions that cover multiple queues may be non-atomic, given that queues can be created and destroyed asynchronously, and such events do not form part of any transaction. Further, the behaviour of transactions with respect to the immediate and mandatory flags on Basic.Publish methods is not defined. $channel->select_tx()->deliver; Select standard transaction mode. This method sets the channel to use standard transactions. The client must use this method at least once on a channel before using the Commit or Rollback methods. =head2 commit_tx $channel->commit_tx()->deliver; Commit the current transaction. This method commits all message publications and acknowledgments performed in the current transaction. A new transaction starts immediately after a commit. =head2 rollback_tx $channel->rollback_tx()->deliver; Abandon the current transaction. This method abandons all message publications and acknowledgments performed in the current transaction. A new transaction starts immediately after a rollback. Note that unacked messages will not be automatically redelivered by rollback; if that is required an explicit recover call should be issued. =head1 SEE ALSO L, L, L =head1 COPYRIGHT AND LICENSE Copyright (C) 2015-2017, Sebastian Podjasek and others Based on L - Copyright (C) 2010 Masahito Ikuta, maintained by C<< bobtfish@bobtfish.net >> This program is free software, you can redistribute it and/or modify it under the terms of the Artistic License version 2.0. =cut Consumer.pm100664001750001750 1024013527056003 23064 0ustar00sebaseba000000000000Mojo-RabbitMQ-Client-0.3.1/lib/Mojo/RabbitMQ/Clientpackage Mojo::RabbitMQ::Client::Consumer; use Mojo::Base 'Mojo::EventEmitter'; use Mojo::Promise; use Scalar::Util 'weaken'; require Mojo::RabbitMQ::Client; use constant DEBUG => $ENV{MOJO_RABBITMQ_DEBUG} // 0; has url => undef; has client => undef; has channel => undef; has queue => undef; has setup => 0; has defaults => sub { {} }; sub consume_p { my $self = shift; my $promise = Mojo::Promise->new()->resolve(); weaken $self; unless ($self->client) { $promise = $promise->then( sub { warn "-- spawn new client\n" if DEBUG; my $client_promise = Mojo::Promise->new(); my $client = Mojo::RabbitMQ::Client->new(url => $self->url); $self->client($client); # Catch all client related errors $self->client->catch(sub { $client_promise->reject($_[1]) }); # When connection is in Open state, open new channel $client->on( open => sub { warn "-- client open\n" if DEBUG; $client_promise->resolve; } ); $client->on('close' => sub { shift; $self->emit('close', @_) }); # Start connection $client->connect; return $client_promise; } ); } # Create a new channel with auto-assigned id unless ($self->channel) { $promise = $promise->then( sub { warn "-- create new channel\n" if DEBUG; my $channel_promise = Mojo::Promise->new; my $channel = Mojo::RabbitMQ::Client::Channel->new(); $channel->catch(sub { $channel_promise->reject($_[1]) }); $channel->on(close => sub { warn 'Channel closed: ' . $_[1]->method_frame->reply_text; }); $channel->on( open => sub { my ($channel) = @_; warn "-- channel opened\n" if DEBUG; $self->channel($channel); $channel->qos(%{$self->defaults->{qos}})->deliver; $channel_promise->resolve; } ); $self->client->open_channel($channel); return $channel_promise; } ); } # Start consuming messages $promise = $promise->then( sub { my $consumer_promise = Mojo::Promise->new; my $consumer = $self->channel->consume( queue => $self->client->url->query->param('queue'), %{$self->defaults->{consumer}} ); $consumer->on( message => sub { warn "-- message received\n" if DEBUG; my ($client, $message) = @_; $self->emit('message', $message); } ); $consumer->on('success' => sub { $consumer_promise->resolve(@_) }); $consumer->deliver; return $consumer_promise; } ); return $promise; } sub close { my $self = shift; if ($self->client) { $self->client->close(); } } 1; =encoding utf8 =head1 NAME Mojo::RabbitMQ::Client::Consumer - simple Mojo::RabbitMQ::Client based consumer =head1 SYNOPSIS use Mojo::RabbitMQ::Client::Consumer; my $consumer = Mojo::RabbitMQ::Consumer->new( url => 'amqp://guest:guest@127.0.0.1:5672/?exchange=mojo&queue=mojo', defaults => { qos => {prefetch_count => 1}, queue => {durable => 1}, consumer => {no_ack => 0}, } ); $consumer->catch(sub { die "Some error caught in Consumer" } ); $consumer->on('success' => sub { say "Consumer ready" }); $consumer->on( 'message' => sub { my ($consumer, $message) = @_; $consumer->channel->ack($message)->deliver; } ); $consumer->consume_p->wait; Mojo::IOLoop->start unless Mojo::IOLoop->is_running; =head1 DESCRIPTION =head1 EVENTS L inherits all events from L and can emit the following new ones. =head1 ATTRIBUTES L has following attributes. =head1 METHODS L inherits all methods from L and implements the following new ones. =head1 SEE ALSO L =head1 COPYRIGHT AND LICENSE Copyright (C) 2015-2017, Sebastian Podjasek and others This program is free software, you can redistribute it and/or modify it under the terms of the Artistic License version 2.0. =cut LocalQueue.pm100664001750001750 403513527056003 23315 0ustar00sebaseba000000000000Mojo-RabbitMQ-Client-0.3.1/lib/Mojo/RabbitMQ/Clientpackage Mojo::RabbitMQ::Client::LocalQueue; use Mojo::Base -base; has message_queue => sub { [] }; has drain_code_queue => sub { [] }; sub push { my $self = shift; CORE::push @{$self->message_queue}, @_; return $self->_drain_queue(); } sub get { my $self = shift; CORE::push @{$self->drain_code_queue}, @_; return $self->_drain_queue(); } sub _drain_queue { my $self = shift; my $message_count = scalar @{$self->message_queue}; my $drain_code_count = scalar @{$self->drain_code_queue}; my $count = $message_count < $drain_code_count ? $message_count : $drain_code_count; for (1 .. $count) { &{shift @{$self->drain_code_queue}}(shift @{$self->message_queue}); } return $self; } 1; =encoding utf8 =head1 NAME Mojo::RabbitMQ::Client::LocalQueue - Callback queue =head1 SYNOPSIS use Mojo::RabbitMQ::Client::LocalQueue my $queue = Mojo::RabbitMQ::Client::LocalQueue->new(); # Register callback when content appears $queue->get(sub { say "got expected content: " . $_[0] }); # Push some content to consume $queue->push("It Works!"); # This prints: # got expected content: It Works! =head1 DESCRIPTION L is a queue for callbacks expecting some content to be received. =head1 METHODS L implements following methods: =head2 get $queue->get(sub { process_message($_[0]) }) Registers a callback which is executed when new message is pushed to queue. =head2 push $queue->push("Some content"); $queue->push({objects => 'are also welcome}); Pushes content to queue and also drains all declared callbacks. =head1 SEE ALSO L, L =head1 COPYRIGHT AND LICENSE Copyright (C) 2015-2017, Sebastian Podjasek and others Based on L - Copyright (C) 2010 Masahito Ikuta, maintained by C<< bobtfish@bobtfish.net >> This program is free software, you can redistribute it and/or modify it under the terms of the Artistic License version 2.0. =cut Method.pm100664001750001750 623713527056003 22504 0ustar00sebaseba000000000000Mojo-RabbitMQ-Client-0.3.1/lib/Mojo/RabbitMQ/Clientpackage Mojo::RabbitMQ::Client::Method; use Mojo::Base 'Mojo::EventEmitter'; has is_sent => 0; has client => undef; has channel => undef; has name => undef; has arguments => sub { {} }; has expect => undef; sub setup { my $self = shift; $self->name(shift); $self->arguments(shift); $self->expect(shift); return $self; } sub deliver { my $self = shift; return 0 unless $self->channel->_assert_open(); $self->client->_write_expect( $self->name => $self->arguments, $self->expect => sub { $self->emit('success', @_); }, sub { $self->emit('error', @_); }, $self->channel->id, ); $self->is_sent(1); return 1; } 1; =encoding utf8 =head1 NAME Mojo::RabbitMQ::Client::Method - it's a generic class for all AMQP method calls =head1 SYNOPSIS use Mojo::RabbitMQ::Client::Method; my $method = Mojo::RabbitMQ::Client::Method->new( client => $client, channel => $channel )->setup( 'Basic::Consume' => { ... }, ['Basic::ConsumeOk', ...] ); # Watch for errors $method->on(error => sub { warn "Error in reception: " . $_[1] }); # Send this frame to AMQP $method->deliver; =head1 DESCRIPTION L is general class for every AMQP method call. =head1 EVENTS L inherits all events from L and can emit the following new ones. =head2 success $method->on(success => sub { my ($method, $frame) = @_; ... }); Emitted when one of expected replies is received. =head2 message Can be emitted by consumption & get methods. =head2 empty Can be emitted by get method, when no messages are available on queue. =head1 ATTRIBUTES L has following attributes. =head2 is_sent $method->is_sent ? "Method was sent" : "Method is still pending delivery"; =head2 client my $client = $method->client; $method->client($client); =head2 name my $name = $method->name; $method->name('Basic::Get'); =head2 arguments my $arguments = $method->arguments; $method->arguments({no_ack => 1, ticket => 0, queue => 'amq.queue'}); =head2 expect my $expectations = $method->expect; $method->expect([qw(Basic::GetOk Basic::GetEmpty)]); =head1 METHODS L inherits all methods from L and implements the following new ones. =head2 setup $method = $method->setup($name, $arguments, $expectations); Sets AMQP method name, its arguments and expected replies. =head2 deliver my $status = $method->deliver(); This delivers AMQP method call to server. Returns C<> when channel is not open, C<> otherwise. On successful delivery->reply cycle emits C<> event. C<> is emitted when none of expected replies are received. =head1 SEE ALSO L, L =head1 COPYRIGHT AND LICENSE Copyright (C) 2015-2017, Sebastian Podjasek and others Based on L - Copyright (C) 2010 Masahito Ikuta, maintained by C<< bobtfish@bobtfish.net >> This program is free software, you can redistribute it and/or modify it under the terms of the Artistic License version 2.0. =cut Publish.pm100664001750001750 755113527056003 24112 0ustar00sebaseba000000000000Mojo-RabbitMQ-Client-0.3.1/lib/Mojo/RabbitMQ/Client/Methodpackage Mojo::RabbitMQ::Client::Method::Publish; use Mojo::Base 'Mojo::RabbitMQ::Client::Method'; sub setup { my $self = shift; $self->arguments({@_}); return $self; } sub deliver { my $self = shift; return $self if !$self->channel->is_active; my %args = %{$self->arguments}; my $header_args = {header => delete $args{header} || {}, weight => delete $args{weight}}; my $body = delete $args{body} || ''; $self->_publish(%args)->_header($header_args, $body)->_body($body, sub { $self->is_sent(1); $self->emit('success'); }); return $self if !$args{mandatory} && !$args{immediate}; $self->channel->return_cbs->{($args{exchange} || '') . '_' . $args{routing_key}} = $self; return $self; } sub _publish { my $self = shift; my %args = @_; $self->client->_write_frame( Net::AMQP::Protocol::Basic::Publish->new( exchange => '', mandatory => 0, immediate => 0, %args, # routing_key ticket => 0, ), $self->channel->id ); return $self; } sub _header { my ($self, $args, $body) = @_; $self->client->_write_frame( Net::AMQP::Frame::Header->new( weight => $args->{weight} || 0, body_size => length($body), header_frame => Net::AMQP::Protocol::Basic::ContentHeader->new( content_type => 'application/octet-stream', content_encoding => undef, headers => {}, delivery_mode => 1, priority => 1, correlation_id => undef, expiration => undef, message_id => undef, timestamp => time, type => undef, user_id => $self->client->user, app_id => undef, cluster_id => undef, %{ $args->{header} }, ), ), $self->channel->id ); return $self; } sub _body { my ($self, $body, $cb) = @_; $self->client->_write_frame(Net::AMQP::Frame::Body->new(payload => $body), $self->channel->id, $cb); return $self; } 1; =encoding utf8 =head1 NAME Mojo::RabbitMQ::Client::Method::Publish - single class to do all of AMQP Publish method magic =head1 SYNOPSIS use Mojo::RabbitMQ::Client::Method::Publish; my $method = Mojo::RabbitMQ::Client::Method::Publish->new( client => $client, channel => $channel )->setup( exchange => 'mojo', routing_key => '', header => {} body => 'mojo', mandatory => 0, immediate => 0, )->deliver(); =head1 DESCRIPTION L is a special class to implement AMQP message publish workflow. =head1 EVENTS L inherits all events from L. =head1 ATTRIBUTES L inherits all attributes from L. =head1 METHODS L inherits all methods from L with following changes. =head2 setup $method = $method->setup($arguments); Only accepts common arguments for message publish chain. Which is: =over 2 =item Frame::Method =over 2 =item Basic::Publish =over 2 =item * exchange =item * routing_key =item * mandatory =item * immediate =back =back =item Frame::Header =over 2 =item Basic::ContentHeader =over 2 =item * header =item * weight =back =back =item Frame::Body =over 2 =item * body (as payload) =back =back =head1 SEE ALSO L, L, L =head1 COPYRIGHT AND LICENSE Copyright (C) 2015-2017, Sebastian Podjasek and others Based on L - Copyright (C) 2010 Masahito Ikuta, maintained by C<< bobtfish@bobtfish.net >> This program is free software, you can redistribute it and/or modify it under the terms of the Artistic License version 2.0. =cut Publisher.pm100664001750001750 1232613527056003 23235 0ustar00sebaseba000000000000Mojo-RabbitMQ-Client-0.3.1/lib/Mojo/RabbitMQ/Clientpackage Mojo::RabbitMQ::Client::Publisher; use Mojo::Base -base; use Mojo::Promise; use Mojo::JSON qw(encode_json); use Scalar::Util 'weaken'; require Mojo::RabbitMQ::Client; use constant DEBUG => $ENV{MOJO_RABBITMQ_DEBUG} // 0; has url => undef; has client => undef; has channel => undef; has setup => 0; has defaults => sub { {} }; sub publish_p { my $self = shift; my $body = shift; my $headers = {}; my %args = (); if (ref($_[0]) eq 'HASH') { $headers = shift; } if (@_) { %args = (@_); } my $promise = Mojo::Promise->new()->resolve; weaken $self; unless ($self->client) { $promise = $promise->then( sub { warn "-- spawn new client\n" if DEBUG; my $client_promise = Mojo::Promise->new(); my $client = Mojo::RabbitMQ::Client->new(url => $self->url); $self->client($client); # Catch all client related errors $self->client->catch(sub { $client_promise->reject($_[1]) }); # When connection is in Open state, open new channel $self->client->on( open => sub { warn "-- client open\n" if DEBUG; $client_promise->resolve; } ); # Start connection $client->connect; return $client_promise; } ); } # Create a new channel with auto-assigned id unless ($self->channel) { $promise = $promise->then( sub { warn "-- create new channel\n" if DEBUG; my $channel_promise = Mojo::Promise->new(); my $channel = Mojo::RabbitMQ::Client::Channel->new(); $channel->catch(sub { $channel_promise->reject($_[1]) }); $channel->on( open => sub { my ($channel) = @_; $self->channel($channel); warn "-- channel opened\n" if DEBUG; $channel_promise->resolve; } ); $channel->on(close => sub { warn 'Channel closed: ' . $_[1]->method_frame->reply_text; }); $self->client->open_channel($channel); return $channel_promise; } ); } $promise = $promise->then( sub { warn "-- publish message\n" if DEBUG; my $query = $self->client->url->query; my $exchange_name = $query->param('exchange'); my $routing_key = $query->param('routing_key'); my %headers = (content_type => 'text/plain', %$headers); if (ref($body)) { $headers{content_type} = 'application/json'; $body = encode_json $body; } return $self->channel->publish_p( exchange => $exchange_name, routing_key => $routing_key, mandatory => 0, immediate => 0, header => \%headers, %args, body => $body ); } ); return $promise; } 1; =encoding utf8 =head1 NAME Mojo::RabbitMQ::Client::Publisher - simple Mojo::RabbitMQ::Client based publisher =head1 SYNOPSIS use Mojo::RabbitMQ::Client::Publisher; my $publisher = Mojo::RabbitMQ::Client::Publisher->new( url => 'amqp://guest:guest@127.0.0.1:5672/?exchange=mojo&routing_key=mojo' ); $publisher->publish_p( {encode => { to => 'json'}}, routing_key => 'mojo_mq' )->then(sub { say "Message published"; })->catch(sub { die "Publishing failed" })->wait; =head1 DESCRIPTION =head1 ATTRIBUTES L has following attributes. =head2 url Sets all connection parameters in one string, according to specification from L. For detailed description please see L. =head1 METHODS L implements only single method. =head2 publish_p $publisher->publish_p('simple plain text body'); $publisher->publish_p({ some => 'json' }); $publisher->publish_p($body, { header => 'content' }, routing_key => 'mojo', mandatory => 1); Method signature publish_p($body!, \%headers?, *@params) =over 2 =item body First argument is mandatory body content of published message. Any reference passed here will be encoded as JSON and accordingly C header will be set to C. =item headers If second argument is a HASHREF it will be merged to message headers. =item params Any other arguments will be considered key/value pairs and passed to the Client's publish method as arguments overriding everything besides body argument. So this: $publisher->publish({ json => 'object' }, { header => 'content' }); is similar to this: $publisher->publish({ json => 'object' }, header => { header => 'content' }); But beware - headers passed as a HASHREF get merged into the header constructed by the Publisher, but params override values; so if you pass C
as a param like this, it will override the header constructed by the Publisher, and the message will lack the C header, even though you passed a reference as the body argument! With the first example, the C header would be included. =back =head1 SEE ALSO L =head1 COPYRIGHT AND LICENSE Copyright (C) 2015-2017, Sebastian Podjasek and others This program is free software, you can redistribute it and/or modify it under the terms of the Artistic License version 2.0. =cut minil.toml100664001750001750 23513527056003 16352 0ustar00sebaseba000000000000Mojo-RabbitMQ-Client-0.3.1name = "Mojo-RabbitMQ-Client" license = 'artistic_2' badges = ["travis","metacpan"] markdown_maker = "Pod::Markdown::Github" module_maker="ModuleBuildTiny" amqp0-9-1.stripped.extended.xml100664001750001750 5457013527056003 23216 0ustar00sebaseba000000000000Mojo-RabbitMQ-Client-0.3.1/share base.t100664001750001750 506513527056003 15735 0ustar00sebaseba000000000000Mojo-RabbitMQ-Client-0.3.1/tuse strict; use Test::More tests => 7; use_ok 'Mojo::RabbitMQ::Client'; subtest 'attributes' => sub { plan tests => 7; my $c = new_ok( 'Mojo::RabbitMQ::Client', [ tls => 0, user => 'guest', host => 'remote', port => 16526, vhost => '/some/' ] ); is($c->user, 'guest', 'user is guest'); is($c->pass, undef, 'no password'); is($c->host, 'remote', 'host is remote'); is($c->port, 16526, 'port is ok'); is($c->vhost, '/some/', 'proper vhost name'); isa_ok($c->params, 'Mojo::Parameters'); }; subtest 'query param aliases' => sub { plan tests => 6; my $a = new_ok( 'Mojo::RabbitMQ::Client', [ url => 'amqp:///?cacertfile=cacert&certfile=cert&keyfile=key' . '&fail_if_no_peer_cert=1&connection_timeout=100' ] ); is($a->param('ca'), 'cacert', 'cacertfile aliased to ca'); is($a->param('cert'), 'cert', 'cerfile aliased to cert'); is($a->param('key'), 'key', 'keyfile aliased to key'); is($a->param('verify'), '1', 'fail_if_no_peer_cert aliased to verify'); is($a->param('timeout'), '100', 'connection_timeout aliased to timeout'); }; subtest 'query param aliases less significant' => sub { plan tests => 2; my $a = new_ok('Mojo::RabbitMQ::Client', [url => 'amqp:///?cacertfile=cacert&ca=ca']); is($a->param('ca'), 'cacert', 'should take base value, not alias'); }; subtest 'attributes from query params' => sub { plan tests => 5; my $a = new_ok('Mojo::RabbitMQ::Client', [url => 'amqp://?heartbeat=180&timeout=90&channel_max=1']); is($a->host, 'localhost', 'need this to parse url!'); is($a->heartbeat_timeout, 180, 'heartbeat timeout set'); is($a->connect_timeout, 90, 'connect timeout set'); is($a->max_channels, 1, 'max channels set'); }; subtest 'change default port for amqps scheme' => sub { plan tests => 6; my $c = new_ok('Mojo::RabbitMQ::Client', [url => 'amqps://']); is($c->user, undef, 'no user'); is($c->pass, undef, 'no password'); is($c->host, 'localhost', 'default host'); is($c->port, 5671, 'changed port'); is($c->vhost, '/', 'default vhost'); }; subtest 'keep specified port for amqps scheme' => sub { plan tests => 6; my $c = new_ok('Mojo::RabbitMQ::Client', [url => 'amqps://:15673']); is($c->user, undef, 'no user'); is($c->pass, undef, 'no password'); is($c->host, 'localhost', 'default host'); is($c->port, 15673, 'changed port'); is($c->vhost, '/', 'default vhost'); }; localqueue.t100664001750001750 107713527056003 17161 0ustar00sebaseba000000000000Mojo-RabbitMQ-Client-0.3.1/tuse Test::More tests => 10; use Mojo::RabbitMQ::Client::LocalQueue; my $q = Mojo::RabbitMQ::Client::LocalQueue->new; $q->push(1); $q->get(sub {is $_[0], 1, 'push -> get';}); $q->get(sub {is $_[0], 2, 'get -> push';}); $q->push(2); $q->push(3, 4); $q->push(5, 6); $q->get( sub {is $_[0], 3, '';}, sub {is $_[0], 4, '';}, ); $q->get( sub {is $_[0], 5, '';}, sub {is $_[0], 6, '';}, ); $q->get( sub {is $_[0], 7, '';}, sub {is $_[0], 8, '';}, ); $q->get( sub {is $_[0], 9, '';}, sub {is $_[0], 10, '';}, ); $q->push(7, 8); $q->push(9, 10); publisher.t100664001750001750 611713527056003 17017 0ustar00sebaseba000000000000Mojo-RabbitMQ-Client-0.3.1/tuse Test::More tests => 9; BEGIN { use_ok 'Mojo::RabbitMQ::Client'; use_ok 'Mojo::RabbitMQ::Client::Publisher'; } SKIP: { skip "Not requested by user, set TEST_RMQ=1 environment variable to test", 7 unless $ENV{TEST_RMQ}; my $run_id = time(); my $exchange_name = 'mrc_test_' . $run_id; my $queue_name = 'mrc_test_queue' . $run_id; my $url = $ENV{MOJO_RABBITMQ_URL} || 'amqp://guest:guest@127.0.0.1:5672/?exchange=' . $exchange_name . '&routing_key=' . $queue_name; # setup my $client = Mojo::RabbitMQ::Client->new(url => $url); $client->connect_p->then( sub { shift->acquire_channel_p(); } )->then( sub { shift->declare_exchange_p( exchange => $exchange_name, type => 'topic', auto_delete => 1 ); } )->then( sub { shift->declare_queue_p(queue => $queue_name, auto_delete => 1); } )->then( sub { shift->bind_queue_p( exchange => $exchange_name, queue => $queue_name, routing_key => $queue_name, ); } )->wait; # tests my @tests = ( ['plain text', 'plain text', 'text/plain'], ['hash as json', {json => 'object'}, 'application/json'], ['array as json', ['array'], 'application/json'], ); my $publisher = Mojo::RabbitMQ::Client::Publisher->new(url => $url); foreach my $t (@tests) { $publisher->publish_p($t->[1])->then(sub { pass('published: ' . $t->[0]) })->wait; } $publisher->publish_p( {json => 'object'}, {content_type => 'text/plain'}, routing_key => '#' )->then(sub { pass('json published into the void') })->wait; # verify my $channel; Mojo::RabbitMQ::Client->new(url => $url)->connect_p->then( sub { shift->acquire_channel_p(); } )->then( sub { $channel = shift; } )->wait; foreach my $t (@tests) { $channel->get_p(queue => $queue_name, no_ack => 1)->then( sub { my $channel = shift; my $frame = shift; my $message = shift; if ($message and $message->{header}->{content_type} eq $t->[2]) { pass("received valid content_type: " . $t->[2]); } else { diag explain $frame; diag explain $message; pass("received something not valid, expecting " . $t->[2] . " got " . ($message->{header}->{content_type} // '(undef)')); # SHOULD fail } } )->wait; } # There should be nothing else waiting $channel->get_p(queue => $queue_name, no_ack => 1)->then( sub { my $channel = shift; diag explain \@_; pass("received something extra") if defined $_[1]; # SHOULD fail } )->wait; } __END__ my $channel = Mojo::RabbitMQ::Client->new(url => $url)->connect_p->then(sub { shift->acquire_channel_p() }->wait; foreach my $t (@tests) { my ($channel, $frame, $message) = $channel->get_p(queue => $queue_name, no_ack => 1)->wait; if ($message and $message->{header}->{content_type} eq $t->[2]) { pass("received valid content_type"); } else { fail("received something not valid"); } } static.t100664001750001750 115413527056003 16305 0ustar00sebaseba000000000000Mojo-RabbitMQ-Client-0.3.1/tuse strict; use Test::More tests => 5; use Test::Exception; use_ok 'Mojo::RabbitMQ::Client'; my $client = Mojo::RabbitMQ::Client->new(); throws_ok { $client->consumer() } qr/is a static method/, 'calling consumer on instance goes fatal'; throws_ok { $client->publisher() } qr/is a static method/, 'calling publisher on instance goes fatal'; lives_and { isa_ok Mojo::RabbitMQ::Client->consumer(), 'Mojo::RabbitMQ::Client::Consumer' }, 'called consumer on package, should live'; lives_and { isa_ok Mojo::RabbitMQ::Client->publisher(), 'Mojo::RabbitMQ::Client::Publisher' }, 'called publisher on package, should live'; uri.t100664001750001750 331013527056003 15611 0ustar00sebaseba000000000000Mojo-RabbitMQ-Client-0.3.1/tuse strict; use Test::More tests => 79; my @order = qw(tls user pass host port vhost param); my @tests = (); # Basic tests taken from https://www.rabbitmq.com/uri-spec.html push @tests, [ 'amqp://user:pass@host:10000/vhost', 0, "user", "pass", "host", "10000", "vhost" ], [ 'amqp://user%61:%61pass@ho%61st:10000/v%2fhost', 0, "usera", "apass", "hoast", "10000", "v/host" ], ['amqp://', 0, undef, undef, "localhost", "5672", "/"], ['amqp://:@/', 0, "", "", "localhost", "5672", "/"], ['amqp://user@', 0, "user", undef, "localhost", "5672", "/"], ['amqp://user:pass@', 0, "user", "pass", "localhost", "5672", "/"], ['amqp://host', 0, undef, undef, "host", "5672", "/"], ['amqp://:10000', 0, undef, undef, "localhost", "10000", "/"], ['amqp:///vhost', 0, undef, undef, "localhost", "5672", "vhost"], ['amqp://host/', 0, undef, undef, "host", "5672", "/"], ['amqp://host/%2f', 0, undef, undef, "host", "5672", "/"], ['amqp://host///', 0, undef, undef, "host", "5672", "//"], ['amqp://[::1]', 0, undef, undef, "[::1]", "5672", "/"]; use_ok 'Mojo::RabbitMQ::Client'; foreach my $t (@tests) { my $idx = 0; my $url = shift @$t; my $client = Mojo::RabbitMQ::Client->new(url => $url); for my $v (@$t) { my $attr = $order[$idx]; if (ref($v) eq 'HASH') { foreach my $k (keys %$v) { my $x = $v->{$k}; is($client->$attr($k), $x, "expect $attr($k) to be " . ($x // '(undefined)') . " from $url"); } } else { is($client->$attr(), $v, "expect $attr to be " . ($v // '(undefined)') . " from $url"); } $idx++; } } use.t100664001750001750 45713527056003 15577 0ustar00sebaseba000000000000Mojo-RabbitMQ-Client-0.3.1/tuse strict; use Test::More tests => 7; use_ok $_ for qw( Mojo::RabbitMQ::Client Mojo::RabbitMQ::Client::Channel Mojo::RabbitMQ::Client::Consumer Mojo::RabbitMQ::Client::LocalQueue Mojo::RabbitMQ::Client::Method Mojo::RabbitMQ::Client::Method::Publish Mojo::RabbitMQ::Client::Publisher ); client.t100664001750001750 15513527056003 16444 0ustar00sebaseba000000000000Mojo-RabbitMQ-Client-0.3.1/xtuse Test::More skip_all => "TODO"; subtest 'max_channels' => sub { }; subtest 'utf-8 on TLS' => sub { }; consumer.t100664001750001750 672513527056003 17052 0ustar00sebaseba000000000000Mojo-RabbitMQ-Client-0.3.1/xtuse Test::More skip_all => "TODO"; BEGIN { use_ok 'Mojo::RabbitMQ::Client' } sub failure { my ($test, $details) = @_; fail($test); diag("Details: " . $details) if $details; Mojo::IOLoop->stop; } sub handle_error { my $desc = $_[0] // 'Error'; return sub { failure($desc, $_[1]->method_frame->reply_text); } } my $run_id = time(); my $exchange_name = 'mrc_test_' . $run_id; my $queue_name = 'mrc_test_queue' . $run_id; my $url = $ENV{MOJO_RABBITMQ_URL} || 'rabbitmq://guest:guest@127.0.0.1:5672/?exchange=' . $exchange_name . '&queue=' . $queue_name; Mojo::IOLoop->timer( # Global test timeout 10 => sub { failure('Test timeout'); } ); my $client = Mojo::RabbitMQ::Client->new(url => $url); $client->catch(handle_error('Connection or other server errors')); $client->on( open => sub { pass('Client connected'); my $channel = Mojo::RabbitMQ::Client::Channel->new(); $channel->catch(handle_error("Channel error")); $channel->on(close => handle_error("Channel error")); $channel->on( open => sub { pass('Channel opened'); my $exchange = $channel->declare_exchange( exchange => $exchange_name, type => 'topic', auto_delete => 1, ); $exchange->catch(handle_error('Failed to declare exchange')); $exchange->on( success => sub { pass('Exchange declared'); my $queue = $channel->declare_queue(queue => $queue_name, auto_delete => 1,); $queue->catch(handle_error('Failed to declare queue')); $queue->on( success => sub { pass('Queue declared'); my $bind = $channel->bind_queue( exchange => $exchange_name, queue => $queue_name, routing_key => $queue_name, ); $bind->catch(handle_error('Failed to bind queue')); $bind->on( success => sub { pass('Queue bound'); my $publish = $channel->publish( exchange => $exchange_name, routing_key => $queue_name, body => 'Test message' ); $publish->on(success => sub { pass('Message published'); start_consumer(); $client->close(); }); $publish->deliver(); } ); $bind->deliver(); } ); $queue->deliver(); } ); $exchange->deliver(); } ); $client->open_channel($channel); } ); $client->connect(); sub start_consumer { my $consumer = Mojo::RabbitMQ::Client->consumer( url => $url, defaults => { qos => {prefetch_count => 1}, queue => {auto_delete => 1}, consumer => {no_ack => 0}, } ); $consumer->catch(sub { failure('Consumer: Connection or other server errors') }); $consumer->on(connect => sub { pass('Consumer: Connected to server') }); $consumer->on( 'message' => sub { my ($consumer, $message) = @_; pass('Consumer: Got message'); $consumer->close(); } ); $consumer->on(close => sub { pass('Consumer: Disconnected'); Mojo::IOLoop->stop }); $consumer->start(); } Mojo::IOLoop->start unless Mojo::IOLoop->is_running; pod.t100664001750001750 40013527056003 15741 0ustar00sebaseba000000000000Mojo-RabbitMQ-Client-0.3.1/xtuse Mojo::Base -strict; use Test::More; plan skip_all => 'set TEST_POD to enable this test (developer only!)' unless $ENV{TEST_POD}; plan skip_all => 'Test::Pod 1.14+ required for this test!' unless eval 'use Test::Pod 1.14; 1'; all_pod_files_ok(); server.t100664001750001750 735013527056003 16520 0ustar00sebaseba000000000000Mojo-RabbitMQ-Client-0.3.1/xtuse Test::More tests => 12; BEGIN { use_ok 'Mojo::RabbitMQ::Client' } sub failure { my ($test, $details) = @_; fail($test); diag("Details: " . $details) if $details; Mojo::IOLoop->stop; } my $run_id = time(); my $exchange_name = 'mrc_test_' . $run_id; my $queue_name = 'mrc_test_queue' . $run_id; my $amqp = Mojo::RabbitMQ::Client->new( url => ($ENV{MOJO_RABBITMQ_URL} || 'rabbitmq://guest:guest@127.0.0.1:5672/') ); $amqp->ioloop->timer( # Global test timeout 10 => sub { failure('Test timeout'); } ); $amqp->catch(sub { failure('Connection or other server errors') }); $amqp->on(connect => sub { pass('Connected to server') }); $amqp->on( open => sub { my ($self) = @_; pass('Protocol opened'); my $channel = Mojo::RabbitMQ::Client::Channel->new(); $channel->on( open => sub { my ($channel) = @_; pass('Channel opened'); my $exchange = $channel->declare_exchange( exchange => $exchange_name, type => 'topic', auto_delete => 1, ); $exchange->catch(sub { failure('Failed to declare exchange') }); $exchange->on( success => sub { pass('Exchange declared'); my $queue = $channel->declare_queue(queue => $queue_name, auto_delete => 1,); $queue->catch(sub { failure('Failed to declare queue') }); $queue->on( success => sub { pass('Queue declared'); my $bind = $channel->bind_queue( exchange => $exchange_name, queue => $queue_name, routing_key => $queue_name, ); $bind->catch(sub { failure('Failed to bind queue') }); $bind->on( success => sub { pass('Queue bound'); my $publish = $channel->publish( exchange => $exchange_name, routing_key => $queue_name, body => 'Test message', mandatory => 0, immediate => 0, header => {} ); $publish->catch(sub { failure('Message not published') }); $publish->on( success => sub { pass('Message published'); } ); $publish->on(return => sub { failure('Message returned') } ); $publish->deliver(); my $consumer = $channel->consume(queue => $queue_name,); $consumer->on( success => sub { pass('Subscribed to queue'); } ); $consumer->on( message => sub { pass('Got message'); $amqp->close; } ); $consumer->catch(sub { failure('Subscription failed') }); $consumer->deliver; } ); $bind->deliver(); } ); $queue->deliver(); } ); $exchange->deliver(); } ); $channel->on(close => sub { failure('Channel closed', $_[1]->method_frame->reply_text) }); $channel->catch(sub { failure('Channel error') }); $self->open_channel($channel); } ); $amqp->on(close => sub { pass('Connection closed') }); $amqp->on(disconnect => sub { pass('Disconnected'); Mojo::IOLoop->stop }); $amqp->connect(); Mojo::IOLoop->start unless Mojo::IOLoop->is_running; META.yml100664001750001750 416213527056003 15641 0ustar00sebaseba000000000000Mojo-RabbitMQ-Client-0.3.1--- abstract: 'Mojo::IOLoop based RabbitMQ client' author: - '-2019, Sebastian Podjasek and others' build_requires: Test::Exception: '0.43' Test::More: '0.98' configure_requires: Module::Build::Tiny: '0.035' dynamic_config: 0 generated_by: 'Minilla/v3.0.14, CPAN::Meta::Converter version 2.150010' license: artistic_2 meta-spec: url: http://module-build.sourceforge.net/META-spec-v1.4.html version: '1.4' name: Mojo-RabbitMQ-Client no_index: directory: - t - xt - inc - share - eg - examples - author - builder provides: Mojo::RabbitMQ::Client: file: lib/Mojo/RabbitMQ/Client.pm version: v0.3.1 Mojo::RabbitMQ::Client::Channel: file: lib/Mojo/RabbitMQ/Client/Channel.pm Mojo::RabbitMQ::Client::Consumer: file: lib/Mojo/RabbitMQ/Client/Consumer.pm Mojo::RabbitMQ::Client::LocalQueue: file: lib/Mojo/RabbitMQ/Client/LocalQueue.pm Mojo::RabbitMQ::Client::Method: file: lib/Mojo/RabbitMQ/Client/Method.pm Mojo::RabbitMQ::Client::Method::Publish: file: lib/Mojo/RabbitMQ/Client/Method/Publish.pm Mojo::RabbitMQ::Client::Publisher: file: lib/Mojo/RabbitMQ/Client/Publisher.pm requires: File::ShareDir: '0' List::Util: '1.33' Mojolicious: '7.53' Net::AMQP: '0.06' perl: '5.010' resources: bugtracker: https://github.com/inway/mojo-rabbitmq-client/issues homepage: https://github.com/inway/mojo-rabbitmq-client repository: git://github.com/inway/mojo-rabbitmq-client.git version: 0.3.1 x_contributors: - 'Adam Williamson ' - 'Adam Williamson ' - 'Christopher Rasch-Olsen Raa ' - 'Mohammad S Anwar ' - 'Oliver Kurz ' - 'Patrick Goldmann ' - 'Richard Lippmann ' - 'Salve J. Nilsen ' - 'Sebastian Podjasek ' - 'Sebastian Riedel ' - 'Stephan Kulow ' - 'Vidar Tyldum ' - 'gregor herrmann ' x_serialization_backend: 'CPAN::Meta::YAML version 0.018' MANIFEST100664001750001750 107713527056003 15523 0ustar00sebaseba000000000000Mojo-RabbitMQ-Client-0.3.1Build.PL Changes LICENSE META.json README.md cpanfile examples/chat-monitor.pl examples/chat.pl examples/simple.pl inc/Module/AutoInstall.pm lib/Mojo/RabbitMQ/Client.pm lib/Mojo/RabbitMQ/Client/Channel.pm lib/Mojo/RabbitMQ/Client/Consumer.pm lib/Mojo/RabbitMQ/Client/LocalQueue.pm lib/Mojo/RabbitMQ/Client/Method.pm lib/Mojo/RabbitMQ/Client/Method/Publish.pm lib/Mojo/RabbitMQ/Client/Publisher.pm minil.toml share/amqp0-9-1.stripped.extended.xml t/base.t t/localqueue.t t/publisher.t t/static.t t/uri.t t/use.t xt/client.t xt/consumer.t xt/pod.t xt/server.t META.yml MANIFEST