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