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/05/03 20:50:59 UTC
svn commit: r1478919 - in /qpid/proton/trunk/proton-c/bindings/perl/lib:
qpid/proton/Constants.pm qpid/proton/TypeHelper.pm qpid_proton.pm
Author: mcpierce
Date: Fri May 3 18:50:59 2013
New Revision: 1478919
URL: http://svn.apache.org/r1478919
Log:
PROTON-228: Added the TypeHelper class for working with complex types in Perl
This new type is modeled after a similar type in the Ruby language
bindings.
Added:
qpid/proton/trunk/proton-c/bindings/perl/lib/qpid/proton/TypeHelper.pm
Modified:
qpid/proton/trunk/proton-c/bindings/perl/lib/qpid/proton/Constants.pm
qpid/proton/trunk/proton-c/bindings/perl/lib/qpid_proton.pm
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=1478919&r1=1478918&r2=1478919&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 3 18:50:59 2013
@@ -21,32 +21,86 @@ package qpid::proton;
use constant {
NULL => $cproton_perl::PN_NULL,
- BOOL => $cproton_perl::PN_BOOL,
- UBYTE => $cproton_perl::PN_UBYTE,
- BYTE => $cproton_perl::PN_BYTE,
- USHORT => $cproton_perl::PN_USHORT,
- SHORT => $cproton_perl::PN_SHORT,
- UINT => $cproton_perl::PN_UINT,
- INT => $cproton_perl::PN_INT,
- CHAR => $cproton_perl::PN_CHAR,
- ULONG => $cproton_perl::PN_ULONG,
- LONG => $cproton_perl::PN_LONG,
- TIMESTAMP => $cproton_perl::PN_TIMESTAMP,
- FLOAT => $cproton_perl::PN_FLOAT,
- DOUBLE => $cproton_perl::PN_DOUBLE,
- DECIMAL32 => $cproton_perl::PN_DECIMAL32,
- DECIMAL64 => $cproton_perl::PN_DECIMAL64,
- DECIMAL128 => $cproton_perl::PN_DECIMAL128,
- UUID => $cproton_perl::PN_UUID,
- BINARY => $cproton_perl::PN_BINARY,
- STRING => $cproton_perl::PN_STRING,
- SYMBOL => $cproton_perl::PN_SYMBOL,
- DESCRIBED => $cproton_perl::PN_DESCRIBED,
- ARRAY => $cproton_perl::PN_ARRAY,
- LIST => $cproton_perl::PN_LIST,
- MAP => $cproton_perl::PN_MAP,
+ BOOL => qpid::proton::TypeHelper->new(
+ $cproton_perl::PN_BOOL,
+ "put_bool",
+ "get_bool"),
+ UBYTE => qpid::proton::TypeHelper->new(
+ $cproton_perl::PN_UBYTE,
+ "put_ubyte",
+ "get_ubyte"),
+ BYTE => qpid::proton::TypeHelper->new(
+ $cproton_perl::PN_BYTE,
+ "put_byte",
+ "get_byte"),
+ USHORT => qpid::proton::TypeHelper->new(
+ $cproton_perl::PN_USHORT,
+ "put_ushort",
+ "get_ushort"),
+ SHORT => qpid::proton::TypeHelper->new(
+ $cproton_perl::PN_SHORT,
+ "put_short",
+ "get_short"),
+ UINT => qpid::proton::TypeHelper->new(
+ $cproton_perl::PN_UINT,
+ "put_uint",
+ "get_uint"),
+ INT => qpid::proton::TypeHelper->new(
+ $cproton_perl::PN_INT,
+ "put_int",
+ "get_int"),
+ CHAR => qpid::proton::TypeHelper->new(
+ $cproton_perl::PN_CHAR,
+ "put_char",
+ "get_char"),
+ ULONG => qpid::proton::TypeHelper->new(
+ $cproton_perl::PN_ULONG,
+ "put_ulong",
+ "get_ulong"),
+ LONG => qpid::proton::TypeHelper->new(
+ $cproton_perl::PN_LONG,
+ "put_long",
+ "get_long"),
+ TIMESTAMP => qpid::proton::TypeHelper->new(
+ $cproton_perl::PN_TIMESTAMP,
+ "put_timestamp",
+ "get_timestamp"),
+ FLOAT => qpid::proton::TypeHelper->new(
+ $cproton_perl::PN_FLOAT,
+ "put_float",
+ "get_float"),
+ DOUBLE => qpid::proton::TypeHelper->new(
+ $cproton_perl::PN_DOUBLE,
+ "put_double",
+ "get_double"),
+ DECIMAL32 => qpid::proton::TypeHelper->new(
+ $cproton_perl::PN_DECIMAL32,
+ "put_decimal32",
+ "get_decimal32"),
+ DECIMAL64 => qpid::proton::TypeHelper->new(
+ $cproton_perl::PN_DECIMAL64,
+ "put_decimal64",
+ "get_decimal64"),
+ DECIMAL128 => qpid::proton::TypeHelper->new(
+ $cproton_perl::PN_DECIMAL128,
+ "put_decimal128",
+ "get_decimal128"),
+ UUID => qpid::proton::TypeHelper->new(
+ $cproton_perl::PN_UUID,
+ "put_uuid",
+ "get_uuid"),
+ BINARY => qpid::proton::TypeHelper->new(
+ $cproton_perl::PN_BINARY,
+ "put_binary",
+ "get_binary"),
+ STRING => qpid::proton::TypeHelper->new(
+ $cproton_perl::PN_STRING,
+ "put_string",
+ "get_string"),
+ SYMBOL => qpid::proton::TypeHelper->new(
+ $cproton_perl::PN_SYMBOL,
+ "put_symbol",
+ "get_symbol")
};
-
-
1;
Added: qpid/proton/trunk/proton-c/bindings/perl/lib/qpid/proton/TypeHelper.pm
URL: http://svn.apache.org/viewvc/qpid/proton/trunk/proton-c/bindings/perl/lib/qpid/proton/TypeHelper.pm?rev=1478919&view=auto
==============================================================================
--- qpid/proton/trunk/proton-c/bindings/perl/lib/qpid/proton/TypeHelper.pm (added)
+++ qpid/proton/trunk/proton-c/bindings/perl/lib/qpid/proton/TypeHelper.pm Fri May 3 18:50:59 2013
@@ -0,0 +1,99 @@
+#
+# 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.
+#
+
+package qpid::proton::TypeHelper;
+
+our %by_type_value = ();
+
+sub new {
+ my ($class) = @_;
+ my ($self) = {};
+
+ my $type_value = $_[1];
+ my $set_method = $_[2];
+ my $get_method = $_[3];
+
+ $self->{_type_value} = $type_value;
+ $self->{_set_method} = $set_method;
+ $self->{_get_method} = $get_method;
+
+ bless $self, $class;
+
+ $qpid::proton::TypeHelper::by_type_value{$type_value} = $self;
+
+ return $self;
+}
+
+sub getter_method {
+ my ($self) = @_;
+
+ return $self->{_get_method};
+}
+
+sub get_type_value {
+ my ($self) = @_;
+ my $type_value = $self->{_type_value};
+
+ return $self->{_type_value};
+}
+
+sub put {
+ my ($self) = @_;
+ my $data = $_[1];
+ my $described = $_[2];
+ my $elements = $_[3];
+ my $array_type = $self->{_type_value};
+ my $setter_method = $self->{_set_method};
+
+ $data->put_array($described,
+ qpid::proton::TypeHelper->find_by_type_value($array_type));
+ $data->enter;
+ foreach $value (@${elements}) {
+ $data->$setter_method($value);
+ }
+ $data->exit;
+}
+
+sub get {
+ my $data = $_[1];
+
+ my ($size, $described, $type_value) = $data->get_array;
+ my $get_method = $type_value->getter_method;
+ my $result = qpid::proton::Array->new($described, $type_value);
+
+ $data->enter;
+ while($data->next) {
+ my $next_value = $data->$get_method();
+ $result->push($next_value);
+ }
+ $data->exit;
+
+ return $result;
+}
+
+sub find_by_type_value {
+ my $type_value = $_[1];
+
+ return undef if !defined($type_value);
+
+ return $qpid::proton::TypeHelper::by_type_value{$type_value};
+}
+
+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=1478919&r1=1478918&r2=1478919&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 Fri May 3 18:50:59 2013
@@ -21,8 +21,9 @@ use strict;
use warnings;
use cproton_perl;
-use qpid::proton::Constants;
use qpid::proton::Data;
+use qpid::proton::TypeHelper;
+use qpid::proton::Constants;
use qpid::proton::Messenger;
use qpid::proton::Message;
---------------------------------------------------------------------
To unsubscribe, e-mail: commits-unsubscribe@qpid.apache.org
For additional commands, e-mail: commits-help@qpid.apache.org