You are viewing a plain text version of this content. The canonical link for it is here.
Posted to commits@qpid.apache.org by mc...@apache.org on 2014/12/18 14:17:13 UTC
[1/4] qpid-proton git commit: PROTON-471: Add Messenger->work to Perl
bindings
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 <mc...@gmail.com>
Authored: Wed Jan 8 09:53:47 2014 -0500
Committer: Darryl L. Pierce <mc...@gmail.com>
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: commits-unsubscribe@qpid.apache.org
For additional commands, e-mail: commits-help@qpid.apache.org
[2/4] qpid-proton git commit: PROTON-471: Example for Messenger->Work
in Perl.
Posted by mc...@apache.org.
PROTON-471: Example for Messenger->Work in Perl.
Project: http://git-wip-us.apache.org/repos/asf/qpid-proton/repo
Commit: http://git-wip-us.apache.org/repos/asf/qpid-proton/commit/9186cb6b
Tree: http://git-wip-us.apache.org/repos/asf/qpid-proton/tree/9186cb6b
Diff: http://git-wip-us.apache.org/repos/asf/qpid-proton/diff/9186cb6b
Branch: refs/heads/master
Commit: 9186cb6bd3f3b7a1b17d9fe9c1fd28eb83073322
Parents: 3b20007
Author: Darryl L. Pierce <mc...@gmail.com>
Authored: Fri Dec 12 17:15:58 2014 -0500
Committer: Darryl L. Pierce <mc...@gmail.com>
Committed: Thu Dec 18 08:16:45 2014 -0500
----------------------------------------------------------------------
examples/messenger/perl/async.pm | 120 +++++++++++++++++++++++++++++
examples/messenger/perl/recv_async.pl | 84 ++++++++++++++++++++
examples/messenger/perl/send_async.pl | 97 +++++++++++++++++++++++
3 files changed, 301 insertions(+)
----------------------------------------------------------------------
http://git-wip-us.apache.org/repos/asf/qpid-proton/blob/9186cb6b/examples/messenger/perl/async.pm
----------------------------------------------------------------------
diff --git a/examples/messenger/perl/async.pm b/examples/messenger/perl/async.pm
new file mode 100644
index 0000000..5cd350b
--- /dev/null
+++ b/examples/messenger/perl/async.pm
@@ -0,0 +1,120 @@
+#
+# Licensed to the Apache Software Foundation (ASF) under one
+# or more contributor license agreements. See the NOTICE file
+# distributed with this work for additional information
+# regarding copyright ownership. The ASF licenses this file
+# to you under the Apache License, Version 2.0 (the
+# "License"); you may not use this file except in compliance
+# with the License. You may obtain a copy of the License at
+#
+# http://www.apache.org/licenses/LICENSE-2.0
+#
+# Unless required by applicable law or agreed to in writing,
+# software distributed under the License is distributed on an
+# "AS IS" BASIS, WITHOUT WARRANTIES OR CONDITIONS OF ANY
+# KIND, either express or implied. See the License for the
+# specific language governing permissions and limitations
+# under the License.
+#
+
+use qpid_proton;
+
+package async::CallbackAdapter;
+
+sub new {
+ my ($class) = @_;
+ my ($self) = {};
+
+ my $messenger = $_[1];
+
+ $self->{_messenger} = $messenger;
+ $messenger->set_blocking(0);
+ $messenger->set_incoming_window(1024);
+ $messenger->set_outgoing_window(1024);
+
+ my $message = qpid::proton::Message->new();
+ $self->{_message} = $message;
+ $self->{_incoming} = $message;
+ $self->{_tracked} = {};
+
+ bless $self, $class;
+ return $self;
+}
+
+sub run {
+ my ($self) = @_;
+
+ $self->{_running} = 1;
+
+ my $messenger = $self->{_messenger};
+
+ $messenger->start();
+ $self->on_start();
+
+ do {
+ $messenger->work;
+ $self->process_outgoing;
+ $self->process_incoming;
+ } while($self->{_running});
+
+ $messenger->stop();
+
+ while(!$messenger->stopped()) {
+ $messenger->work;
+ $self->process_outgoing;
+ $self->process_incoming;
+ }
+
+ $self->on_stop();
+}
+
+sub stop {
+ my ($self) = @_;
+
+ $self->{_running} = 0;
+}
+
+sub process_outgoing {
+ my ($self) = @_;
+ my $tracked = $self->{_tracked};
+
+ foreach $key (keys %{$tracked}) {
+ my $on_status = $tracked->{$key};
+ if (defined($on_status)) {
+ if (!($on_status eq qpid::proton::Tracker::PENDING)) {
+ $self->$on_status($status);
+ $self->{_messenger}->settle($t);
+ # delete the settled item
+ undef $tracked->{$key};
+ }
+ }
+ }
+}
+
+sub process_incoming {
+ my ($self) = @_;
+ my $messenger = $self->{_messenger};
+
+ while ($messenger->incoming > 0) {
+ my $message = $self->{_message};
+ my $t = $messenger->get($message);
+
+ $self->on_receive($message);
+ $messenger->accept($t);
+ }
+}
+
+sub send {
+ my ($self) = @_;
+ my $messenger = $self->{_messenger};
+ my $tracked = $self->{_tracked};
+ my $message = $_[1];
+ my $on_status = $_[2] || undef;
+
+ my $tracker = $messenger->put($message);
+
+ $tracked->{$tracker} = $on_status if (defined($on_status));
+}
+
+
+1;
http://git-wip-us.apache.org/repos/asf/qpid-proton/blob/9186cb6b/examples/messenger/perl/recv_async.pl
----------------------------------------------------------------------
diff --git a/examples/messenger/perl/recv_async.pl b/examples/messenger/perl/recv_async.pl
new file mode 100755
index 0000000..9a2195a
--- /dev/null
+++ b/examples/messenger/perl/recv_async.pl
@@ -0,0 +1,84 @@
+#
+# Licensed to the Apache Software Foundation (ASF) under one
+# or more contributor license agreements. See the NOTICE file
+# distributed with this work for additional information
+# regarding copyright ownership. The ASF licenses this file
+# to you under the Apache License, Version 2.0 (the
+# "License"); you may not use this file except in compliance
+# with the License. You may obtain a copy of the License at
+#
+# http://www.apache.org/licenses/LICENSE-2.0
+#
+# Unless required by applicable law or agreed to in writing,
+# software distributed under the License is distributed on an
+# "AS IS" BASIS, WITHOUT WARRANTIES OR CONDITIONS OF ANY
+# KIND, either express or implied. See the License for the
+# specific language governing permissions and limitations
+# under the License.
+#
+
+use qpid_proton;
+use async;
+
+package async::Receiver;
+
+@ISA = (async::CallbackAdapter);
+
+sub on_start {
+ my ($self) = @_;
+ my $args = $_[1] || ("amqp://~0.0.0.0");
+ my $messenger = $self->{_messenger};
+
+ foreach $arg ($args) {
+ $messenger->subscribe($arg);
+ }
+
+ $messenger->receive();
+}
+
+sub on_receive {
+ my ($self) = @_;
+ my $msg = $_[1];
+ my $message = $self->{_message};
+ my $text = "";
+
+ if (defined($msg->get_body)) {
+ $text = $msg->get_body;
+ if ($text eq "die") {
+ $self->stop;
+ }
+ } else {
+ $text = $message->get_subject;
+ }
+
+ $text = "" if (!defined($text));
+
+ print "Received: $text\n";
+
+ if ($msg->get_reply_to) {
+ print "Sending reply to: " . $msg->get_reply_to . "\n";
+ $message->clear;
+ $message->set_address($msg->get_reply_to());
+ $message->set_body("Reply for ", $msg->get_body);
+ $self->send($message);
+ }
+}
+
+sub on_status {
+ my ($self) = @_;
+ my $messenger = $self->{_messenger};
+ my $status = $_[1];
+
+ print "Status: ", $status, "\n";
+}
+
+sub on_stop {
+ print "Stopped.\n"
+}
+
+package main;
+
+our $messenger = new qpid::proton::Messenger();
+our $app = new async::Receiver($messenger);
+
+$app->run();
http://git-wip-us.apache.org/repos/asf/qpid-proton/blob/9186cb6b/examples/messenger/perl/send_async.pl
----------------------------------------------------------------------
diff --git a/examples/messenger/perl/send_async.pl b/examples/messenger/perl/send_async.pl
new file mode 100644
index 0000000..2f9408a
--- /dev/null
+++ b/examples/messenger/perl/send_async.pl
@@ -0,0 +1,97 @@
+#
+# Licensed to the Apache Software Foundation (ASF) under one
+# or more contributor license agreements. See the NOTICE file
+# distributed with this work for additional information
+# regarding copyright ownership. The ASF licenses this file
+# to you under the Apache License, Version 2.0 (the
+# "License"); you may not use this file except in compliance
+# with the License. You may obtain a copy of the License at
+#
+# http://www.apache.org/licenses/LICENSE-2.0
+#
+# Unless required by applicable law or agreed to in writing,
+# software distributed under the License is distributed on an
+# "AS IS" BASIS, WITHOUT WARRANTIES OR CONDITIONS OF ANY
+# KIND, either express or implied. See the License for the
+# specific language governing permissions and limitations
+# under the License.
+#
+
+use Getopt::Std;
+use qpid_proton;
+use async;
+
+$Getopt::Std::STANDARD_HELP_VERSION = 1;
+
+sub VERSION_MESSAGE() {}
+
+sub HELP_MESSAGE() {
+ print "Usage: send_async.pl [OPTIONS] <msg_0> <msg_1> ...\n";
+ print "Options:\n";
+ print "\t-a - the message address (def. amqp://0.0.0.0)\n";
+ print "\t-r - the reply-to address: //<domain>[/<name>]\n";
+ print "\t msg_# - a text string to send\n";
+}
+
+my %optons = ();
+getopts("a:r:", \%options) or usage();
+
+our $address = $options{a} || "amqp://0.0.0.0";
+our $replyto = $options{r} || "~/#";
+
+package async::Sender;
+
+@ISA = (async::CallbackAdapter);
+
+sub on_start {
+ my ($self) = @_;
+ my $message = $self->{_message};
+ my $messenger = $self->{_messenger};
+ my $args = $_[1] || ("Hello world!");
+
+ print "Started\n";
+
+ $message->clear;
+ $message->set_address("amqp://0.0.0.0");
+ $message->set_reply_to($replyto) if (defined($replyto));
+
+ foreach $arg ($args) {
+ $message->set_body($arg);
+ if ($replyto) {
+ $message->set_reply_to($replyto);
+ }
+ $self->send($message, "on_status");
+ }
+
+ $messenger->receive() if (defined($replyto));
+}
+
+sub on_status {
+ my ($self) = @_;
+ my $messenger = $self->{_messenger};
+ my $status = $_[1] || "";
+
+ print "Status: ", $status, "\n";
+}
+
+sub on_receive {
+ my ($self) = @_;
+ my $message = $_[1];
+ my $text = $message->get_body || "[empty]";
+
+ print "Received: " . $text . "\n";
+
+ $self->stop();
+}
+
+sub on_stop {
+ print "Stopped\n";
+}
+
+
+package main;
+
+our $msgr = new qpid::proton::Messenger();
+our $app = async::Sender->new($msgr);
+
+$app->run;
---------------------------------------------------------------------
To unsubscribe, e-mail: commits-unsubscribe@qpid.apache.org
For additional commands, e-mail: commits-help@qpid.apache.org
[3/4] qpid-proton git commit: PROTON-471: Reworked how Perl processes
error results from API calls.
Posted by mc...@apache.org.
PROTON-471: Reworked how Perl processes error results from API calls.
It does not die on qpid::proton::Errors::INPROGRESS.
Project: http://git-wip-us.apache.org/repos/asf/qpid-proton/repo
Commit: http://git-wip-us.apache.org/repos/asf/qpid-proton/commit/ad96b59e
Tree: http://git-wip-us.apache.org/repos/asf/qpid-proton/tree/ad96b59e
Diff: http://git-wip-us.apache.org/repos/asf/qpid-proton/diff/ad96b59e
Branch: refs/heads/master
Commit: ad96b59ea1d7a137cdf4a0a3473885d5906dc7c0
Parents: 9186cb6
Author: Darryl L. Pierce <mc...@gmail.com>
Authored: Thu Dec 11 10:37:57 2014 -0500
Committer: Darryl L. Pierce <mc...@gmail.com>
Committed: Thu Dec 18 08:16:45 2014 -0500
----------------------------------------------------------------------
.../perl/lib/qpid/proton/ExceptionHandling.pm | 28 +++++++++++++-------
1 file changed, 19 insertions(+), 9 deletions(-)
----------------------------------------------------------------------
http://git-wip-us.apache.org/repos/asf/qpid-proton/blob/ad96b59e/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 33cf6c0..00cdab1 100644
--- a/proton-c/bindings/perl/lib/qpid/proton/ExceptionHandling.pm
+++ b/proton-c/bindings/perl/lib/qpid/proton/ExceptionHandling.pm
@@ -20,21 +20,31 @@
use strict;
use warnings;
use cproton_perl;
-use Devel::StackTrace;
+use Switch;
+
+use feature qw(switch);
package qpid::proton;
sub check_for_error {
my $rc = $_[0];
- if($rc < 0) {
- my $source = $_[1];
-
- my $trace = Devel::StackTrace->new;
-
- print $trace->as_string;
-
- die "ERROR[$rc] " . $source->get_error() . "\n";
+ switch($rc) {
+ case 'qpid::proton::Errors::NONE' {next;}
+ case 'qpid::proton::Errors::EOS' {next;}
+ case 'qpid::proton::Errors::ERROR' {next;}
+ case 'qpid::proton::Errors::OVERFLOW' {next;}
+ case 'qpid::proton::Errors::UNDERFLOW' {next;}
+ case 'qpid::proton::Errors::STATE' {next;}
+ case 'qpid::proton::Errors::ARGUMENT' {next;}
+ case 'qpid::proton::Errors::TIMEOUT' {next;}
+ case 'qpid::proton::Errors::INTERRUPTED' {
+ my $source = $_[1];
+ my $trace = Devel::StackTrace->new;
+
+ print $trace->as_string;
+ die "ERROR[$rc]" . $source->get_error() . "\n";
+ }
}
}
---------------------------------------------------------------------
To unsubscribe, e-mail: commits-unsubscribe@qpid.apache.org
For additional commands, e-mail: commits-help@qpid.apache.org
[4/4] qpid-proton git commit: PROTON-471: Removed the bool mapping
for arguments in the Perl bindings.
Posted by mc...@apache.org.
PROTON-471: Removed the bool mapping for arguments in the Perl bindings.
Project: http://git-wip-us.apache.org/repos/asf/qpid-proton/repo
Commit: http://git-wip-us.apache.org/repos/asf/qpid-proton/commit/28bbd8bc
Tree: http://git-wip-us.apache.org/repos/asf/qpid-proton/tree/28bbd8bc
Diff: http://git-wip-us.apache.org/repos/asf/qpid-proton/diff/28bbd8bc
Branch: refs/heads/master
Commit: 28bbd8bc699600e8ac5f2f29e3804d9528e7a711
Parents: ad96b59
Author: Darryl L. Pierce <mc...@gmail.com>
Authored: Thu Dec 11 10:39:16 2014 -0500
Committer: Darryl L. Pierce <mc...@gmail.com>
Committed: Thu Dec 18 08:16:46 2014 -0500
----------------------------------------------------------------------
proton-c/bindings/perl/perl.i | 33 ---------------------------------
1 file changed, 33 deletions(-)
----------------------------------------------------------------------
http://git-wip-us.apache.org/repos/asf/qpid-proton/blob/28bbd8bc/proton-c/bindings/perl/perl.i
----------------------------------------------------------------------
diff --git a/proton-c/bindings/perl/perl.i b/proton-c/bindings/perl/perl.i
index e06980a..26ca9d5 100644
--- a/proton-c/bindings/perl/perl.i
+++ b/proton-c/bindings/perl/perl.i
@@ -13,39 +13,6 @@
%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: commits-unsubscribe@qpid.apache.org
For additional commands, e-mail: commits-help@qpid.apache.org