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 2013/09/04 21:06:53 UTC
svn commit: r1520109 - in /qpid/proton/trunk: examples/messenger/perl/
proton-c/bindings/perl/lib/qpid/proton/ proton-c/bindings/perl/tests/
Author: mcpierce
Date: Wed Sep 4 19:06:52 2013
New Revision: 1520109
URL: http://svn.apache.org/r1520109
Log:
PROTON-385: Added the body property to Perl Message class.
Added the preencode and postdecode methods to Message, with appropriate
calls from Messenger, to encode and decode the body itself.
The send.pl and recv.pl examples now use the body type, with send.pl
sending random values as an example for using the body field.
Modified:
qpid/proton/trunk/examples/messenger/perl/recv.pl
qpid/proton/trunk/examples/messenger/perl/send.pl
qpid/proton/trunk/proton-c/bindings/perl/lib/qpid/proton/Data.pm
qpid/proton/trunk/proton-c/bindings/perl/lib/qpid/proton/Message.pm
qpid/proton/trunk/proton-c/bindings/perl/lib/qpid/proton/Messenger.pm
qpid/proton/trunk/proton-c/bindings/perl/tests/message.t
Modified: qpid/proton/trunk/examples/messenger/perl/recv.pl
URL: http://svn.apache.org/viewvc/qpid/proton/trunk/examples/messenger/perl/recv.pl?rev=1520109&r1=1520108&r2=1520109&view=diff
==============================================================================
--- qpid/proton/trunk/examples/messenger/perl/recv.pl (original)
+++ qpid/proton/trunk/examples/messenger/perl/recv.pl Wed Sep 4 19:06:52 2013
@@ -51,6 +51,7 @@ for(;;)
print "Address: " . $msg->get_address() . "\n";
print "Subject: " . $msg->get_subject() . "\n";
print "Content: " . $msg->get_content() . "\n";
+ print "Body: " . $msg->get_body() . "\n";
}
}
Modified: qpid/proton/trunk/examples/messenger/perl/send.pl
URL: http://svn.apache.org/viewvc/qpid/proton/trunk/examples/messenger/perl/send.pl?rev=1520109&r1=1520108&r2=1520109&view=diff
==============================================================================
--- qpid/proton/trunk/examples/messenger/perl/send.pl (original)
+++ qpid/proton/trunk/examples/messenger/perl/send.pl Wed Sep 4 19:06:52 2013
@@ -48,6 +48,15 @@ foreach (@messages)
{
$msg->set_address($address);
$msg->set_content($_);
+ # try a few different body types
+ my $body_type = int(rand(4));
+ SWITCH: {
+ $body_type == 0 && do { $msg->set_body("It is now " . localtime(time));};
+ $body_type == 1 && do { $msg->set_body(rand(65536), qpid::proton::FLOAT); };
+ $body_type == 2 && do { $msg->set_body(int(rand(2)), qpid::proton::BOOL); };
+ $body_type == 3 && do { $msg->set_body({"foo" => "bar"}, qpid::proton::MAP); };
+ }
+
$messenger->put($msg);
}
Modified: qpid/proton/trunk/proton-c/bindings/perl/lib/qpid/proton/Data.pm
URL: http://svn.apache.org/viewvc/qpid/proton/trunk/proton-c/bindings/perl/lib/qpid/proton/Data.pm?rev=1520109&r1=1520108&r2=1520109&view=diff
==============================================================================
--- qpid/proton/trunk/proton-c/bindings/perl/lib/qpid/proton/Data.pm (original)
+++ qpid/proton/trunk/proton-c/bindings/perl/lib/qpid/proton/Data.pm Wed Sep 4 19:06:52 2013
@@ -17,6 +17,8 @@
# under the License.
#
+use Scalar::Util qw(looks_like_number);
+
=pod
=head1 NAME
@@ -68,8 +70,16 @@ sub new {
my ($class) = @_;
my ($self) = {};
my $capacity = $_[1] || 16;
+ my $impl = $capacity;
+ $self->{_free} = 0;
+
+ if($capacity) {
+ if (::looks_like_number($capacity)) {
+ $impl = cproton_perl::pn_data($capacity);
+ $self->{_free} = 1;
+ }
+ }
- my $impl = cproton_perl::pn_data($capacity);
$self->{_impl} = $impl;
bless $self, $class;
@@ -80,9 +90,31 @@ sub DESTROY {
my ($self) = @_;
my $impl = $self->{_impl};
- cproton_perl::pn_data_free($impl);
+ cproton_perl::pn_data_free($impl) if $self->{_free};
+}
+
+=pod
+
+=head1 ACTIONS
+
+Clear all content for the data object.
+
+=over
+
+=item my $data->clear();
+
+=back
+
+=cut
+
+sub clear {
+ my ($self) = @_;
+ my $impl = $self->{_impl};
+
+ cproton_perl::pn_data_clear($impl);
}
+
=pod
=head1 NAVIGATION
@@ -177,16 +209,14 @@ sub next {
my ($self) = @_;
my $impl = $self->{_impl};
- my $type = cproton_perl::pn_data_next($impl);
- return qpid::proton::Mapping->find_by_type_value($type);
+ return cproton_perl::pn_data_next($impl);
}
sub prev {
my ($self) = @_;
my $impl = $self->{_impl};
- my $type = cproton_perl::pn_data_prev($impl);
- return qpid::proton::Mapping->find_by_type_value($type);
+ return cproton_perl::pn_data_prev($impl);
}
Modified: qpid/proton/trunk/proton-c/bindings/perl/lib/qpid/proton/Message.pm
URL: http://svn.apache.org/viewvc/qpid/proton/trunk/proton-c/bindings/perl/lib/qpid/proton/Message.pm?rev=1520109&r1=1520108&r2=1520109&view=diff
==============================================================================
--- qpid/proton/trunk/proton-c/bindings/perl/lib/qpid/proton/Message.pm (original)
+++ qpid/proton/trunk/proton-c/bindings/perl/lib/qpid/proton/Message.pm Wed Sep 4 19:06:52 2013
@@ -30,6 +30,8 @@ sub new {
my $impl = cproton_perl::pn_message();
$self->{_impl} = $impl;
+ $self->{_body} = undef;
+ $self->{_body_type} = undef;
bless $self, $class;
return $self;
@@ -54,7 +56,8 @@ sub DESTROY {
sub get_impl {
my ($self) = @_;
- return $self->{_impl};
+ my $impl = $self->{_impl};
+ return $impl;
}
sub clear {
@@ -312,5 +315,71 @@ sub get_reply_to_group_id {
return cproton_perl::pn_message_get_reply_to_group_id($self->{_impl});
}
+=pod
+
+=head2 BODY
+
+The body of the message. When setting the body value a type must be specified,
+such as I<qpid::proton::INT>. If unspecified, the body type will default to
+B<qpid::proton::STRING>.
+
+=over
+
+=item $msg->set_body( [VALUE], [TYPE] );
+
+=item $msg->get_body();
+
+=item $msg->get_body_type();
+
+=back
+
+=cut
+
+sub set_body {
+ my ($self) = @_;
+ my $body = $_[1];
+ my $body_type = $_[2] || qpid::proton::STRING;
+
+ $self->{_body} = $body;
+ $self->{_body_type} = $body_type;
+}
+
+sub get_body {
+ my ($self) = @_;
+ my $body = $self->{_body};
+
+ return $body;
+}
+
+sub get_body_type {
+ my ($self) = @_;
+
+ return $self->{_body_type};
+}
+
+sub preencode() {
+ my ($self) = @_;
+ my $impl = $self->{_impl};
+ my $my_body = $self->{_body};
+ my $body_type = $self->{_body_type};
+
+ my $body = new qpid::proton::Data(cproton_perl::pn_message_body($impl));
+ $body->clear();
+ $body_type->put($body, $my_body) if($my_body && $body_type);
+}
+
+sub postdecode() {
+ my ($self) = @_;
+ my $impl = $self->{_impl};
+
+ $self->{_body} = undef;
+ $self->{_body_type} = undef;
+ my $body = new qpid::proton::Data(cproton_perl::pn_message_body($impl));
+ if ($body->next()) {
+ $self->{_body_type} = $body->get_type();
+ $self->{_body} = $body->get_type()->get($body);
+ }
+}
+
1;
Modified: qpid/proton/trunk/proton-c/bindings/perl/lib/qpid/proton/Messenger.pm
URL: http://svn.apache.org/viewvc/qpid/proton/trunk/proton-c/bindings/perl/lib/qpid/proton/Messenger.pm?rev=1520109&r1=1520108&r2=1520109&view=diff
==============================================================================
--- qpid/proton/trunk/proton-c/bindings/perl/lib/qpid/proton/Messenger.pm (original)
+++ qpid/proton/trunk/proton-c/bindings/perl/lib/qpid/proton/Messenger.pm Wed Sep 4 19:06:52 2013
@@ -161,7 +161,9 @@ sub put {
my $impl = $self->{_impl};
my $message = $_[1];
- cproton_perl::pn_messenger_put($impl, $message->get_impl);
+ $message->preencode();
+ my $msgimpl = $message->get_impl();
+ cproton_perl::pn_messenger_put($impl, $msgimpl);
return cproton_perl::pn_messenger_outgoing_tracker($impl);
}
@@ -179,6 +181,7 @@ sub get {
my $message = $_[1] || new proton::Message();
cproton_perl::pn_messenger_get($impl, $message->get_impl());
+ $message->postdecode();
return cproton_perl::pn_messenger_incoming_tracker($impl);
}
Modified: qpid/proton/trunk/proton-c/bindings/perl/tests/message.t
URL: http://svn.apache.org/viewvc/qpid/proton/trunk/proton-c/bindings/perl/tests/message.t?rev=1520109&r1=1520108&r2=1520109&view=diff
==============================================================================
--- qpid/proton/trunk/proton-c/bindings/perl/tests/message.t (original)
+++ qpid/proton/trunk/proton-c/bindings/perl/tests/message.t Wed Sep 4 19:06:52 2013
@@ -251,4 +251,3 @@ ok(!$message->get_content(), 'Content ca
$message->set_content($content);
ok($message->get_content() eq $content,
'Content was saved correctly');
-
---------------------------------------------------------------------
To unsubscribe, e-mail: commits-unsubscribe@qpid.apache.org
For additional commands, e-mail: commits-help@qpid.apache.org