Repository: qpid-proton Updated Branches: refs/heads/master a533c5301 -> 28bbd8bc6
PROTON-471: Add Messenger->work to Perl bindings Added methods for checking that a Messenger instance is blocking. Also added asynchronous examples for Perl. Added a recv_async and a send_async example app for Perl, based on the Python apps. Project: http://git-wip-us.apache.org/repos/asf/qpid-proton/repo Commit: http://git-wip-us.apache.org/repos/asf/qpid-proton/commit/3b200074 Tree: http://git-wip-us.apache.org/repos/asf/qpid-proton/tree/3b200074 Diff: http://git-wip-us.apache.org/repos/asf/qpid-proton/diff/3b200074 Branch: refs/heads/master Commit: 3b20007434045295f1d5e21b588895b59240e56f Parents: a533c53 Author: Darryl L. Pierce <[email protected]> Authored: Wed Jan 8 09:53:47 2014 -0500 Committer: Darryl L. Pierce <[email protected]> Committed: Thu Dec 18 08:16:44 2014 -0500 ---------------------------------------------------------------------- examples/messenger/py/send_async.py | 1 - .../perl/lib/qpid/proton/ExceptionHandling.pm | 7 +- .../bindings/perl/lib/qpid/proton/Message.pm | 5 +- .../bindings/perl/lib/qpid/proton/Messenger.pm | 85 ++++++++++++++++++-- .../bindings/perl/lib/qpid/proton/Tracker.pm | 6 +- proton-c/bindings/perl/lib/qpid_proton.pm | 5 +- proton-c/bindings/perl/perl.i | 33 ++++++++ 7 files changed, 123 insertions(+), 19 deletions(-) ---------------------------------------------------------------------- http://git-wip-us.apache.org/repos/asf/qpid-proton/blob/3b200074/examples/messenger/py/send_async.py ---------------------------------------------------------------------- diff --git a/examples/messenger/py/send_async.py b/examples/messenger/py/send_async.py index 526fd7d..304aceb 100755 --- a/examples/messenger/py/send_async.py +++ b/examples/messenger/py/send_async.py @@ -38,7 +38,6 @@ class App(CallbackAdapter): self.message.address = opts.address self.message.reply_to = opts.reply_to for a in args: - print "Sending:", a self.message.body = a self.send(self.message, self.on_status) http://git-wip-us.apache.org/repos/asf/qpid-proton/blob/3b200074/proton-c/bindings/perl/lib/qpid/proton/ExceptionHandling.pm ---------------------------------------------------------------------- diff --git a/proton-c/bindings/perl/lib/qpid/proton/ExceptionHandling.pm b/proton-c/bindings/perl/lib/qpid/proton/ExceptionHandling.pm index 534a2ab..33cf6c0 100644 --- a/proton-c/bindings/perl/lib/qpid/proton/ExceptionHandling.pm +++ b/proton-c/bindings/perl/lib/qpid/proton/ExceptionHandling.pm @@ -20,6 +20,7 @@ use strict; use warnings; use cproton_perl; +use Devel::StackTrace; package qpid::proton; @@ -29,7 +30,11 @@ sub check_for_error { if($rc < 0) { my $source = $_[1]; - die "ERROR[$rc] " . $source->get_error(); + my $trace = Devel::StackTrace->new; + + print $trace->as_string; + + die "ERROR[$rc] " . $source->get_error() . "\n"; } } http://git-wip-us.apache.org/repos/asf/qpid-proton/blob/3b200074/proton-c/bindings/perl/lib/qpid/proton/Message.pm ---------------------------------------------------------------------- diff --git a/proton-c/bindings/perl/lib/qpid/proton/Message.pm b/proton-c/bindings/perl/lib/qpid/proton/Message.pm index a46717a..88184ed 100644 --- a/proton-c/bindings/perl/lib/qpid/proton/Message.pm +++ b/proton-c/bindings/perl/lib/qpid/proton/Message.pm @@ -65,7 +65,10 @@ sub get_impl { sub clear { my ($self) = @_; - cproton__perl::pn_message_clear($self->{_impl}); + my $impl = $self->{_impl}; + + cproton_perl::pn_message_clear($impl); + $self->{_body} = undef; $self->{_properties} = {}; $self->{_instructions} = {}; http://git-wip-us.apache.org/repos/asf/qpid-proton/blob/3b200074/proton-c/bindings/perl/lib/qpid/proton/Messenger.pm ---------------------------------------------------------------------- diff --git a/proton-c/bindings/perl/lib/qpid/proton/Messenger.pm b/proton-c/bindings/perl/lib/qpid/proton/Messenger.pm index cc1a1f0..c60bfb6 100644 --- a/proton-c/bindings/perl/lib/qpid/proton/Messenger.pm +++ b/proton-c/bindings/perl/lib/qpid/proton/Messenger.pm @@ -92,7 +92,10 @@ sub get_incoming_window { sub get_error { my ($self) = @_; - return cproton_perl::pn_error_text(cproton_perl::pn_messenger_error($self->{_impl})); + my $impl = $self->{_impl}; + my $text = cproton_perl::pn_error_text(cproton_perl::pn_messenger_error($impl)); + + return $text || ""; } sub get_errno { @@ -110,6 +113,13 @@ sub stop { qpid::proton::check_for_error(cproton_perl::pn_messenger_stop($self->{_impl}), $self); } +sub stopped { + my ($self) = @_; + my $impl = $self->{_impl}; + + return cproton_perl::pn_messenger_stopped($impl); +} + sub subscribe { my ($self) = @_; cproton_perl::pn_messenger_subscribe($self->{_impl}, $_[1]); @@ -203,20 +213,56 @@ sub get { sub get_incoming_tracker { my ($self) = @_; my $impl = $self->{_impl}; + my $result = undef; my $tracker = cproton_perl::pn_messenger_incoming_tracker($impl); if ($tracker != -1) { - return qpid::proton::Tracker->new($tracker); - } else { - return undef; + $result = new qpid::proton::Tracker($tracker); } + + return $result; } sub receive { my ($self) = @_; - my $n = $_[1]; - $n = -1 if !defined $n; - qpid::proton::check_for_error(cproton_perl::pn_messenger_recv($self->{_impl}, $n), $self); + my $impl = $self->{_impl}; + my $n = $_[1] || -1; + + qpid::proton::check_for_error(cproton_perl::pn_messenger_recv($impl, $n), $self); +} + +sub set_blocking { + my ($self) = @_; + my $impl = $self->{_impl}; + my $blocking = int($_[1] || 0); + + qpid::proton::check_for_error(cproton_perl::pn_messenger_set_blocking($impl, $blocking)); +} + +sub get_blocking { + my ($self) = @_; + my $impl = $self->{_impl}; + + return cproton_perl::pn_messenger_is_blocking($impl); +} + +sub work { + my ($self) = @_; + my $impl = $self->{_impl}; + my $timeout = $_[1]; + + if (!defined($timeout)) { + $timeout = -1; + } else { + $timeout = int($timeout * 1000); + } + my $err = cproton_perl::pn_messenger_work($impl, $timeout); + if ($err == qpid::proton::Errors::TIMEOUT) { + return 0; + } else { + qpid::proton::check_for_error($err); + return 1; + } } sub interrupt { @@ -260,7 +306,10 @@ sub accept { if (!defined $tracker) { $tracker = cproton_perl::pn_messenger_incoming_tracker($self->{_impl}); $flags = $cproton_perl::PN_CUMULATIVE; + } else { + $tracker = $tracker->get_impl; } + qpid::proton::check_for_error(cproton_perl::pn_messenger_accept($self->{_impl}, $tracker, $flags), $self); } @@ -277,8 +326,28 @@ sub reject { sub status { my ($self) = @_; + my $impl = $self->{_impl}; + my $tracker = $_[1]; + + if (!defined($tracker)) { + $tracker = $self->get_incoming_tracker(); + } + + return cproton_perl::pn_messenger_status($impl, $tracker->get_impl); +} + +sub settle { + my ($self) = @_; + my $impl = $self->{_impl}; my $tracker = $_[1]; - return cproton_perl::pn_messenger_status($self->{_impl}, $tracker); + my $flag = 0; + + if (!defined($tracker)) { + $tracker = $self->get_incoming_tracker(); + $flag = $cproton_perl::PN_CUMULATIVE; + } + + cproton_perl::pn_messenger_settle($impl, $tracker->get_impl, $flag); } 1; http://git-wip-us.apache.org/repos/asf/qpid-proton/blob/3b200074/proton-c/bindings/perl/lib/qpid/proton/Tracker.pm ---------------------------------------------------------------------- diff --git a/proton-c/bindings/perl/lib/qpid/proton/Tracker.pm b/proton-c/bindings/perl/lib/qpid/proton/Tracker.pm index 38b1cdf..82046e7 100644 --- a/proton-c/bindings/perl/lib/qpid/proton/Tracker.pm +++ b/proton-c/bindings/perl/lib/qpid/proton/Tracker.pm @@ -17,10 +17,6 @@ # under the License. # -use strict; -use warnings; -use cproton_perl; - package qpid::proton::Tracker; sub new { @@ -30,13 +26,13 @@ sub new { $self->{_impl} = $_[1]; bless $self, $class; + return $self; } sub get_impl { my ($self) = @_; - return $self->{_impl}; } http://git-wip-us.apache.org/repos/asf/qpid-proton/blob/3b200074/proton-c/bindings/perl/lib/qpid_proton.pm ---------------------------------------------------------------------- diff --git a/proton-c/bindings/perl/lib/qpid_proton.pm b/proton-c/bindings/perl/lib/qpid_proton.pm index cbee98d..7e43218 100644 --- a/proton-c/bindings/perl/lib/qpid_proton.pm +++ b/proton-c/bindings/perl/lib/qpid_proton.pm @@ -21,6 +21,8 @@ use strict; use warnings; use cproton_perl; +use qpid::proton; + use qpid::proton::utils; use qpid::proton::ExceptionHandling; use qpid::proton::Data; @@ -30,9 +32,6 @@ use qpid::proton::Tracker; use qpid::proton::Messenger; use qpid::proton::Message; -use qpid::proton; -use qpid::proton::utils; - package qpid_proton; 1; http://git-wip-us.apache.org/repos/asf/qpid-proton/blob/3b200074/proton-c/bindings/perl/perl.i ---------------------------------------------------------------------- diff --git a/proton-c/bindings/perl/perl.i b/proton-c/bindings/perl/perl.i index 26ca9d5..e06980a 100644 --- a/proton-c/bindings/perl/perl.i +++ b/proton-c/bindings/perl/perl.i @@ -13,6 +13,39 @@ %include <cstring.i> +%typemap(in) bool +{ + if(!$input) + { + $1 = false; + } + else if((IV)$input == 0) + { + $1 = false; + } + else + { + $1 = true; + } +} + +%typemap(out) bool +{ + SV* obj = sv_newmortal(); + + if($1) + { + sv_setiv(obj, (IV)1); + } + else + { + sv_setsv(obj, &PL_sv_undef); + } + + $result = obj; + argvi++; +} + %typemap(in) pn_atom_t { if(!$input) --------------------------------------------------------------------- To unsubscribe, e-mail: [email protected] For additional commands, e-mail: [email protected]
