r58452 - in /trunk/libnet-stomp-perl: ./ debian/ debian/source/ examples/ lib/Net/ lib/Net/Stomp/

ansgar-guest at users.alioth.debian.org ansgar-guest at users.alioth.debian.org
Wed May 26 11:27:00 UTC 2010


Author: ansgar-guest
Date: Wed May 26 11:26:52 2010
New Revision: 58452

URL: http://svn.debian.org/wsvn/pkg-perl/?sc=1&rev=58452
Log:
* New upstream release.
* Install examples.
* Use tiny debian/rules.
* Use source format 3.0 (quilt).
* debian/control: Mention "Perl module" in short description.
* debian/control: Add perl (>= 5.10) as a preferred alternative to
  libmodule-build-perl build-dep.
* debian/control: Add (build-)dep on libclass-accessor-perl.
* debian/copyright: Formatting changes for current DEP-5 proposal.
* debian/copyright: Add additional copyright holders and years of copyright.
* Bump Standards-Version to 3.8.4.
* Add myself to Uploaders.

Added:
    trunk/libnet-stomp-perl/MANIFEST.SKIP
      - copied unchanged from r58449, branches/upstream/libnet-stomp-perl/current/MANIFEST.SKIP
    trunk/libnet-stomp-perl/debian/libnet-stomp-perl.examples
    trunk/libnet-stomp-perl/debian/source/
    trunk/libnet-stomp-perl/debian/source/format
    trunk/libnet-stomp-perl/examples/
      - copied from r58449, branches/upstream/libnet-stomp-perl/current/examples/
Modified:
    trunk/libnet-stomp-perl/CHANGES
    trunk/libnet-stomp-perl/MANIFEST
    trunk/libnet-stomp-perl/META.yml
    trunk/libnet-stomp-perl/Makefile.PL
    trunk/libnet-stomp-perl/README
    trunk/libnet-stomp-perl/debian/changelog
    trunk/libnet-stomp-perl/debian/control
    trunk/libnet-stomp-perl/debian/copyright
    trunk/libnet-stomp-perl/debian/rules
    trunk/libnet-stomp-perl/lib/Net/Stomp.pm
    trunk/libnet-stomp-perl/lib/Net/Stomp/Frame.pm

Modified: trunk/libnet-stomp-perl/CHANGES
URL: http://svn.debian.org/wsvn/pkg-perl/trunk/libnet-stomp-perl/CHANGES?rev=58452&op=diff
==============================================================================
--- trunk/libnet-stomp-perl/CHANGES (original)
+++ trunk/libnet-stomp-perl/CHANGES Wed May 26 11:26:52 2010
@@ -1,4 +1,15 @@
 Revision history for Perl module Net::Stomp:
+
+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
@@ -30,4 +41,4 @@
   - add can_read() method
 
 0.30 Sat Oct  7 09:47:57 BST 2006
-  - initial release
+  - initial release

Modified: trunk/libnet-stomp-perl/MANIFEST
URL: http://svn.debian.org/wsvn/pkg-perl/trunk/libnet-stomp-perl/MANIFEST?rev=58452&op=diff
==============================================================================
--- trunk/libnet-stomp-perl/MANIFEST (original)
+++ trunk/libnet-stomp-perl/MANIFEST Wed May 26 11:26:52 2010
@@ -1,10 +1,13 @@
 Build.PL
 CHANGES
+examples/send.pl
+examples/subscribe.pl
 lib/Net/Stomp.pm
 lib/Net/Stomp/Frame.pm
-Makefile.PL
 MANIFEST			This list of files
+MANIFEST.SKIP
+META.yml
 README
 t/pod.t
 t/pod_coverage.t
-META.yml
+Makefile.PL

Modified: trunk/libnet-stomp-perl/META.yml
URL: http://svn.debian.org/wsvn/pkg-perl/trunk/libnet-stomp-perl/META.yml?rev=58452&op=diff
==============================================================================
--- trunk/libnet-stomp-perl/META.yml (original)
+++ trunk/libnet-stomp-perl/META.yml Wed May 26 11:26:52 2010
@@ -1,23 +1,25 @@
 ---
