Author: mcpierce
Date: Thu Sep 5 19:20:12 2013
New Revision: 1520389
URL: http://svn.apache.org/r1520389
Log:
PROTON-382: Added properties field to the Perl Message class.
Added the set_property and get_property methods to assign and fetch
individual values. Added unit test for validating the APIs.
Modified:
qpid/proton/trunk/examples/messenger/perl/recv.pl
qpid/proton/trunk/examples/messenger/perl/send.pl
qpid/proton/trunk/proton-c/bindings/perl/ChangeLog
qpid/proton/trunk/proton-c/bindings/perl/lib/qpid/proton/Constants.pm
qpid/proton/trunk/proton-c/bindings/perl/lib/qpid/proton/Data.pm
qpid/proton/trunk/proton-c/bindings/perl/lib/qpid/proton/Mapping.pm
qpid/proton/trunk/proton-c/bindings/perl/lib/qpid/proton/Message.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=1520389&r1=1520388&r2=1520389&view=diff
==============================================================================
--- qpid/proton/trunk/examples/messenger/perl/recv.pl (original)
+++ qpid/proton/trunk/examples/messenger/perl/recv.pl Thu Sep 5 19:20:12 2013
@@ -52,6 +52,11 @@ for(;;)
print "Subject: " . $msg->get_subject() . "\n";
print "Content: " . $msg->get_content() . "\n";
print "Body: " . $msg->get_body() . "\n";
+ print "Properties:\n";
+ my $props = $msg->get_properties();
+ foreach (keys $props) {
+ print "\t$_=$props->{$_}\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=1520389&r1=1520388&r2=1520389&view=diff
==============================================================================
--- qpid/proton/trunk/examples/messenger/perl/send.pl (original)
+++ qpid/proton/trunk/examples/messenger/perl/send.pl Thu Sep 5 19:20:12 2013
@@ -50,6 +50,7 @@ foreach (@messages)
$msg->set_content($_);
# try a few different body types
my $body_type = int(rand(4));
+ $msg->set_property("sent", "" . localtime(time));
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); };
Modified: qpid/proton/trunk/proton-c/bindings/perl/ChangeLog
URL:
http://svn.apache.org/viewvc/qpid/proton/trunk/proton-c/bindings/perl/ChangeLog?rev=1520389&r1=1520388&r2=1520389&view=diff
==============================================================================
--- qpid/proton/trunk/proton-c/bindings/perl/ChangeLog (original)
+++ qpid/proton/trunk/proton-c/bindings/perl/ChangeLog Thu Sep 5 19:20:12 2013
@@ -2,6 +2,7 @@ version 0.6:
* qpid::proton::Messenger returns incoming trackers on get.
* qpid::proton::Messenger returns outgoing tracker on put.
* qpid::proton::Message exposes the body property.
+ * qpid::proton::Message exposes the properties property.
version 0.5:
* Added the qpid::proton::Data type.
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=1520389&r1=1520388&r2=1520389&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 Thu
Sep 5 19:20:12 2013
@@ -134,8 +134,8 @@ use constant {
MAP => qpid::proton::Mapping->new(
"map",
$cproton_perl::PN_MAP,
- "put_map",
- "get_map"),
+ "put_map_helper",
+ "get_map_helper"),
};
1;
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=1520389&r1=1520388&r2=1520389&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 Thu Sep 5
19:20:12 2013
@@ -1159,4 +1159,45 @@ sub get_map {
cproton_perl::pn_data_get_map($impl);
}
+sub put_map_helper {
+ my ($self) = @_;
+ my ($hash) = $_[1];
+
+ $self->put_map;
+ $self->enter;
+
+ foreach(keys $hash) {
+ $self->put_string("$_");
+ $self->put_string("$hash->{$_}");
+ }
+
+ $self->exit;
+}
+
+sub get_map_helper {
+ my ($self) = @_;
+ my $result = {};
+ my $type = $self->get_type;
+
+ if ($cproton_perl::PN_MAP == $type->get_type_value) {
+ my $size = $self->get_map;
+
+ $self->enter;
+
+ for($count = 0; $count < $size; $count++) {
+ if($self->next) {
+ my $key = $self->get_type->get($self);
+ if($self->next) {
+ my $value = $self->get_type->get($self);
+ $result->{$key} = $value;
+ }
+ }
+ }
+ }
+
+ $self->exit;
+
+ return $result;
+}
+
1;
Modified: qpid/proton/trunk/proton-c/bindings/perl/lib/qpid/proton/Mapping.pm
URL:
http://svn.apache.org/viewvc/qpid/proton/trunk/proton-c/bindings/perl/lib/qpid/proton/Mapping.pm?rev=1520389&r1=1520388&r2=1520389&view=diff
==============================================================================
--- qpid/proton/trunk/proton-c/bindings/perl/lib/qpid/proton/Mapping.pm
(original)
+++ qpid/proton/trunk/proton-c/bindings/perl/lib/qpid/proton/Mapping.pm Thu Sep
5 19:20:12 2013
@@ -17,6 +17,8 @@
# under the License.
#
+use qpid_proton;
+
package qpid::proton::Mapping;
our %by_type_value = ();
@@ -56,8 +58,6 @@ sub equals {
my ($self) = @_;
my $that = $_[1];
- return 0 if !defined($that);
-
return ($self->get_type_value == $that->get_type_value);
}
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=1520389&r1=1520388&r2=1520389&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 Thu Sep
5 19:20:12 2013
@@ -30,6 +30,7 @@ sub new {
my $impl = cproton_perl::pn_message();
$self->{_impl} = $impl;
+ $self->{_properties} = {};
$self->{_body} = undef;
$self->{_body_type} = undef;
@@ -317,6 +318,57 @@ sub get_reply_to_group_id {
=pod
+=head2 PROPERTIES
+
+Allows for accessing and updating the set of properties associated with the
+message.
+
+=over
+
+=item my $props = $msg->get_properties;
+
+=item $msg->set_properties( [VAL] );
+
+=item my $value = $msg->get_property( [KEY] );
+
+=item $msg->set_propert( [KEY], [VALUE] );
+
+=back
+
+=cut
+
+sub get_properties {
+ my ($self) = @_;
+
+ return $self->{_properties};
+}
+
+sub set_properties {
+ my ($self) = @_;
+ my ($properties) = $_[1];
+
+ $self->{_properties} = $properties;
+}
+
+sub get_property {
+ my ($self) = @_;
+ my $name = $_[1];
+ my $properties = $self->{_properties};
+
+ return $properties{$name};
+}
+
+sub set_property {
+ my ($self) = @_;
+ my $name = $_[1];
+ my $value = $_[2];
+ my $properties = $self->{_properties};
+
+ $properties->{"$name"} = $value;
+}
+
+=pod
+
=head2 BODY
The body of the message. When setting the body value a type must be specified,
@@ -366,6 +418,12 @@ sub preencode() {
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);
+
+ my $my_props = $self->{_properties};
+
+ my $props = new
qpid::proton::Data(cproton_perl::pn_message_properties($impl));
+ $props->clear();
+ qpid::proton::MAP->put($props, $my_props) if $my_props;
}
sub postdecode() {
@@ -379,6 +437,14 @@ sub postdecode() {
$self->{_body_type} = $body->get_type();
$self->{_body} = $body->get_type()->get($body);
}
+
+ my $props = new
qpid::proton::Data(cproton_perl::pn_message_properties($impl));
+
+ $props->rewind;
+ if ($props->next) {
+ my $properties = $props->get_type->get($props);
+ $self->{_properties} = $props->get_type->get($props);
+ }
}
1;
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=1520389&r1=1520388&r2=1520389&view=diff
==============================================================================
--- qpid/proton/trunk/proton-c/bindings/perl/tests/message.t (original)
+++ qpid/proton/trunk/proton-c/bindings/perl/tests/message.t Thu Sep 5
19:20:12 2013
@@ -251,3 +251,4 @@ ok(!$message->get_content(), 'Content ca
$message->set_content($content);
ok($message->get_content() eq $content,
'Content was saved correctly');
+
---------------------------------------------------------------------
To unsubscribe, e-mail: [email protected]
For additional commands, e-mail: [email protected]
