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/06/11 16:06:56 UTC
svn commit: r1491797 - in /qpid/proton/trunk/proton-c/bindings/perl:
lib/qpid/proton.pm lib/qpid/proton/Constants.pm lib/qpid_proton.pm
tests/hash_helper.t tests/utils.pm
Author: mcpierce
Date: Tue Jun 11 14:06:56 2013
New Revision: 1491797
URL: http://svn.apache.org/r1491797
Log:
PROTON-328: Add hash helper function to Perl language bindings.
Added the proton.pm module to hold helper functions.
Added the following new global function:
* qpid::proton::get_map_from - get a map from Data as a Perl hash
Added:
qpid/proton/trunk/proton-c/bindings/perl/lib/qpid/proton.pm
qpid/proton/trunk/proton-c/bindings/perl/tests/hash_helper.t
Modified:
qpid/proton/trunk/proton-c/bindings/perl/lib/qpid/proton/Constants.pm
qpid/proton/trunk/proton-c/bindings/perl/lib/qpid_proton.pm
qpid/proton/trunk/proton-c/bindings/perl/tests/utils.pm
Added: qpid/proton/trunk/proton-c/bindings/perl/lib/qpid/proton.pm
URL: http://svn.apache.org/viewvc/qpid/proton/trunk/proton-c/bindings/perl/lib/qpid/proton.pm?rev=1491797&view=auto
==============================================================================
--- qpid/proton/trunk/proton-c/bindings/perl/lib/qpid/proton.pm (added)
+++ qpid/proton/trunk/proton-c/bindings/perl/lib/qpid/proton.pm Tue Jun 11 14:06:56 2013
@@ -0,0 +1,75 @@
+#
+# Licensed to the Apache Software Foundation (ASF) under one
+# or more contributor license agreements. See the NOTICE file
+# distributed with this work for additional information
+# regarding copyright ownership. The ASF licenses this file
+# to you under the Apache License, Version 2.0 (the
+# "License"); you may not use this file except in compliance
+# with the License. You may obtain a copy of the License at
+#
+# http://www.apache.org/licenses/LICENSE-2.0
+#
+# Unless required by applicable law or agreed to in writing,
+# software distributed under the License is distributed on an
+# "AS IS" BASIS, WITHOUT WARRANTIES OR CONDITIONS OF ANY
+# KIND, either express or implied. See the License for the
+# specific language governing permissions and limitations
+# under the License.
+#
+
+=pod
+
+=head1 NAME
+
+qpid::proton;
+
+=head1 DESCRIPTION
+
+=cut
+
+package qpid::proton;
+
+
+=pod
+
+=head2 MAPS
+
+Moving values from a map within a B<qpid::proton::Data> object into a
+Perl B<Hash> object is done using the following:
+
+=over
+
+=item %hash = qpid::proton::get_map_from( [DATA] );
+
+=back
+
+=cut
+
+sub get_map_from {
+ my $data = $_[0];
+
+ die "data cannot be nil" unless defined($data);
+
+ my $type = $data->get_type;
+
+ die "current node is not a map" if !($type == qpid::proton::MAP);
+
+ my $result;
+ my $count = $data->get_map;
+
+ $data->enter;
+ for($i = 0; $i < $count/2; $i++) {
+ $data->next;
+ my $type = $data->get_type;
+ my $key = $type->get($data);
+ $data->next;
+ $type = $data->get_type;
+ my $value = $type->get($data);
+ %{$result}->{$key} = $value;
+ }
+ $data->exit;
+
+ return $result;
+}
+
+1;
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=1491797&r1=1491796&r2=1491797&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 Tue Jun 11 14:06:56 2013
@@ -131,6 +131,11 @@ use constant {
$cproton_perl::PN_LIST,
"put_list",
"get_list"),
+ MAP => qpid::proton::Mapping->new(
+ "map",
+ $cproton_perl::PN_MAP,
+ "put_map",
+ "get_map"),
};
1;
Modified: qpid/proton/trunk/proton-c/bindings/perl/lib/qpid_proton.pm
URL: http://svn.apache.org/viewvc/qpid/proton/trunk/proton-c/bindings/perl/lib/qpid_proton.pm?rev=1491797&r1=1491796&r2=1491797&view=diff
==============================================================================
--- qpid/proton/trunk/proton-c/bindings/perl/lib/qpid_proton.pm (original)
+++ qpid/proton/trunk/proton-c/bindings/perl/lib/qpid_proton.pm Tue Jun 11 14:06:56 2013
@@ -24,9 +24,10 @@ use cproton_perl;
use qpid::proton::Data;
use qpid::proton::Mapping;
use qpid::proton::Constants;
-use qpid::proton::array_helper;
use qpid::proton::Messenger;
use qpid::proton::Message;
+use qpid::proton;
+
1;
Added: qpid/proton/trunk/proton-c/bindings/perl/tests/hash_helper.t
URL: http://svn.apache.org/viewvc/qpid/proton/trunk/proton-c/bindings/perl/tests/hash_helper.t?rev=1491797&view=auto
==============================================================================
--- qpid/proton/trunk/proton-c/bindings/perl/tests/hash_helper.t (added)
+++ qpid/proton/trunk/proton-c/bindings/perl/tests/hash_helper.t Tue Jun 11 14:06:56 2013
@@ -0,0 +1,74 @@
+#!/bin/env perl -w
+#
+# Licensed to the Apache Software Foundation (ASF) under one
+# or more contributor license agreements. See the NOTICE file
+# distributed with this work for additional information
+# regarding copyright ownership. The ASF licenses this file
+# to you under the Apache License, Version 2.0 (the
+# "License"); you may not use this file except in compliance
+# with the License. You may obtain a copy of the License at
+#
+# http://www.apache.org/licenses/LICENSE-2.0
+#
+# Unless required by applicable law or agreed to in writing,
+# software distributed under the License is distributed on an
+# "AS IS" BASIS, WITHOUT WARRANTIES OR CONDITIONS OF ANY
+# KIND, either express or implied. See the License for the
+# specific language governing permissions and limitations
+# under the License.
+#
+
+use Test::More qw(no_plan);
+use Test::Exception;
+
+require 'utils.pm';
+
+BEGIN {use_ok('qpid_proton');}
+require_ok('qpid_proton');
+
+my $data;
+my $hash;
+my $result;
+
+#=============================================================================
+# raises an error when getting a hash from a null data object
+#=============================================================================
+dies_ok(sub {qpid::proton::get_map_from(undef);},
+ "Raises an error when getting a hash froma null data object");
+
+
+#=============================================================================
+# raises an error if the current node is not a map
+#=============================================================================
+$data = qpid::proton::Data->new;
+$data->put_string(random_string(16));
+$data->rewind;
+$data->next;
+
+dies_ok(sub {qpid::proton::get_map_from($data);},
+ "Raises an error if the current node is not a map");
+
+
+#=============================================================================
+# returns a hash from a Data object
+#=============================================================================
+$data = qpid::proton::Data->new;
+$hash = random_hash(rand(128) + 64);
+$data->put_map;
+$data->enter;
+foreach my $key (keys \%{$hash}) {
+ $data->put_string($key);
+ $data->put_string($hash->{$key});
+}
+$data->exit;
+$data->rewind;
+$data->next;
+
+{
+ $result = qpid::proton::get_map_from($data);
+
+ ok(defined($result), "Getting a hash returns a value");
+ ok(scalar(keys %{$result}) == scalar(keys %{$hash}),
+ "Returned the same number of keys");
+ is_deeply(\%{$result}, \%{$hash}, "Returned the same hash values");
+}
Modified: qpid/proton/trunk/proton-c/bindings/perl/tests/utils.pm
URL: http://svn.apache.org/viewvc/qpid/proton/trunk/proton-c/bindings/perl/tests/utils.pm?rev=1491797&r1=1491796&r2=1491797&view=diff
==============================================================================
--- qpid/proton/trunk/proton-c/bindings/perl/tests/utils.pm (original)
+++ qpid/proton/trunk/proton-c/bindings/perl/tests/utils.pm Tue Jun 11 14:06:56 2013
@@ -22,7 +22,7 @@ sub random_hash
$result{$key} = $val;
}
- return %result;
+ return \%result;
}
sub random_string
---------------------------------------------------------------------
To unsubscribe, e-mail: commits-unsubscribe@qpid.apache.org
For additional commands, e-mail: commits-help@qpid.apache.org