+abstract: 'A Streaming Text Orientated Messaging Protocol Client'
+author:
+  - "Leon Brocard <acme at astray.com>.\nThom May <thom.may at betfair.com>.\nAsh Berlin <ash_github at firemirror.com>."
+configure_requires:
+  Module::Build: 0.36
+generated_by: 'Module::Build version 0.3603'
+license: perl
+meta-spec:
+  url: http://module-build.sourceforge.net/META-spec-v1.4.html
+  version: 1.4
 name: Net-Stomp
-version: 0.34
-author:
-  - Leon Brocard <acme at astray.com>.
-abstract: A Streaming Text Orientated Messaging Protocol Client
-license: perl
-resources:
-  license: http://dev.perl.org/licenses/
+provides:
+  Net::Stomp:
+    file: lib/Net/Stomp.pm
+    version: 0.35
+  Net::Stomp::Frame:
+    file: lib/Net/Stomp/Frame.pm
 requires:
   Class::Accessor::Fast: 0
   IO::Select: 0
   IO::Socket::INET: 0
-provides:
-  Net::Stomp:
-    file: lib/Net/Stomp.pm
-    version: 0.34
-  Net::Stomp::Frame:
-    file: lib/Net/Stomp/Frame.pm
-generated_by: Module::Build version 0.280801
-meta-spec:
-  url: http://module-build.sourceforge.net/META-spec-v1.2.html
-  version: 1.2
+resources:
+  license: http://dev.perl.org/licenses/
+version: 0.35

Modified: trunk/libnet-stomp-perl/Makefile.PL
URL: http://svn.debian.org/wsvn/pkg-perl/trunk/libnet-stomp-perl/Makefile.PL?rev=58452&op=diff
==============================================================================
--- trunk/libnet-stomp-perl/Makefile.PL (original)
+++ trunk/libnet-stomp-perl/Makefile.PL Wed May 26 11:26:52 2010
@@ -1,16 +1,16 @@
-# Note: this file was auto-generated by Module::Build::Compat version 0.2808_01
+# Note: this file was auto-generated by Module::Build::Compat version 0.3603
 use ExtUtils::MakeMaker;
 WriteMakefile
 (
-          'PL_FILES' => {},
-          'INSTALLDIRS' => 'site',
           'NAME' => 'Net::Stomp',
-          'EXE_FILES' => [],
           'VERSION_FROM' => 'lib/Net/Stomp.pm',
           'PREREQ_PM' => {
+                           'Class::Accessor::Fast' => '0',
                            'IO::Select' => '0',
-                           'IO::Socket::INET' => '0',
-                           'Class::Accessor::Fast' => '0'
-                         }
+                           'IO::Socket::INET' => '0'
+                         },
+          'INSTALLDIRS' => 'site',
+          'EXE_FILES' => [],
+          'PL_FILES' => {}
         )
 ;

Modified: trunk/libnet-stomp-perl/README
URL: http://svn.debian.org/wsvn/pkg-perl/trunk/libnet-stomp-perl/README?rev=58452&op=diff
==============================================================================
--- trunk/libnet-stomp-perl/README (original)
+++ trunk/libnet-stomp-perl/README Wed May 26 11:26:52 2010
@@ -47,14 +47,17 @@
     For details on the protocol see <http://stomp.codehaus.org/Protocol>.
 
     To enable the ActiveMQ Broker for Stomp add the following to the
-    activemq.xml configuration:
-
-      <connector>
-          <serverTransport uri="stomp://localhost:61613"/>
-      </connector>
+    activemq.xml configuration inside the <transportConnectors> section:
+
+      <transportConnector name="stomp" uri="stomp://localhost:61613"/>
+
+    To enable the ActiveMQ Broker for Stomp and SSL add the following inside
+    the <transportConnectors> section:
+
+      <transportConnector name="stomp+ssl" uri="stomp+ssl://localhost:61612"/>
 
     For details on Stomp in ActiveMQ See
-    <http://www.activemq.org/site/stomp.html>.
+    <http://activemq.apache.org/stomp.html>.
 
 METHODS
   new
@@ -63,6 +66,24 @@
 
       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.
