qpid-commits mailing list archives

Site index · List index
Message view « Date » · « Thread »
Top « Date » · « Thread »
From mcpie...@apache.org
Subject 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
Date Tue, 11 Jun 2013 14:06:56 GMT
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


Mime
View raw message