Net-Stomp-0.46000755001750001750 012265231376 12707 5ustar00jasonjason000000000000Net-Stomp-0.46/MANIFEST.SKIP000444001750001750 20112265231376 14713 0ustar00jasonjason000000000000^MYMETA.yml$ ^MANIFEST.bak$ ^Build$ ^Makefile ^\.DS_Store ^Net-Stomp-.* \.tar\.gz$ ^\.git \.swp$ ^_build/ ^blib/ ^MYMETA\.json$ Net-Stomp-0.46/Makefile.PL000444001750001750 65612265231376 15005 0ustar00jasonjason000000000000# Note: this file was auto-generated by Module::Build::Compat version 0.4007 use ExtUtils::MakeMaker; WriteMakefile ( 'NAME' => 'Net::Stomp', 'VERSION_FROM' => 'lib/Net/Stomp.pm', 'PREREQ_PM' => { 'Class::Accessor::Fast' => '0', 'IO::Select' => '0', 'IO::Socket::INET' => '0' }, 'INSTALLDIRS' => 'site', 'EXE_FILES' => [], 'PL_FILES' => {} ) ; Net-Stomp-0.46/Build.PL000444001750001750 77412265231376 14330 0ustar00jasonjason000000000000#!perl use Module::Build; use strict; use warnings; my $build = Module::Build->new( create_makefile_pl => 'traditional', license => 'perl', module_name => 'Net::Stomp', requires => { 'IO::Socket::INET' => '0', 'IO::Select' => '0', 'Class::Accessor::Fast' => '0', }, recommends => { 'IO::Socket::IP' => '0.20', 'IO::Socket::SSL' => '1.75', }, ); $build->create_build_script; Net-Stomp-0.46/README000444001750001750 1742112265231376 13751 0ustar00jasonjason000000000000NAME Net::Stomp - A Streaming Text Orientated Messaging Protocol Client SYNOPSIS # send a message to the queue 'foo' use Net::Stomp; my $stomp = Net::Stomp->new( { hostname => 'localhost', port => '61613' } ); $stomp->connect( { login => 'hello', passcode => 'there' } ); $stomp->send( { destination => '/queue/foo', body => 'test message' } ); $stomp->disconnect; # subscribe to messages from the queue 'foo' use Net::Stomp; my $stomp = Net::Stomp->new( { hostname => 'localhost', port => '61613' } ); $stomp->connect( { login => 'hello', passcode => 'there' } ); $stomp->subscribe( { destination => '/queue/foo', 'ack' => 'client', 'activemq.prefetchSize' => 1 } ); while (1) { my $frame = $stomp->receive_frame; warn $frame->body; # do something here $stomp->ack( { frame => $frame } ); } $stomp->disconnect; # write your own frame my $frame = Net::Stomp::Frame->new( { command => $command, headers => $conf, body => $body } ); $self->send_frame($frame); DESCRIPTION This module allows you to write a Stomp client. Stomp is the Streaming Text Orientated Messaging Protocol (or the Protocol Briefly Known as TTMP and Represented by the symbol :ttmp). It's a simple and easy to implement protocol for working with Message Orientated Middleware from any language. Net::Stomp is useful for talking to Apache ActiveMQ, an open source (Apache 2.0 licensed) Java Message Service 1.1 (JMS) message broker packed with many enterprise features. A Stomp frame consists of a command, a series of headers and a body - see Net::Stomp::Frame for more details. For details on the protocol see . To enable the ActiveMQ Broker for Stomp add the following to the activemq.xml configuration inside the section: To enable the ActiveMQ Broker for Stomp and SSL add the following inside the section: For details on Stomp in ActiveMQ See . METHODS new The constructor creates a new object. You must pass in a hostname and a port: my $stomp = Net::Stomp->new( { hostname => 'localhost', port => '61613' } ); If you want to use SSL, make sure you have IO::Socket::SSL and pass in the SSL flag: my $stomp = Net::Stomp->new( { hostname => 'localhost', port => '61612', ssl => 1, } ); If you want to pass in IO::Socket::SSL options: my $stomp = Net::Stomp->new( { hostname => 'localhost', port => '61612', ssl => 1, ssl_options => { SSL_cipher_list => 'ALL:!EXPORT' }, } ); connect This connects to the Stomp server. You must pass in a login and passcode. You may pass in 'client-id', which specifies the JMS Client ID which is used in combination to the activemqq.subscriptionName to denote a durable subscriber. $stomp->connect( { login => 'hello', passcode => 'there' } ); send This sends a message to a queue or topic. You must pass in a destination and a body. $stomp->send( { destination => '/queue/foo', body => 'test message' } ); To send a BytesMessage, you should set the field 'bytes_message' to 1. send_transactional This sends a message in transactional mode and fails if the receipt of the message is not acknowledged by the server: $stomp->send_transactional( { destination => '/queue/foo', body => 'test message' } ) or die "Couldn't send the message!"; If using ActiveMQ, you might also want to make the message persistent: $stomp->send_transactional( { destination => '/queue/foo', body => 'test message', persistent => 'true' } ) or die "Couldn't send the message!"; disconnect This disconnects from the Stomp server: $stomp->disconnect; subscribe This subscribes you to a queue or topic. You must pass in a destination. The acknowledge mode defaults to 'auto', which means that frames will be considered delivered after they have been sent to a client. The other option is 'client', which means that messages will only be considered delivered after the client specifically acknowledges them with an ACK frame. Other options: 'selector': which specifies a JMS Selector using SQL 92 syntax as specified in the JMS 1.1 specificiation. This allows a filter to be applied to each message as part of the subscription. 'activemq.dispatchAsync': should messages be dispatched synchronously or asynchronously from the producer thread for non-durable topics in the broker. For fast consumers set this to false. For slow consumers set it to true so that dispatching will not block fast consumers. 'activemq.exclusive': Would I like to be an Exclusive Consumer on a queue. 'activemq.maximumPendingMessageLimit': For Slow Consumer Handlingon non-durable topics by dropping old messages - we can set a maximum pending limit which once a slow consumer backs up to this high water mark we begin to discard old messages. 'activemq.noLocal': Specifies whether or not locally sent messages should be ignored for subscriptions. Set to true to filter out locally sent messages. 'activemq.prefetchSize': Specifies the maximum number of pending messages that will be dispatched to the client. Once this maximum is reached no more messages are dispatched until the client acknowledges a message. Set to 1 for very fair distribution of messages across consumers where processing messages can be slow. 'activemq.priority': Sets the priority of the consumer so that dispatching can be weighted in priority order. 'activemq.retroactive': For non-durable topics do you wish this subscription to the retroactive. 'activemq.subscriptionName': For durable topic subscriptions you must specify the same clientId on the connection and subscriberName on the subscribe. $stomp->subscribe( { destination => '/queue/foo', 'ack' => 'client', 'activemq.prefetchSize' => 1 } ); unsubscribe This unsubscribes you to a queue or topic. You must pass in a destination: $stomp->unsubcribe({ destination => '/queue/foo' }); receive_frame This blocks and returns you the next Stomp frame. my $frame = $stomp->receive_frame; warn $frame->body; # do something here The header bytes_message is 1 if the message was a BytesMessage. can_read This returns whether a frame is waiting to be read. Optionally takes a timeout in seconds: my $can_read = $stomp->can_read; my $can_read = $stomp->can_read({ timeout => '0.1' }); ack This acknowledges that you have received and processed a frame (if you are using client acknowledgements): $stomp->ack( { frame => $frame } ); send_frame If this module does not provide enough help for sending frames, you may construct your own frame and send it: # write your own frame my $frame = Net::Stomp::Frame->new( { command => $command, headers => $conf, body => $body } ); $self->send_frame($frame); SEE ALSO Net::Stomp::Frame. AUTHOR Leon Brocard . COPYRIGHT Copyright (C) 2006-9, Leon Brocard This module is free software; you can redistribute it or modify it under the same terms as Perl itself. Net-Stomp-0.46/MANIFEST000444001750001750 34212265231376 14154 0ustar00jasonjason000000000000Build.PL CHANGES examples/send.pl examples/subscribe.pl lib/Net/Stomp.pm lib/Net/Stomp/Frame.pm MANIFEST This list of files MANIFEST.SKIP META.yml README t/pod.t t/pod_coverage.t xt/consume_buffering.t Makefile.PL META.json Net-Stomp-0.46/META.yml000444001750001750 152712265231376 14322 0ustar00jasonjason000000000000--- abstract: 'A Streaming Text Orientated Messaging Protocol Client' author: - 'Leon Brocard ,' - 'Thom May ,' - 'Michael S. Fischer ,' - 'Ash Berlin ' build_requires: {} configure_requires: Module::Build: 0.40 dynamic_config: 1 generated_by: 'Module::Build version 0.4007, CPAN::Meta::Converter version 2.132140' license: perl meta-spec: url: http://module-build.sourceforge.net/META-spec-v1.4.html version: 1.4 name: Net-Stomp provides: Net::Stomp: file: lib/Net/Stomp.pm version: 0.46 Net::Stomp::Frame: file: lib/Net/Stomp/Frame.pm recommends: IO::Socket::IP: 0.20 IO::Socket::SSL: 1.75 requires: Class::Accessor::Fast: 0 IO::Select: 0 IO::Socket::INET: 0 resources: license: http://dev.perl.org/licenses/ version: 0.46 Net-Stomp-0.46/CHANGES000444001750001750 1012012265231376 14051 0ustar00jasonjason000000000000Revision history for Perl module Net::Stomp: 0.46 Tue Jan 14 12:21:43 GMT 2014 - Recommend modules required for IPv6 support (Dagfinn Ilmari Mannsåker) 0.45 Wed Mar 14 10:25:35 GMT 2012 - reconnect on fork() (Gianni Ceccarelli) 0.44 Wed Nov 23 23:26:39 GMT 2011 - Updated CHANGES to include recent changes (Jason Tang) 0.43 Mon Nov 21 10:46:58 GMT 2011 - rt#68583: "Use of uninitialized value" warning in as_string()(Chisel Wright) - rt#70670: Key using id rather than destination (Gianni Ceccarelli) 0.42 Sat Aug 20 07:37:31 GMT 2011 - Improve handling of disconnecting/reconnecting (Chisel Wright) 0.41 Thu Apr 28 14:56:49 GMT 2011 - Various small warning/error message fies: - Remove undef warning from substr (Squeeks) - rt#67160: IO::Socket::INET/SSL Error Variables (Stephen Fralich) - rt#65979: Fix bug in failover hosts (vigith maurice) 0.41 Fri Feb 4 09:16:39 GMT 2011 - Fix silly bug in _read_body (reported by Zulf Ahmed) - Remove uninitialized value in numeric gt warning (reported by Dave Krieger) 0.39 Fri Jan 14 15:59:27 GMT 2011 - Cope with EOF during receive_frame better 0.38_99 Fri Aug 27 00:11:08 BST 2010 - Reimplemented Net::Stomp::receive_frame() to properly handle STOMP frames that have extraneous line feed characters after the NULL terminator, before the next frame header (e.g., ActiveMQ). (Implemented by Michael S. Fischer) - Improve reading performace by reading large chunks and buffering - Read buffer size can now be specified in Net::Stomp->new() with the 'bufsize' key. - Possible incompatible change - Net::Stomp::Frame#parse method removed. Hopefully no one was using this. If you were, RTFS and look at Net::Stomp#receive_frame method. 0.38 Tue Aug 03 13:58:10 BST 2010 - Fix an issue with IO::Handle buffering interfering with IO::Select. This manifested as receive_frame hanging, or as if not all messages would get delivered to the client. (RT 44629) 0.37 Fri May 28 15:26:17 BST 2010 - Report a proper error if non-SSL STOMP server is not listening rather than "Can't use an undefined value as a symbol reference". - Fix regression in can_read: it now again defaults to waiting indefinitely. (RT 58502) 0.36 Fri May 28 16:20:15 BST 2010 - Fix behaviour regression on constructor - 0.35 would look at ->new time if no server could be reached. We now die after trying each server once. 0.35 Tue May 25 15:55:36 BST 2010 - add some examples - add support for SSL (thanks to Aleksandar Ivanisevic) - add send_transactional (based on Net::Stomp::Receipt, thanks to Hugo Salgado) - add some convenience methods for accessing headers in a frame (thanks to Claes Jakobsson) - receive_frame now accepts a {timeout=>1} option - failover support (thanks to Thom May and Ash Berlin) - reconnect and resubscribe when connection failes (Thom May) 0.34 Fri Jun 27 09:29:13 BST 2008 - revert to 0.32's code, as the last release broke things that I don't have time to fix right now 0.33 Wed Jun 25 08:45:59 BST 2008 - fixes from Paul Driver: can_read doesn't behave correctly. The docs say it returns true iff there's a frame waiting to be read, but it's just a select() call to see if there's data on the socket, which can return both false positives and false negatives. While investigating this, I noticed that Net::Stomp::Frame->parse was modified at some point to take a socket as its argument. This is inconsistent with docs and probably not what was wanted anyway. parse and as_string should be symmetrical. Attached is a patch that fixes both issues and adds tests for them. 0.32 Sun Oct 29 09:06:31 GMT 2006 - rewrote the parser to add support for BytesMessage, which should allow Java<->Perl messages (thanks to Hiram Chirino and Sileshi Kassa) - set binmode() on the socket so Windows should now work (thanks to Sileshi Kassa) 0.31 Wed Oct 11 17:28:31 BST 2006 - minor docpatch noticed by Leo Lapworth - tweak frame parser - add unsubscribe() method - add can_read() method 0.30 Sat Oct 7 09:47:57 BST 2006 - initial release Net-Stomp-0.46/META.json000444001750001750 247512265231376 14475 0ustar00jasonjason000000000000{ "abstract" : "A Streaming Text Orientated Messaging Protocol Client", "author" : [ "Leon Brocard ,", "Thom May ,", "Michael S. Fischer ,", "Ash Berlin " ], "dynamic_config" : 1, "generated_by" : "Module::Build version 0.4007, CPAN::Meta::Converter version 2.132140", "license" : [ "perl_5" ], "meta-spec" : { "url" : "http://search.cpan.org/perldoc?CPAN::Meta::Spec", "version" : "2" }, "name" : "Net-Stomp", "prereqs" : { "configure" : { "requires" : { "Module::Build" : "0.40" } }, "runtime" : { "recommends" : { "IO::Socket::IP" : "0.20", "IO::Socket::SSL" : "1.75" }, "requires" : { "Class::Accessor::Fast" : "0", "IO::Select" : "0", "IO::Socket::INET" : "0" } } }, "provides" : { "Net::Stomp" : { "file" : "lib/Net/Stomp.pm", "version" : "0.46" }, "Net::Stomp::Frame" : { "file" : "lib/Net/Stomp/Frame.pm" } }, "release_status" : "stable", "resources" : { "license" : [ "http://dev.perl.org/licenses/" ] }, "version" : "0.46" } Net-Stomp-0.46/examples000755001750001750 012265231376 14525 5ustar00jasonjason000000000000Net-Stomp-0.46/examples/send.pl000444001750001750 73212265231376 16132 0ustar00jasonjason000000000000#!perl use strict; use warnings; use lib 'lib'; use DateTime; use Net::Stomp; my $stomp = Net::Stomp->new( { hostname => 'localhost', port => '61613' } ); $stomp->connect( { login => 'hello', passcode => 'there' } ); my $count = shift || 1; foreach my $i ( 1 .. $count ) { warn $i; $stomp->send( { destination => '/queue/foo', body => DateTime->now . " $i", bytes_message => 1, } ); } $stomp->disconnect; Net-Stomp-0.46/examples/subscribe.pl000444001750001750 111712265231376 17200 0ustar00jasonjason000000000000#!perl use strict; use warnings; use lib 'lib'; use Net::Stomp; my $stomp = Net::Stomp->new( { hostname => 'localhost', port => '61613' } ); $stomp->connect( { login => 'hello', passcode => 'there' } ); $stomp->subscribe( { destination => '/queue/foo', 'ack' => 'client', 'activemq.prefetchSize' => 1, } ); while ( $stomp->can_read( { timeout => 1 } ) ) { my $frame = $stomp->receive_frame; $stomp->ack( { frame => $frame } ); warn $frame->command . ': >' . substr( $frame->body, 0, 80 ) . "<\n"; } $stomp->disconnect; Net-Stomp-0.46/xt000755001750001750 012265231376 13342 5ustar00jasonjason000000000000Net-Stomp-0.46/xt/consume_buffering.t000444001750001750 315312265231376 17366 0ustar00jasonjason000000000000# -*- Mode: Perl; tab-width: 2; indent-tabs-mode: nil; -*- use strict; use warnings; use Test::More; use Test::Exception; use Net::Stomp; my $amount_to_send = 32; my $broker_host = '0.0.0.0'; note "About to insert $amount_to_send messages - be patient"; lives_ok { local $SIG{ALRM} = sub { die "failed to send $amount_to_send messages\n" }; # NB: \n required alarm(10); my $connection = Net::Stomp->new({ hostname => $broker_host, port => 61613, }); $connection->connect; for my $n (1 .. $amount_to_send) { $connection->send({ destination => '/queue/consume.many', body => "Message $n - " . scalar localtime }) } } q{inserted multiple jobs without dying}; note "Inserted $amount_to_send messages - cheers"; # now try to peel off messages use Net::Stomp; my $connection; lives_ok { $connection = Net::Stomp->new({ hostname => $broker_host, debug => 1, port => 61613, }); $connection->connect; $connection->subscribe({ destination => '/queue/consume.many', ack => 'client', }); } q{connected using Net::Stomp}; note "About to consume $amount_to_send frames - be patient"; lives_ok { local $SIG{ALRM} = sub { die "failed to consume $amount_to_send messages\n" }; # NB: \n required alarm(10); for (1 .. $amount_to_send) { my $frame = $connection->receive_frame; note "read frame $_: " . $frame->body; $connection->ack({frame => $frame}); } } qq{read $amount_to_send frames}; note "Consumed $amount_to_send frames - cheers"; done_testing; Net-Stomp-0.46/lib000755001750001750 012265231376 13455 5ustar00jasonjason000000000000Net-Stomp-0.46/lib/Net000755001750001750 012265231376 14203 5ustar00jasonjason000000000000Net-Stomp-0.46/lib/Net/Stomp.pm000444001750001750 5146712265231376 16035 0ustar00jasonjason000000000000package Net::Stomp; use strict; use warnings; use IO::Select; use Net::Stomp::Frame; use Carp; use base 'Class::Accessor::Fast'; our $VERSION = '0.46'; __PACKAGE__->mk_accessors( qw( _cur_host failover hostname hosts port select serial session_id socket ssl ssl_options subscriptions _connect_headers bufsize reconnect_on_fork ) ); sub new { my $class = shift; my $self = $class->SUPER::new(@_); $self->bufsize(8192) unless $self->bufsize; $self->reconnect_on_fork(1) unless defined $self->reconnect_on_fork; $self->{_framebuf} = ""; # We are not subscribed to anything at the start $self->subscriptions( {} ); $self->select( IO::Select->new ); my @hosts = (); # failover://tcp://primary:61616 # failover:(tcp://primary:61616,tcp://secondary:61616)?randomize=false if ($self->failover) { my ($uris, $opts) = $self->failover =~ m{^failover:(?://)? \(? (.*?) \)? (?: \? (.*?) ) ?$}ix; confess "Unable to parse failover uri: " . $self->failover unless $uris; foreach my $host (split(/,/,$uris)) { $host =~ m{^\w+://([a-zA-Z0-9\-./]+):([0-9]+)$} || confess "Unable to parse failover component: '$host'"; my ($hostname, $port) = ($1, $2); push(@hosts, {hostname => $hostname, port => $port}); } } elsif ($self->hosts) { ## @hosts is used inside the while loop later to decide whether we have ## cycled through all setup hosts. @hosts = @{$self->hosts}; } $self->hosts(@hosts); my $err; { local $@ = 'run me!'; while($@) { eval { $self->_get_connection }; last unless $@; if (!@hosts || $self->_cur_host == $#hosts ) { # We've cycled through all setup hosts. Die now. Can't die because # $@ is localized. $err = $@; last; } sleep(5); } } die $err if $err; return $self; } my $socket_class; sub _get_connection { my $self = shift; if (my $hosts = $self->hosts) { if (defined $self->_cur_host && ($self->_cur_host < $#{$hosts} ) ) { $self->_cur_host($self->_cur_host+1); } else { $self->_cur_host(0); } $self->hostname($hosts->[$self->_cur_host]->{hostname}); $self->port($hosts->[$self->_cur_host]->{port}); } my ($socket); my %sockopts = ( PeerAddr => $self->hostname, PeerPort => $self->port, Proto => 'tcp', Timeout => 5 ); if ( $self->ssl ) { eval { require IO::Socket::SSL }; die "You should install the IO::Socket::SSL module for SSL support in Net::Stomp" if $@; %sockopts = ( %sockopts, %{ $self->ssl_options || {} } ); $socket = IO::Socket::SSL->new(%sockopts); } else { $socket_class ||= eval { require IO::Socket::IP; IO::Socket::IP->VERSION('0.20'); "IO::Socket::IP" } || do { require IO::Socket::INET; "IO::Socket::INET" }; $socket = $socket_class->new(%sockopts); binmode($socket) if $socket; } die "Error connecting to " . $self->hostname . ':' . $self->port . ": $@" unless $socket; $self->select->remove($self->socket) if $self->socket; $self->select->add($socket); $self->socket($socket); $self->{_pid} = $$; } sub connect { my ( $self, $conf ) = @_; my $frame = Net::Stomp::Frame->new( { command => 'CONNECT', headers => $conf } ); $self->send_frame($frame); $frame = $self->receive_frame; # Setting initial values for session id, as given from # the stomp server $self->session_id( $frame->headers->{session} ); $self->_connect_headers( $conf ); return $frame; } sub disconnect { my $self = shift; my $frame = Net::Stomp::Frame->new( { command => 'DISCONNECT' } ); $self->send_frame($frame); $self->socket->close; $self->select->remove($self->socket); } sub _reconnect { my $self = shift; if ($self->socket) { $self->socket->close; } eval { $self->_get_connection }; while ($@) { sleep(5); eval { $self->_get_connection }; } $self->connect( $self->_connect_headers ); for my $sub(keys %{$self->subscriptions}) { $self->subscribe($self->subscriptions->{$sub}); } } sub can_read { my ( $self, $conf ) = @_; # If there is any data left in the framebuffer that we haven't read, return # 'true'. But we don't want to spin endlessly, so only return true the # first time. (Anything touching the _framebuf should update this flag when # it does something. if ( $self->{_framebuf_changed} && length $self->{_framebuf} ) { $self->{_framebuf_changed} = 0; return 1; } $conf ||= {}; my $timeout = exists $conf->{timeout} ? $conf->{timeout} : undef; return $self->select->can_read($timeout) || 0; } sub send { my ( $self, $conf ) = @_; my $body = $conf->{body}; delete $conf->{body}; my $frame = Net::Stomp::Frame->new( { command => 'SEND', headers => $conf, body => $body } ); $self->send_frame($frame); } sub send_transactional { my ( $self, $conf ) = @_; my $body = $conf->{body}; delete $conf->{body}; # begin the transaction my $transaction_id = $self->_get_next_transaction; my $begin_frame = Net::Stomp::Frame->new( { command => 'BEGIN', headers => { transaction => $transaction_id } } ); $self->send_frame($begin_frame); # send the message my $receipt_id = $self->_get_next_transaction; $conf->{receipt} = $receipt_id; my $message_frame = Net::Stomp::Frame->new( { command => 'SEND', headers => $conf, body => $body } ); $self->send_frame($message_frame); # check the receipt my $receipt_frame = $self->receive_frame; if ( $receipt_frame->command eq 'RECEIPT' && $receipt_frame->headers->{'receipt-id'} eq $receipt_id ) { # success, commit the transaction my $frame_commit = Net::Stomp::Frame->new( { command => 'COMMIT', headers => { transaction => $transaction_id } } ); return $self->send_frame($frame_commit); } else { # some failure, abort transaction my $frame_abort = Net::Stomp::Frame->new( { command => 'ABORT', headers => { transaction => $transaction_id } } ); $self->send_frame($frame_abort); return 0; } } sub _sub_key { my ($conf) = @_; if ($conf->{id}) { return "id-".$conf->{id} } return "dest-".$conf->{destination} } sub subscribe { my ( $self, $conf ) = @_; my $frame = Net::Stomp::Frame->new( { command => 'SUBSCRIBE', headers => $conf } ); $self->send_frame($frame); my $subs = $self->subscriptions; $subs->{_sub_key($conf)} = $conf; } sub unsubscribe { my ( $self, $conf ) = @_; my $frame = Net::Stomp::Frame->new( { command => 'UNSUBSCRIBE', headers => $conf } ); $self->send_frame($frame); my $subs = $self->subscriptions; delete $subs->{_sub_key($conf)} } sub ack { my ( $self, $conf ) = @_; my $id = $conf->{frame}->headers->{'message-id'}; my $frame = Net::Stomp::Frame->new( { command => 'ACK', headers => { 'message-id' => $id } } ); $self->send_frame($frame); } sub send_frame { my ( $self, $frame ) = @_; # see if we're connected before we try to syswrite() if (not defined $self->_connected) { $self->_reconnect; if (not defined $self->_connected) { warn q{wasn't connected; couldn't _reconnect()}; } } my $written = $self->socket->syswrite( $frame->as_string ); if (($written||0) != length($frame->as_string)) { warn 'only wrote ' . ($written||0) . ' characters out of the ' . length($frame->as_string) . ' character frame'; warn 'problem frame: <<' . $frame->as_string . '>>'; } unless (defined $self->_connected) { $self->_reconnect; $self->send_frame($frame); } } sub _read_data { my ($self, $timeout) = @_; return unless $self->select->can_read($timeout); my $len = $self->socket->sysread($self->{_framebuf}, $self->bufsize, length($self->{_framebuf} || '')); if ($len && $len > 0) { $self->{_framebuf_changed} = 1; } else { # EOF detected - connection is gone. We have to reset the framebuf in # case we had a partial frame in there that will never arrive. $self->{_framebuf} = ""; delete $self->{_command}; delete $self->{_headers}; } return $len; } sub _read_headers { my ($self) = @_; if ($self->{_framebuf} =~ s/^\n*([^\n].*?)\n\n//s) { $self->{_framebuf_changed} = 1; my $raw_headers = $1; if ($raw_headers =~ s/^(.+)\n//) { $self->{_command} = $1; } foreach my $line (split(/\n/, $raw_headers)) { my ($key, $value) = split(/\s*:\s*/, $line, 2); $self->{_headers}->{$key} = $value; } return 1; } return 0; } sub _read_body { my ($self) = @_; my $h = $self->{_headers}; if ($h->{'content-length'}) { if (length($self->{_framebuf}) >= $h->{'content-length'}) { $self->{_framebuf_changed} = 1; my $body = substr($self->{_framebuf}, 0, $h->{'content-length'}, '' ); # Trim the trailer off the frame. $self->{_framebuf} =~ s/^.*?\000\n*//s; return Net::Stomp::Frame->new({ command => delete $self->{_command}, headers => delete $self->{_headers}, body => $body }); } } elsif ($self->{_framebuf} =~ s/^(.*?)\000\n*//s) { # No content-length header. my $body = $1; $self->{_framebuf_changed} = 1; return Net::Stomp::Frame->new({ command => delete $self->{_command}, headers => delete $self->{_headers}, body => $body }); } return 0; } # this method is to stop the pointless warnings being thrown when trying to # call peername() on a closed socket, i.e. # getpeername() on closed socket GEN125 at # /opt/xt/xt-perl/lib/5.12.3/x86_64-linux/IO/Socket.pm line 258. # # solution taken from: # http://objectmix.com/perl/80545-warning-getpeername.html sub _connected { my $self = shift; return if $self->{_pid} != $$ and $self->reconnect_on_fork; my $connected; { local $^W = 0; $connected = $self->socket->connected; } return $connected; } sub receive_frame { my ($self, $conf) = @_; my $timeout = exists $conf->{timeout} ? $conf->{timeout} : undef; unless (defined $self->_connected) { $self->_reconnect; } my $done = 0; while ( not $done = $self->_read_headers ) { return undef unless $self->_read_data($timeout); } while ( not $done = $self->_read_body ) { return undef unless $self->_read_data($timeout); } return $done; } sub _get_next_transaction { my $self = shift; my $serial = $self->serial || 0; $serial++; $self->serial($serial); return ($self->session_id||'nosession') . '-' . $serial; } 1; __END__ =head1 NAME Net::Stomp - A Streaming Text Orientated Messaging Protocol Client =head1 SYNOPSIS # send a message to the queue 'foo' use Net::Stomp; my $stomp = Net::Stomp->new( { hostname => 'localhost', port => '61613' } ); $stomp->connect( { login => 'hello', passcode => 'there' } ); $stomp->send( { destination => '/queue/foo', body => 'test message' } ); $stomp->disconnect; # subscribe to messages from the queue 'foo' use Net::Stomp; my $stomp = Net::Stomp->new( { hostname => 'localhost', port => '61613' } ); $stomp->connect( { login => 'hello', passcode => 'there' } ); $stomp->subscribe( { destination => '/queue/foo', 'ack' => 'client', 'activemq.prefetchSize' => 1 } ); while (1) { my $frame = $stomp->receive_frame; warn $frame->body; # do something here $stomp->ack( { frame => $frame } ); } $stomp->disconnect; # write your own frame my $frame = Net::Stomp::Frame->new( { command => $command, headers => $conf, body => $body } ); $self->send_frame($frame); # connect with failover supporting similar URI to ActiveMQ $stomp = Net::Stomp->new({ failover => "failover://tcp://primary:61616" }) # "?randomize=..." and other parameters are ignored currently $stomp = Net::Stomp->new({ failover => "failover:(tcp://primary:61616,tcp://secondary:61616)?randomize=false" }) # Or in a more natural perl way $stomp = Net::Stomp->new({ hosts => [ { hostname => 'primary', port => 61616 }, { hostname => 'secondary', port => 61616 }, ] }); =head1 DESCRIPTION This module allows you to write a Stomp client. Stomp is the Streaming Text Orientated Messaging Protocol (or the Protocol Briefly Known as TTMP and Represented by the symbol :ttmp). It's a simple and easy to implement protocol for working with Message Orientated Middleware from any language. L is useful for talking to Apache ActiveMQ, an open source (Apache 2.0 licensed) Java Message Service 1.1 (JMS) message broker packed with many enterprise features. A Stomp frame consists of a command, a series of headers and a body - see L for more details. For details on the protocol see L. To enable the ActiveMQ Broker for Stomp add the following to the activemq.xml configuration inside the section: To enable the ActiveMQ Broker for Stomp and SSL add the following inside the section: For details on Stomp in ActiveMQ See L. =head1 METHODS =head2 new The constructor creates a new object. You must pass in a hostname and a port or set a failover configuration: my $stomp = Net::Stomp->new( { hostname => 'localhost', port => '61613' } ); If you want to use SSL, make sure you have L and pass in the SSL flag: my $stomp = Net::Stomp->new( { hostname => 'localhost', port => '61612', ssl => 1, } ); If you want to pass in L options: my $stomp = Net::Stomp->new( { hostname => 'localhost', port => '61612', ssl => 1, ssl_options => { SSL_cipher_list => 'ALL:!EXPORT' }, } ); =head3 Failover There is experiemental failover support in Net::Stomp. You can specify failover in a similar maner to ActiveMQ (L) for similarity with Java configs or using a more natural method to perl of passing in an array-of-hashrefs in the C parameter. Currently when ever Net::Stomp connects or reconnects it will simply try the next host in the list. =head3 Reconnect on C By default Net::Stomp will reconnect, using a different socket, if the process Cs. This avoids problems when parent & child write to the socket at the same time. If, for whatever reason, you don't want this to happen, set C to C<0> (either as a constructor parameter, or by calling the method). =head2 connect This connects to the Stomp server. You may pass in a C and C options. You may also pass in 'client-id', which specifies the JMS Client ID which is used in combination to the activemqq.subscriptionName to denote a durable subscriber. $stomp->connect( { login => 'hello', passcode => 'there' } ); =head2 send This sends a message to a queue or topic. You must pass in a destination and a body. $stomp->send( { destination => '/queue/foo', body => 'test message' } ); To send a BytesMessage, you should set the field 'bytes_message' to 1. =head2 send_transactional This sends a message in transactional mode and fails if the receipt of the message is not acknowledged by the server: $stomp->send_transactional( { destination => '/queue/foo', body => 'test message' } ) or die "Couldn't send the message!"; If using ActiveMQ, you might also want to make the message persistent: $stomp->send_transactional( { destination => '/queue/foo', body => 'test message', persistent => 'true' } ) or die "Couldn't send the message!"; =head2 disconnect This disconnects from the Stomp server: $stomp->disconnect; =head2 subscribe This subscribes you to a queue or topic. You must pass in a destination. The acknowledge mode defaults to 'auto', which means that frames will be considered delivered after they have been sent to a client. The other option is 'client', which means that messages will only be considered delivered after the client specifically acknowledges them with an ACK frame. Other options: 'selector': which specifies a JMS Selector using SQL 92 syntax as specified in the JMS 1.1 specificiation. This allows a filter to be applied to each message as part of the subscription. 'activemq.dispatchAsync': should messages be dispatched synchronously or asynchronously from the producer thread for non-durable topics in the broker. For fast consumers set this to false. For slow consumers set it to true so that dispatching will not block fast consumers. 'activemq.exclusive': Would I like to be an Exclusive Consumer on a queue. 'activemq.maximumPendingMessageLimit': For Slow Consumer Handlingon non-durable topics by dropping old messages - we can set a maximum pending limit which once a slow consumer backs up to this high water mark we begin to discard old messages. 'activemq.noLocal': Specifies whether or not locally sent messages should be ignored for subscriptions. Set to true to filter out locally sent messages. 'activemq.prefetchSize': Specifies the maximum number of pending messages that will be dispatched to the client. Once this maximum is reached no more messages are dispatched until the client acknowledges a message. Set to 1 for very fair distribution of messages across consumers where processing messages can be slow. 'activemq.priority': Sets the priority of the consumer so that dispatching can be weighted in priority order. 'activemq.retroactive': For non-durable topics do you wish this subscription to the retroactive. 'activemq.subscriptionName': For durable topic subscriptions you must specify the same clientId on the connection and subscriberName on the subscribe. $stomp->subscribe( { destination => '/queue/foo', 'ack' => 'client', 'activemq.prefetchSize' => 1 } ); =head2 unsubscribe This unsubscribes you to a queue or topic. You must pass in a destination: $stomp->unsubcribe({ destination => '/queue/foo' }); =head2 receive_frame This blocks and returns you the next Stomp frame. my $frame = $stomp->receive_frame; warn $frame->body; # do something here The header bytes_message is 1 if the message was a BytesMessage. By default this method will block until a frame can be returned. If you wish to wait for a specified time pass a C argument: # Wait half a second for a frame, else return undef $stomp->receive_frame({ timeout => 0.5 }) =head2 can_read This returns whether there is new data is waiting to be read from the STOMP server. Optionally takes a timeout in seconds: my $can_read = $stomp->can_read; my $can_read = $stomp->can_read({ timeout => '0.1' }); C says block until something can be read, C<0> says to poll and return immediately. =head2 ack This acknowledges that you have received and processed a frame (if you are using client acknowledgements): $stomp->ack( { frame => $frame } ); =head2 send_frame If this module does not provide enough help for sending frames, you may construct your own frame and send it: # write your own frame my $frame = Net::Stomp::Frame->new( { command => $command, headers => $conf, body => $body } ); $self->send_frame($frame); =head1 SEE ALSO L. =head1 AUTHORS Leon Brocard , Thom May , Michael S. Fischer , Ash Berlin =head1 CONTRIBUTORS Paul Driver , Andreas Faafeng , Vigith Maurice , Stephen Fralich , Squeeks , Chisel Wright , =head1 COPYRIGHT Copyright (C) 2006-9, Leon Brocard Copyright (C) 2009, Thom May, Betfair.com Copyright (C) 2010, Ash Berlin, Net-a-Porter.com Copyright (C) 2010, Michael S. Fischer This module is free software; you can redistribute it or modify it under the same terms as Perl itself. Net-Stomp-0.46/lib/Net/Stomp000755001750001750 012265231376 15305 5ustar00jasonjason000000000000Net-Stomp-0.46/lib/Net/Stomp/Frame.pm000444001750001750 576412265231376 17046 0ustar00jasonjason000000000000package Net::Stomp::Frame; use strict; use warnings; use base 'Class::Accessor::Fast'; __PACKAGE__->mk_accessors(qw(command headers body)); BEGIN { for my $header ( qw(destination exchange content-type content-length message-id)) { my $method = $header; $method =~ s/-/_/g; no strict 'refs'; *$method = sub { my $self = shift; $self->headers->{$header} = shift if @_; $self->headers->{$header}; }; } } sub as_string { my $self = shift; my $command = $self->command; my $headers = $self->headers; my $body = $self->body; my $frame = $command . "\n"; # insert a content-length header my $bytes_message = 0; if ( $headers->{bytes_message} ) { $bytes_message = 1; delete $headers->{bytes_message}; $headers->{"content-length"} = length( $self->body ); } while ( my ( $key, $value ) = each %{ $headers || {} } ) { $frame .= $key . ':' . (defined $value ? $value : '') . "\n"; } $frame .= "\n"; $frame .= $body || ''; $frame .= "\000"; } 1; __END__ =head1 NAME Net::Stomp::Frame - A STOMP Frame =head1 SYNOPSIS use Net::Stomp::Frame; my $frame = Net::Stomp::Frame->new( { command => $command, headers => $headers, body => $body, } ); my $frame = Net::Stomp::Frame->parse($string); my $string = $frame->as_string; =head1 DESCRIPTION This module encapulates a Stomp frame. Stomp is the Streaming Text Orientated Messaging Protocol (or the Protocol Briefly Known as TTMP and Represented by the symbol :ttmp). It's a simple and easy to implement protocol for working with Message Orientated Middleware from any language. L is useful for talking to Apache ActiveMQ, an open source (Apache 2.0 licensed) Java Message Service 1.1 (JMS) message broker packed with many enterprise features. A Stomp frame consists of a command, a series of headers and a body. For details on the protocol see L. =head1 METHODS =head2 new Create a new L object: my $frame = Net::Stomp::Frame->new( { command => $command, headers => $headers, body => $body, } ); =head2 parse Create a new L given a string containing the serialised frame: my $frame = Net::Stomp::Frame->parse($string); =head2 as_string Create a string containing the serialised frame representing the frame: my $string = $frame->as_string; =head2 destination Get or set the C header. =head2 content_type Get or set the C header. =head2 content_length Get or set the C header. =head2 exchange Get or set the C header. =head2 message_id Get or set the C header. =head1 SEE ALSO L. =head1 AUTHOR Leon Brocard . =head1 COPYRIGHT Copyright (C) 2006, Leon Brocard This module is free software; you can redistribute it or modify it under the same terms as Perl itself. Net-Stomp-0.46/t000755001750001750 012265231376 13152 5ustar00jasonjason000000000000Net-Stomp-0.46/t/pod.t000444001750001750 21412265231376 14233 0ustar00jasonjason000000000000#!perl -T use Test::More; eval "use Test::Pod 1.14"; plan skip_all => "Test::Pod 1.14 required for testing POD" if $@; all_pod_files_ok(); Net-Stomp-0.46/t/pod_coverage.t000444001750001750 25412265231376 16112 0ustar00jasonjason000000000000#!perl -T use Test::More; eval "use Test::Pod::Coverage 1.04"; plan skip_all => "Test::Pod::Coverage 1.04 required for testing POD coverage" if $@; all_pod_coverage_ok();