Author: gsim
Date: Fri Oct 10 12:38:26 2014
New Revision: 1630783
URL: http://svn.apache.org/r1630783
Log:
PROTON-582: Perl Message can infer the type of the content provided.
The qpid::proton::Message->set_body() method can take either a single
argument (the body) or two arguments (the body and an explicit type).
Previous, if the second argument wasn't provided, the code assumed it
was a qpid::message::STRING type.
Now, the code will attempt to determine the type of the argument. It can
successfully infer a hash, array, int and string. It will default to a
string if it cannot otherwise determine the type.
Modified:
qpid/proton/branches/examples/examples/messenger/perl/recv.pl
qpid/proton/branches/examples/examples/messenger/perl/send.pl
qpid/proton/branches/examples/proton-c/bindings/perl/lib/qpid/proton/Data.pm
qpid/proton/branches/examples/proton-c/bindings/perl/lib/qpid/proton/Message.pm
qpid/proton/branches/examples/proton-c/bindings/perl/lib/qpid_proton.pm
Modified: qpid/proton/branches/examples/examples/messenger/perl/recv.pl
URL:
http://svn.apache.org/viewvc/qpid/proton/branches/examples/examples/messenger/perl/recv.pl?rev=1630783&r1=1630782&r2=1630783&view=diff
==============================================================================
--- qpid/proton/branches/examples/examples/messenger/perl/recv.pl (original)
+++ qpid/proton/branches/examples/examples/messenger/perl/recv.pl Fri Oct 10
12:38:26 2014
@@ -51,21 +51,28 @@ for(;;)
{
$messenger->get($msg);
+ print "\n";
print "Address: " . $msg->get_address() . "\n";
print "Subject: " . $msg->get_subject() . "\n" unless
!defined($msg->get_subject());
print "Body: ";
my $body = $msg->get_body();
- my $body_type = reftype($body);
+ my $body_type = $msg->get_body_type();
if (!defined($body_type)) {
- print "$body\n";
- } elsif ($body_type eq HASH) {
+ print "The body type wasn't defined!\n";
+ } elsif ($body_type == qpid::proton::MAP) {
print "[HASH]\n";
print Dumper(\%{$body}) . "\n";
- } elsif ($body_type eq ARRAY) {
+ } elsif ($body_type == qpid::proton::ARRAY) {
print "[ARRAY]\n";
print Data::Dumper->Dump($body) . "\n";
+ } elsif ($body_type == qpid::proton::LIST) {
+ print "[LIST]\n";
+ print Data::Dumper->Dump($body) . "\n";
+ } else {
+ print "[$body_type]\n";
+ print "$body\n";
}
print "Properties:\n";
Modified: qpid/proton/branches/examples/examples/messenger/perl/send.pl
URL:
http://svn.apache.org/viewvc/qpid/proton/branches/examples/examples/messenger/perl/send.pl?rev=1630783&r1=1630782&r2=1630783&view=diff
==============================================================================
--- qpid/proton/branches/examples/examples/messenger/perl/send.pl (original)
+++ qpid/proton/branches/examples/examples/messenger/perl/send.pl Fri Oct 10
12:38:26 2014
@@ -61,7 +61,7 @@ foreach (@messages)
$msg->set_subject($subject);
$msg->set_content($content);
# try a few different body types
- my $body_type = int(rand(4));
+ my $body_type = int(rand(6));
$msg->set_property("sent", "" . localtime(time));
$msg->get_instructions->{"fold"} = "yes";
$msg->get_instructions->{"spindle"} = "no";
@@ -71,12 +71,15 @@ foreach (@messages)
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 == 1 && do { $msg->set_body(rand(65536)); };
$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); };
+ $body_type == 3 && do { $msg->set_body({"foo" => "bar"}); };
+ $body_type == 4 && do { $msg->set_body([4, [1, 2, 3.1, 3.4E-5], 8, 15,
16, 23, 42]); };
+ $body_type == 5 && do { $msg->set_body(int(rand(65535))); }
}
$messenger->put($msg);
+ print "Sent: " . $msg->get_body . " [CONTENT TYPE: " . $msg->get_body_type
. "]\n";
}
$messenger->send();
Modified:
qpid/proton/branches/examples/proton-c/bindings/perl/lib/qpid/proton/Data.pm
URL:
http://svn.apache.org/viewvc/qpid/proton/branches/examples/proton-c/bindings/perl/lib/qpid/proton/Data.pm?rev=1630783&r1=1630782&r2=1630783&view=diff
==============================================================================
---
qpid/proton/branches/examples/proton-c/bindings/perl/lib/qpid/proton/Data.pm
(original)
+++
qpid/proton/branches/examples/proton-c/bindings/perl/lib/qpid/proton/Data.pm
Fri Oct 10 12:38:26 2014
@@ -1166,16 +1166,23 @@ sub put_list_helper {
$self->put_list;
$self->enter;
- foreach(@{$array}) {
- my $value = $_;
- my $valtype = ::reftype($value);
-
- if ($valtype eq ARRAY) {
- $self->put_list_helper($value);
- } elsif ($valtype eq HASH) {
+ for my $value (@{$array}) {
+ if (qpid::proton::is_num($value)) {
+ if (qpid::proton::is_float($value)) {
+ $self->put_float($value);
+ } else {
+ $self->put_int($value);
+ }
+ } elsif (!defined($value)) {
+ $self->put_null;
+ } elsif ($value eq '') {
+ $self->put_string($value);
+ } elsif (ref($value) eq 'HASH') {
$self->put_map_helper($value);
+ } elsif (ref($value) eq 'ARRAY') {
+ $self->put_list_helper($value);
} else {
- $self->put_string("$value");
+ $self->put_string($value);
}
}
@@ -1194,7 +1201,8 @@ sub get_list_helper {
for(my $count = 0; $count < $size; $count++) {
if ($self->next) {
- my $value = $self->get_type->get($self);
+ my $value_type = $self->get_type;
+ my $value = $value_type->get($self);
push(@{$result}, $value);
}
Modified:
qpid/proton/branches/examples/proton-c/bindings/perl/lib/qpid/proton/Message.pm
URL:
http://svn.apache.org/viewvc/qpid/proton/branches/examples/proton-c/bindings/perl/lib/qpid/proton/Message.pm?rev=1630783&r1=1630782&r2=1630783&view=diff
==============================================================================
---
qpid/proton/branches/examples/proton-c/bindings/perl/lib/qpid/proton/Message.pm
(original)
+++
qpid/proton/branches/examples/proton-c/bindings/perl/lib/qpid/proton/Message.pm
Fri Oct 10 12:38:26 2014
@@ -443,7 +443,29 @@ B<qpid::proton::STRING>.
sub set_body {
my ($self) = @_;
my $body = $_[1];
- my $body_type = $_[2] || qpid::proton::STRING;
+ my $body_type = $_[2] || undef;
+
+ # if no body type was defined, then attempt to infer what it should
+ # be, which is going to be a best guess
+ if (!defined($body_type)) {
+ if (qpid::proton::is_num($body)) {
+ if (qpid::proton::is_float($body)) {
+ $body_type = qpid::proton::FLOAT;
+ } else {
+ $body_type = qpid::proton::INT;
+ }
+ } elsif (!defined($body)) {
+ $body_type = qpid::proton::NULL;
+ } elsif ($body eq '') {
+ $body_type = qpid::proton::STRING;
+ } elsif (ref($body) eq 'HASH') {
+ $body_type = qpid::proton::MAP;
+ } elsif (ref($body) eq 'ARRAY') {
+ $body_type = qpid::proton::LIST;
+ } else {
+ $body_type = qpid::proton::STRING;
+ }
+ }
$self->{_body} = $body;
$self->{_body_type} = $body_type;
Modified:
qpid/proton/branches/examples/proton-c/bindings/perl/lib/qpid_proton.pm
URL:
http://svn.apache.org/viewvc/qpid/proton/branches/examples/proton-c/bindings/perl/lib/qpid_proton.pm?rev=1630783&r1=1630782&r2=1630783&view=diff
==============================================================================
--- qpid/proton/branches/examples/proton-c/bindings/perl/lib/qpid_proton.pm
(original)
+++ qpid/proton/branches/examples/proton-c/bindings/perl/lib/qpid_proton.pm Fri
Oct 10 12:38:26 2014
@@ -21,6 +21,7 @@ use strict;
use warnings;
use cproton_perl;
+use qpid::proton::utils;
use qpid::proton::ExceptionHandling;
use qpid::proton::Data;
use qpid::proton::Mapping;
---------------------------------------------------------------------
To unsubscribe, e-mail: commits-unsubscr...@qpid.apache.org
For additional commands, e-mail: commits-h...@qpid.apache.org
