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/05/16 22:30:35 UTC
svn commit: r1595338 - in /qpid/proton/trunk: examples/messenger/perl/recv.pl
proton-c/bindings/perl/lib/qpid/proton/Constants.pm
proton-c/bindings/perl/lib/qpid/proton/Data.pm
Author: mcpierce
Date: Fri May 16 20:30:35 2014
New Revision: 1595338
URL: http://svn.apache.org/r1595338
Log:
PROTON-580: Perl Data can handle complex array and hash types
Added the get_list_helper and put_list_helper methods to correctly
marshal arrays between a Data instance and Perl.
Updated the recv.pl example to properly display the body of a message
received.
Modified:
qpid/proton/trunk/examples/messenger/perl/recv.pl
qpid/proton/trunk/proton-c/bindings/perl/lib/qpid/proton/Constants.pm
qpid/proton/trunk/proton-c/bindings/perl/lib/qpid/proton/Data.pm
Modified: qpid/proton/trunk/examples/messenger/perl/recv.pl
URL: http://svn.apache.org/viewvc/qpid/proton/trunk/examples/messenger/perl/recv.pl?rev=1595338&r1=1595337&r2=1595338&view=diff
==============================================================================
--- qpid/proton/trunk/examples/messenger/perl/recv.pl (original)
+++ qpid/proton/trunk/examples/messenger/perl/recv.pl Fri May 16 20:30:35 2014
@@ -18,9 +18,11 @@
# under the License.
#
-use strict;
use warnings;
+use Scalar::Util qw(reftype);
+use Data::Dumper;
+
use qpid_proton;
sub usage {
@@ -48,10 +50,24 @@ for(;;)
while ($messenger->incoming() > 0)
{
$messenger->get($msg);
+
print "Address: " . $msg->get_address() . "\n";
print "Subject: " . $msg->get_subject() . "\n";
- print "Content: " . $msg->get_content() . "\n";
- print "Body: " . $msg->get_body() . "\n";
+ print "Body: ";
+
+ my $body = $msg->get_body();
+ my $body_type = reftype($body);
+
+ if (!defined($body_type)) {
+ print "$body\n";
+ } elsif ($body_type eq HASH) {
+ print "[HASH]\n";
+ print Dumper(\%{$body}) . "\n";
+ } elsif ($body_type eq ARRAY) {
+ print "[ARRAY]\n";
+ print Data::Dumper->Dump($body) . "\n";
+ }
+
print "Properties:\n";
my $props = $msg->get_properties();
foreach (keys $props) {
Modified: qpid/proton/trunk/proton-c/bindings/perl/lib/qpid/proton/Constants.pm
URL: http://svn.apache.org/viewvc/qpid/proton/trunk/proton-c/bindings/perl/lib/qpid/proton/Constants.pm?rev=1595338&r1=1595337&r2=1595338&view=diff
==============================================================================
--- qpid/proton/trunk/proton-c/bindings/perl/lib/qpid/proton/Constants.pm (original)
+++ qpid/proton/trunk/proton-c/bindings/perl/lib/qpid/proton/Constants.pm Fri May 16 20:30:35 2014
@@ -129,8 +129,8 @@ use constant {
LIST => qpid::proton::Mapping->new(
"list",
$cproton_perl::PN_LIST,
- "put_list",
- "get_list"),
+ "put_list_helper",
+ "get_list_helper"),
MAP => qpid::proton::Mapping->new(
"map",
$cproton_perl::PN_MAP,
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=1595338&r1=1595337&r2=1595338&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 Fri May 16 20:30:35 2014
@@ -17,7 +17,7 @@
# under the License.
#
-use Scalar::Util qw(looks_like_number);
+use Scalar::Util qw(reftype looks_like_number);
=pod
@@ -1159,16 +1159,82 @@ sub get_map {
cproton_perl::pn_data_get_map($impl);
}
+sub put_list_helper {
+ my ($self) = @_;
+ my ($array) = $_[1];
+
+ $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) {
+ $self->put_map_helper($value);
+ } else {
+ $self->put_string("$value");
+ }
+ }
+
+ $self->exit;
+}
+
+sub get_list_helper {
+ my ($self) = @_;
+ my $result = [];
+ my $type = $self->get_type;
+
+ if ($cproton_perl::PN_LIST == $type->get_type_value) {
+ my $size = $self->get_list;
+
+ $self->enter;
+
+ for(my $count = 0; $count < $size; $count++) {
+ if ($self->next) {
+ my $value = $self->get_type->get($self);
+
+ push($result, $value);
+ }
+ }
+
+ $self->exit;
+ }
+
+ return $result;
+}
+
sub put_map_helper {
my ($self) = @_;
- my ($hash) = $_[1];
+ my $hash = $_[1];
$self->put_map;
$self->enter;
foreach(keys $hash) {
- $self->put_string("$_");
- $self->put_string("$hash->{$_}");
+ my $key = $_;
+ my $value = $hash->{$key};
+
+ my $keytype = ::reftype($key);
+ my $valtype = ::reftype($value);
+
+ if ($keytype eq ARRAY) {
+ $self->put_list_helper($key);
+ } elsif ($keytype eq "HASH") {
+ $self->put_map_helper($key);
+ } else {
+ $self->put_string("$key");
+ }
+
+ if (::reftype($value) eq HASH) {
+ $self->put_map_helper($value);
+ } elsif (::reftype($value) eq ARRAY) {
+ $self->put_list_helper($value);
+ } else {
+ $self->put_string("$value");
+ }
}
$self->exit;
@@ -1193,9 +1259,10 @@ sub get_map_helper {
}
}
}
- }
- $self->exit;
+ $self->exit;
+
+ }
return $result;
}
---------------------------------------------------------------------
To unsubscribe, e-mail: commits-unsubscribe@qpid.apache.org
For additional commands, e-mail: commits-help@qpid.apache.org