@@ -81,6 +102,20 @@
           { 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:
@@ -185,7 +220,7 @@
     Leon Brocard <acme at astray.com>.
 
 COPYRIGHT
-    Copyright (C) 2006, Leon Brocard
+    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.

Modified: trunk/libnet-stomp-perl/debian/changelog
URL: http://svn.debian.org/wsvn/pkg-perl/trunk/libnet-stomp-perl/debian/changelog?rev=58452&op=diff
==============================================================================
--- trunk/libnet-stomp-perl/debian/changelog (original)
+++ trunk/libnet-stomp-perl/debian/changelog Wed May 26 11:26:52 2010
@@ -1,4 +1,4 @@
-libnet-stomp-perl (0.34-2) UNRELEASED; urgency=low
+libnet-stomp-perl (0.35-1) unstable; urgency=low
 
   [ Nathan Handler ]
   * debian/watch: Update to ignore development releases.
@@ -8,7 +8,21 @@
     perl (>= 5.6.0-{12,16}) with an unversioned dependency on perl (as
     permitted by Debian Policy 3.8.3).
 
- -- Nathan Handler <nhandler at ubuntu.com>  Sat, 06 Jun 2009 01:36:42 +0000
+  [ Ansgar Burchardt ]
+  * New upstream release.
+  * Install examples.
+  * Use tiny debian/rules.
+  * Use source format 3.0 (quilt).
+  * debian/control: Mention "Perl module" in short description.
+  * debian/control: Add perl (>= 5.10) as a preferred alternative to
+    libmodule-build-perl build-dep.
+  * debian/control: Add (build-)dep on libclass-accessor-perl.
+  * debian/copyright: Formatting changes for current DEP-5 proposal.
+  * debian/copyright: Add additional copyright holders and years of copyright.
+  * Bump Standards-Version to 3.8.4.
+  * Add myself to Uploaders.
+
+ -- Ansgar Burchardt <ansgar at 43-1.org>  Wed, 26 May 2010 20:26:32 +0900
 
 libnet-stomp-perl (0.34-1) unstable; urgency=low
 

Modified: trunk/libnet-stomp-perl/debian/control
URL: http://svn.debian.org/wsvn/pkg-perl/trunk/libnet-stomp-perl/debian/control?rev=58452&op=diff
==============================================================================
--- trunk/libnet-stomp-perl/debian/control (original)
+++ trunk/libnet-stomp-perl/debian/control Wed May 26 11:26:52 2010
@@ -1,20 +1,21 @@
 Source: libnet-stomp-perl
 Section: perl
 Priority: optional
-Build-Depends: debhelper (>= 7), libmodule-build-perl
-Build-Depends-Indep: perl
+Build-Depends: debhelper (>= 7.0.50~), perl (>= 5.10) | libmodule-build-perl
+Build-Depends-Indep: perl, libclass-accessor-perl
 Maintainer: Debian Perl Group <pkg-perl-maintainers at lists.alioth.debian.org>
 Uploaders: Krzysztof Krzyżaniak (eloy) <eloy at debian.org>,
-  Sebastien Aperghis-Tramoni <sebastien at aperghis.net>
-Standards-Version: 3.8.1
+ Sebastien Aperghis-Tramoni <sebastien at aperghis.net>,
+ Ansgar Burchardt <ansgar at 43-1.org>
+Standards-Version: 3.8.4
 Vcs-Svn: svn://svn.debian.org/pkg-perl/trunk/libnet-stomp-perl/
 Vcs-Browser: http://svn.debian.org/viewsvn/pkg-perl/trunk/libnet-stomp-perl/
 Homepage: http://search.cpan.org/dist/Net-Stomp/
 
 Package: libnet-stomp-perl
 Architecture: all
-Depends: ${misc:Depends}, ${perl:Depends}
-Description: A Streaming Text Orientated Messaging Protocol Client
+Depends: ${misc:Depends}, ${perl:Depends}, libclass-accessor-perl
+Description: Perl module providing a Streaming Text Orientated Messaging Protocol Client
  Net::Stomp 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

Modified: trunk/libnet-stomp-perl/debian/copyright
URL: http://svn.debian.org/wsvn/pkg-perl/trunk/libnet-stomp-perl/debian/copyright?rev=58452&op=diff
==============================================================================
--- trunk/libnet-stomp-perl/debian/copyright (original)
+++ trunk/libnet-stomp-perl/debian/copyright Wed May 26 11:26:52 2010
@@ -1,24 +1,21 @@
-Format-Specification:
-    http://wiki.debian.org/Proposals/CopyrightFormat?action=recall&rev=196
-Upstream-Maintainer: Leon Brocard <acme at astray.com>.
-Upstream-Source: http://search.cpan.org/dist/Net-Stomp/
-Upstream-Name: Net-Stomp
-Disclaimer: This copyright info was automatically extracted 
-    from the perl module. It may not be accurate, so you better 
-    check the module sources in order to ensure the module for its 
-    inclusion in Debian or for general legal information. Please, 
-    if licensing information is incorrectly generated, file a bug 
-    on dh-make-perl.
+Format-Specification: http://svn.debian.org/wsvn/dep/web/deps/dep5.mdwn?op=file&rev=135
+Maintainer: Ash Berlin
+Source: http://search.cpan.org/dist/Net-Stomp/
+Name: Net-Stomp
 
 Files: *
-Copyright: Leon Brocard <acme at astray.com>.
-License-Alias: Perl
-License: Artistic | GPL-1+
+Copyright:
+ 2006-2009, Leon Brocard <acme at astray.com>
+ 2009,      Thom May, Betfair.com <thom.may at betfair.com>
+ 2010,      Ash Berlin, Net-a-Porter.com <ash_github at firemirror.com>
+License: Artistic or GPL-1+
 
 Files: debian/*
-Copyright: 2009, Krzysztof Krzyżaniak (eloy) <eloy at debian.org>
-    2008-2009, Sebastien Aperghis-Tramoni <sebastien at aperghis.net>.
-License: Artistic | GPL-1+
+Copyright:
+ 2009,      Krzysztof Krzyżaniak (eloy) <eloy at debian.org>
+ 2008-2009, Sebastien Aperghis-Tramoni <sebastien at aperghis.net>
+ 2010,      Ansgar Burchardt <ansgar at 43-1.org>
+License: Artistic or GPL-1+
 
 License: Artistic
     This program is free software; you can redistribute it and/or modify

Added: trunk/libnet-stomp-perl/debian/libnet-stomp-perl.examples
URL: http://svn.debian.org/wsvn/pkg-perl/trunk/libnet-stomp-perl/debian/libnet-stomp-perl.examples?rev=58452&op=file
==============================================================================
--- trunk/libnet-stomp-perl/debian/libnet-stomp-perl.examples (added)
+++ trunk/libnet-stomp-perl/debian/libnet-stomp-perl.examples Wed May 26 11:26:52 2010
@@ -1,0 +1,1 @@
+examples/*

Modified: trunk/libnet-stomp-perl/debian/rules
URL: http://svn.debian.org/wsvn/pkg-perl/trunk/libnet-stomp-perl/debian/rules?rev=58452&op=diff
==============================================================================
--- trunk/libnet-stomp-perl/debian/rules (original)
+++ trunk/libnet-stomp-perl/debian/rules Wed May 26 11:26:52 2010
@@ -1,23 +1,11 @@
 #!/usr/bin/make -f
 
-build: build-stamp
-build-stamp:
-	dh build
-	touch $@
+PACKAGE := $(shell dh_listpackages)
+TMP     := $(CURDIR)/debian/$(PACKAGE)
 
-clean:
+%:
 	dh $@
 
-install: install-stamp
-install-stamp: build-stamp
-	dh install
-	touch $@
-
-binary-arch:
-
-binary-indep: install
-	dh $@
-
-binary: binary-arch binary-indep
-
-.PHONY: binary binary-arch binary-indep install clean build
+override_dh_installexamples:
+	dh_installexamples
+	sed -i '1c "#! /usr/bin/perl"' $(TMP)/usr/share/doc/$(PACKAGE)/examples/*.pl

Added: trunk/libnet-stomp-perl/debian/source/format
URL: http://svn.debian.org/wsvn/pkg-perl/trunk/libnet-stomp-perl/debian/source/format?rev=58452&op=file
==============================================================================
--- trunk/libnet-stomp-perl/debian/source/format (added)
+++ trunk/libnet-stomp-perl/debian/source/format Wed May 26 11:26:52 2010
@@ -1,0 +1,1 @@
+3.0 (quilt)

Modified: trunk/libnet-stomp-perl/lib/Net/Stomp.pm
URL: http://svn.debian.org/wsvn/pkg-perl/trunk/libnet-stomp-perl/lib/Net/Stomp.pm?rev=58452&op=diff
==============================================================================
--- trunk/libnet-stomp-perl/lib/Net/Stomp.pm (original)
+++ trunk/libnet-stomp-perl/lib/Net/Stomp.pm Wed May 26 11:26:52 2010
@@ -4,48 +4,132 @@
 use IO::Socket::INET;
 use IO::Select;
 use Net::Stomp::Frame;
+use Carp;
 use base 'Class::Accessor::Fast';
-__PACKAGE__->mk_accessors(qw(hostname port select socket));
-our $VERSION = '0.34';
+our $VERSION = '0.35';
+__PACKAGE__->mk_accessors( qw(
+    _cur_host failover hostname hosts port select serial session_id socket ssl
+    ssl_options subscriptions _connect_headers
+) );
 
 sub new {
-    my $class  = shift;
-    my $self   = $class->SUPER::new(@_);
-    my $socket = IO::Socket::INET->new(
+    my $class = shift;
+    my $self  = $class->SUPER::new(@_);
+
+    # 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)) {
+            my ($hostname, $port) = ($host =~ m{^\w+://([a-zA-Z0-9\-./]+):([0-9]+)$})
+              || confess "Unable to parse failover component: '$host'";
+            push(@hosts, {hostname => $hostname, port => $port});
+        }
+    }
+    $self->hosts(@hosts);
+
+    eval { $self->_get_connection};
+    while($@) {
+        sleep(5);
+        eval { $self->_get_connection};
+    }
+    return $self;
+}
+
+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'
+        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 = IO::Socket::INET->new(%sockopts);
+        binmode($socket);
+    }
     die "Error connecting to " . $self->hostname . ':' . $self->port . ": $!"
         unless $socket;
-    binmode($socket);
+
+    $self->select->remove($self->socket) if $self->socket;
+
+    $self->select->add($socket);
     $self->socket($socket);
-    my $select = IO::Select->new();
-    $select->add($socket);
-    $self->select($select);
-
-    return $self;
+
 }
 
 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', } );
+    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 ) = @_;
-    my $timeout = $conf->{timeout} || 0;
+    $conf ||= {};
+    my $timeout = exists $conf->{timeout} ? $conf->{timeout} : 0;
     return $self->select->can_read($timeout) || 0;
 }
 
@@ -58,11 +142,59 @@
     $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 subscribe {
     my ( $self, $conf ) = @_;
     my $frame = Net::Stomp::Frame->new(
         { command => 'SUBSCRIBE', headers => $conf } );
     $self->send_frame($frame);
+    my $subs = $self->subscriptions;
+    $subs->{$conf->{'destination'}} = $conf;
 }
 
 sub unsubscribe {
@@ -70,6 +202,8 @@
     my $frame = Net::Stomp::Frame->new(
         { command => 'UNSUBSCRIBE', headers => $conf } );
     $self->send_frame($frame);
+    my $subs = $self->subscriptions;
+    delete $subs->{$conf->{'destination'}};
 }
 
 sub ack {
@@ -85,15 +219,49 @@
 
     #     warn "send [" . $frame->as_string . "]\n";
     $self->socket->print( $frame->as_string );
+    my $connected = $self->socket->connected;
+    unless (defined $connected) {
+        $self->_reconnect;
+        $self->send_frame($frame);
+    }
 }
 
 sub receive_frame {
-    my $self = shift;
-
-    my $frame = Net::Stomp::Frame->parse( $self->socket );
-
+    my ($self, $conf) = @_;
+
+    # default is to block until we can read something.
+    $conf ||= { timeout => undef };
+
+    my $frame;
+    while (!$frame) {
+
+        # If the user passed in { timeout => 1 } then we wait for up to a
+        # second to read something. If we get no data in that time, then return
+        # undef.
+
+        # But if we get an error (cos we aren't connected) then we should
+        # reconnect and try again.
+        if ( $self->can_read($conf) ) {
+            eval {
+                $frame = Net::Stomp::Frame->parse( $self->socket );
+                1;
+            } or $self->_reconnect;
+        }
+        else {
+            return;
+        }
+    }
     #     warn "receive [" . $frame->as_string . "]\n";
     return $frame;
+}
+
+sub _get_next_transaction {
+    my $self = shift;
+    my $serial = $self->serial || 0;
+    $serial++;
+    $self->serial($serial);
+
+    return $self->session_id . '-' . $serial;
 }
 
 1;
@@ -132,9 +300,20 @@
   $stomp->disconnect;
 
   # write your own frame
-   my $frame = Net::Stomp::Frame->new(
+  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
 
@@ -152,42 +331,90 @@
 For details on the protocol see L<http://stomp.codehaus.org/Protocol>.
 
 To enable the ActiveMQ Broker for Stomp add the following to the
-activemq.xml configuration:
-
-  <connector>
-      <serverTransport uri="stomp://localhost:61613"/>
-  </connector>
-
-For details on Stomp in ActiveMQ See L<http://www.activemq.org/site/stomp.html>.
+activemq.xml configuration inside the <transportConnectors> section:
+
+  <transportConnector name="stomp" uri="stomp://localhost:61613"/>
+
+To enable the ActiveMQ Broker for Stomp and SSL add the following
+inside the <transportConnectors> section:
+
+  <transportConnector name="stomp+ssl" uri="stomp+ssl://localhost:61612"/>
+
+For details on Stomp in ActiveMQ See L<http://activemq.apache.org/stomp.html>.
 
 =head1 METHODS
 
 =head2 new
 
 The constructor creates a new object. You must pass in a hostname and
-a port:
+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<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 L<IO::Socket::SSL> 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<http://activemq.apache.org/failover-transport-reference.html>) for
+similarity with Java configs or using a more natural method to perl of passing
+in an array-of-hashrefs in the C<hosts> parameter.
+
+Currently when ever Net::Stomp connects or reconnects it will simply try the
+next host in the list.
+
 =head2 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.
+This connects to the Stomp server. You may pass in a C<login> and
+C<passcode> 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.
+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
 
@@ -265,6 +492,12 @@
 
 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<timeout> argument:
+
+  # Wait half a second for a frame, else return undef
+  $stomp->receive_frame({ timeout => 0.5 })
+
 =head2 can_read
 
 This returns whether a frame is waiting to be read. Optionally takes a
@@ -298,10 +531,14 @@
 =head1 AUTHOR
 
 Leon Brocard <acme at astray.com>.
+Thom May <thom.may at betfair.com>.
+Ash Berlin <ash_github at firemirror.com>.
 
 =head1 COPYRIGHT
 
-Copyright (C) 2006, Leon Brocard
+Copyright (C) 2006-9, Leon Brocard
+Copyright (C) 2009, Thom May, Betfair.com
+Copyright (C) 2010, Ash Berlin, Net-a-Porter.com
 
 This module is free software; you can redistribute it or modify it
 under the same terms as Perl itself.

Modified: trunk/libnet-stomp-perl/lib/Net/Stomp/Frame.pm
URL: http://svn.debian.org/wsvn/pkg-perl/trunk/libnet-stomp-perl/lib/Net/Stomp/Frame.pm?rev=58452&op=diff
==============================================================================
--- trunk/libnet-stomp-perl/lib/Net/Stomp/Frame.pm (original)
+++ trunk/libnet-stomp-perl/lib/Net/Stomp/Frame.pm Wed May 26 11:26:52 2010
@@ -3,6 +3,21 @@
 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;
@@ -127,6 +142,26 @@
 
   my $string = $frame->as_string;
 
+=head2 destination
+
+Get or set the C<destination> header.
+
+=head2 content_type
+
+Get or set the C<content-type> header.
+
+=head2 content_length
+
+Get or set the C<content-length> header.
+
+=head2 exchange
+
+Get or set the C<exchange> header.
+
+=head2 message_id
+
+Get or set the C<message-id> header.
+
 =head1 SEE ALSO
 
 L<Net::Stomp>.




More information about the Pkg-perl-cvs-commits mailing list