You are viewing a plain text version of this content. The canonical link for it is here.
Posted to commits@qpid.apache.org by ro...@apache.org on 2017/01/10 15:58:45 UTC
[24/55] [partial] qpid-proton-j git commit: PROTON-1385: retain
proton-j content only, the rest remains in the other repo at:
https://git-wip-us.apache.org/repos/asf/qpid-proton.git
http://git-wip-us.apache.org/repos/asf/qpid-proton-j/blob/2f85988e/proton-c/bindings/perl/lib/qpid/proton/Message.pm
----------------------------------------------------------------------
diff --git a/proton-c/bindings/perl/lib/qpid/proton/Message.pm b/proton-c/bindings/perl/lib/qpid/proton/Message.pm
deleted file mode 100644
index 0251b89..0000000
--- a/proton-c/bindings/perl/lib/qpid/proton/Message.pm
+++ /dev/null
@@ -1,538 +0,0 @@
-#
-# 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::Message;
-
-our $DATA_FORMAT = $cproton_perl::PN_DATA;
-our $TEXT_FORMAT = $cproton_perl::PN_TEXT;
-our $AMQP_FORMAT = $cproton_perl::PN_AMQP;
-our $JSON_FORMAT = $cproton_perl::PN_JSON;
-
-sub new {
- my ($class) = @_;
- my ($self) = {};
-
- my $impl = cproton_perl::pn_message();
- $self->{_impl} = $impl;
- $self->{_properties} = {};
- $self->{_instructions} = {};
- $self->{_annotations} = {};
- $self->{_body} = undef;
- $self->{_body_type} = undef;
-
- bless $self, $class;
- return $self;
-}
-
-use overload fallback => 1,
- '""' => sub {
- my ($self) = @_;
- my $tmp = cproton_perl::pn_string("");
- cproton_perl::pn_inspect($self->{_impl}, $tmp);
- my $result = cproton_perl::pn_string_get($tmp);
- cproton_perl::pn_free($tmp);
- return $result;
-};
-
-sub DESTROY {
- my ($self) = @_;
- my $impl = $self->{_impl};
-
- cproton_perl::pn_message_free($impl);
-}
-
-sub get_impl {
- my ($self) = @_;
- my $impl = $self->{_impl};
- return $impl;
-}
-
-sub clear {
- my ($self) = @_;
- my $impl = $self->{_impl};
-
- cproton_perl::pn_message_clear($impl);
-
- $self->{_body} = undef;
- $self->{_properties} = {};
- $self->{_instructions} = {};
- $self->{_annotations} = {};
-}
-
-sub errno {
- my ($self) = @_;
- return cproton_perl::pn_message_errno($self->{_impl});
-}
-
-sub error {
- my ($self) = @_;
- return cproton_perl::pn_message_error($self->{_impl});
-}
-
-sub set_durable {
- my ($self) = @_;
- cproton_perl::pn_message_set_durable($self->{_impl}, $_[1]);
-}
-
-sub get_durable {
- my ($self) = @_;
- return cproton_perl::pn_message_is_durable($self->{_impl});
-}
-
-sub set_priority {
- my ($self) = @_;
- cproton_perl::pn_message_set_priority($self->{_impl}, $_[1]);
-}
-
-sub get_priority {
- my ($self) = @_;
- return cproton_perl::pn_message_get_priority($self->{_impl});
-}
-
-sub set_ttl {
- my ($self) = @_;
- cproton_perl::pn_message_set_ttl($self->{_impl}, $_[1]);
-}
-
-sub get_ttl {
- my ($self) = @_;
- return cproton_perl::pn_message_get_ttl($self->{_impl});
-}
-
-sub set_first_acquirer {
- my ($self) = @_;
- cproton_perl::pn_message_set_first_acquirer($self->{_impl}, $_[1]);
-}
-
-sub get_first_acquirer {
- my ($self) = @_;
- return cproton_perl::pn_message_is_first_acquirer($self->{_impl});
-}
-
-sub set_delivery_count {
- my ($self) = @_;
- cproton_perl::pn_message_set_delivery_count($self->{_impl}, $_[1]);
-}
-
-sub get_delivery_count {
- my ($self) = @_;
- return cproton_perl::pn_message_get_delivery_count($self->{_impl});
-}
-
-sub set_id {
- my ($self) = @_;
- my $id = $_[1];
-
- die "Message id must be defined" if !defined($id);
-
- cproton_perl::pn_message_set_id($self->{_impl}, $id);
-}
-
-sub get_id {
- my ($self) = @_;
- my $id = cproton_perl::pn_message_get_id($self->{_impl});
-
- return $id;
-}
-
-sub set_user_id {
- my ($self) = @_;
- my $user_id = $_[1];
-
- die "User id must be defined" if !defined($user_id);
-
- cproton_perl::pn_message_set_user_id($self->{_impl}, $user_id);
-}
-
-sub get_user_id {
- my ($self) = @_;
- my $user_id = cproton_perl::pn_message_get_user_id($self->{_impl});
-
- return $user_id;
-}
-
-sub set_address {
- my ($self) = @_;
- cproton_perl::pn_message_set_address($self->{_impl}, $_[1]);
-}
-
-sub get_address {
- my ($self) = @_;
- return cproton_perl::pn_message_get_address($self->{_impl});
-}
-
-sub set_subject {
- my ($self) = @_;
- cproton_perl::pn_message_set_subject($self->{_impl}, $_[1]);
-}
-
-sub get_subject {
- my ($self) = @_;
- return cproton_perl::pn_message_get_subject($self->{_impl});
-}
-
-sub set_reply_to {
- my ($self) = @_;
- cproton_perl::pn_message_set_reply_to($self->{_impl}, $_[1]);
-}
-
-sub get_reply_to {
- my ($self) = @_;
- return cproton_perl::pn_message_get_reply_to($self->{_impl});
-}
-
-sub set_correlation_id {
- my ($self) = @_;
- cproton_perl::pn_message_set_correlation_id($self->{_impl}, $_[1]);
-}
-
-sub get_correlation_id {
- my ($self) = @_;
- return cproton_perl::pn_message_get_correlation_id($self->{_impl});
-}
-
-sub set_format {
- my ($self) = @_;
- my $format = $_[1];
-
- die "Format must be defined" if !defined($format);
-
- cproton_perl::pn_message_set_format($self->{_impl}, $format);
-}
-
-sub get_format {
- my ($self) = @_;
- return cproton_perl::pn_message_get_format($self->{_impl});
-}
-
-sub set_content_type {
- my ($self) = @_;
- cproton_perl::pn_message_set_content_type($self->{_impl}, $_[1]);
-}
-
-sub get_content_type {
- my ($self) = @_;
- return cproton_perl::pn_message_get_content_type($self->{_impl});
-}
-
-sub set_content_encoding {
- my ($self) = @_;
- cproton_perl::pn_message_set_content_encoding($self->{_impl}, $_[1]);
-}
-
-sub get_content_encoding {
- my ($self) = @_;
- return cproton_perl::pn_message_get_content_encoding($self->{_impl});
-}
-
-sub set_expiry_time {
- my ($self) = @_;
- my $expiry_time = $_[1];
-
- die "Expiry time must be defined" if !defined($expiry_time);
-
- $expiry_time = int($expiry_time);
-
- die "Expiry time must be non-negative" if $expiry_time < 0;
-
- cproton_perl::pn_message_set_expiry_time($self->{_impl}, $expiry_time);
-}
-
-sub get_expiry_time {
- my ($self) = @_;
- return cproton_perl::pn_message_get_expiry_time($self->{_impl});
-}
-
-sub set_creation_time {
- my ($self) = @_;
- my $creation_time = $_[1];
-
- die "Creation time must be defined" if !defined($creation_time);
-
- $creation_time = int($creation_time);
-
- die "Creation time must be non-negative" if $creation_time < 0;
-
- cproton_perl::pn_message_set_creation_time($self->{_impl}, $creation_time);
-}
-
-sub get_creation_time {
- my ($self) = @_;
- return cproton_perl::pn_message_get_creation_time($self->{_impl});
-}
-
-sub set_group_id {
- my ($self) = @_;
- cproton_perl::pn_message_set_group_id($self->{_impl}, $_[1]);
-}
-
-sub get_group_id {
- my ($self) = @_;
- return cproton_perl::pn_message_get_group_id($self->{_impl});
-}
-
-sub set_group_sequence {
- my ($self) = @_;
- my $group_sequence = $_[1];
-
- die "Group sequence must be defined" if !defined($group_sequence);
-
- cproton_perl::pn_message_set_group_sequence($self->{_impl}, int($_[1]));
-}
-
-sub get_group_sequence {
- my ($self) = @_;
- return cproton_perl::pn_message_get_group_sequence($self->{_impl});
-}
-
-sub set_reply_to_group_id {
- my ($self) = @_;
- cproton_perl::pn_message_set_reply_to_group_id($self->{_impl}, $_[1]);
-}
-
-sub get_reply_to_group_id {
- my ($self) = @_;
- return cproton_perl::pn_message_get_reply_to_group_id($self->{_impl});
-}
-
-=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 ANNOTATIONS
-
-Allows for accessing and updatin ghte set of annotations associated with the
-message.
-
-=over
-
-=item my $annotations = $msg->get_annotations;
-
-=item $msg->get_annotations->{ [KEY] } = [VALUE];
-
-=item $msg->set_annotations( [VALUE ]);
-
-=back
-
-=cut
-
-sub get_annotations {
- my ($self) = @_;
- return $self->{_annotations};
-}
-
-sub set_annotations {
- my ($self) = @_;
- my $annotations = $_[1];
-
- $self->{_annotations} = $annotations;
-}
-
-=pod
-
-=cut
-
-sub get_instructions {
- my ($self) = @_;
- return $self->{_instructions};
-}
-
-sub set_instructions {
- my ($self) = @_;
- my $instructions = $_[1];
-
- $self->{_instructions} = $instructions;
-}
-
-=pod
-
-=head2 BODY
-
-The body of the message. When setting the body value a type must be specified,
-such as I<qpid::proton::INT>. If unspecified, the body type will default to
-B<qpid::proton::STRING>.
-
-=over
-
-=item $msg->set_body( [VALUE], [TYPE] );
-
-=item $msg->get_body();
-
-=item $msg->get_body_type();
-
-=back
-
-=cut
-
-sub set_body {
- my ($self) = @_;
- my $body = $_[1];
- 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::utils::is_num($body)) {
- if (qpid::proton::utils::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;
-}
-
-sub get_body {
- my ($self) = @_;
- my $body = $self->{_body};
-
- return $body;
-}
-
-sub get_body_type {
- my ($self) = @_;
-
- return $self->{_body_type};
-}
-
-sub preencode() {
- my ($self) = @_;
- my $impl = $self->{_impl};
- my $my_body = $self->{_body};
- my $body_type = $self->{_body_type};
- my $body = new qpid::proton::Data(cproton_perl::pn_message_body($impl));
-
- $body->clear();
- $body_type->put($body, $my_body) if(defined($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;
-
- my $my_insts = $self->{_instructions};
- my $insts = new qpid::proton::Data(cproton_perl::pn_message_instructions($impl));
- $insts->clear;
- qpid::proton::MAP->put($insts, $my_insts) if $my_insts;
-
- my $my_annots = $self->{_annotations};
- my $annotations = new qpid::proton::Data(cproton_perl::pn_message_annotations($impl));
- $annotations->clear();
- qpid::proton::MAP->put($annotations, $my_annots);
-}
-
-sub postdecode() {
- my ($self) = @_;
- my $impl = $self->{_impl};
-
- $self->{_body} = undef;
- $self->{_body_type} = undef;
- my $body = new qpid::proton::Data(cproton_perl::pn_message_body($impl));
- if ($body->next()) {
- $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);
- }
-
- my $insts = new qpid::proton::Data(cproton_perl::pn_message_instructions($impl));
- $insts->rewind;
- if ($insts->next) {
- $self->{_instructions} = $insts->get_type->get($insts);
- }
-
- my $annotations = new qpid::proton::Data(cproton_perl::pn_message_annotations($impl));
- $annotations->rewind;
- if ($annotations->next) {
- my $annots = $annotations->get_type->get($annotations);
- $self->{_annotations} = $annots;
- } else {
- $self->{_annotations} = {};
- }
-}
-
-1;
-
http://git-wip-us.apache.org/repos/asf/qpid-proton-j/blob/2f85988e/proton-c/bindings/perl/lib/qpid/proton/Messenger.pm
----------------------------------------------------------------------
diff --git a/proton-c/bindings/perl/lib/qpid/proton/Messenger.pm b/proton-c/bindings/perl/lib/qpid/proton/Messenger.pm
deleted file mode 100644
index c60bfb6..0000000
--- a/proton-c/bindings/perl/lib/qpid/proton/Messenger.pm
+++ /dev/null
@@ -1,353 +0,0 @@
-#
-# 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 strict;
-use warnings;
-use cproton_perl;
-
-package qpid::proton::Messenger;
-
-sub new {
- my ($class) = @_;
- my ($self) = {};
-
- my $impl = cproton_perl::pn_messenger($_[1]);
- $self->{_impl} = $impl;
-
- bless $self, $class;
- return $self;
-}
-
-sub DESTROY {
- my ($self) = @_;
- cproton_perl::pn_messenger_stop($self->{_impl});
- cproton_perl::pn_messenger_free($self->{_impl});
-}
-
-sub get_name {
- my ($self) = @_;
- return cproton_perl::pn_messenger_name($self->{_impl});
-}
-
-sub set_timeout {
- my ($self) = @_;
- my $timeout = $_[1];
-
- $timeout = 0 if !defined($timeout);
- $timeout = int($timeout);
-
- cproton_perl::pn_messenger_set_timeout($self->{_impl}, $timeout);
-}
-
-sub get_timeout {
- my ($self) = @_;
- return cproton_perl::pn_messenger_get_timeout($self->{_impl});
-}
-
-sub set_outgoing_window {
- my ($self) = @_;
- my $window = $_[1];
-
- $window = 0 if !defined($window);
- $window = int($window);
-
- qpid::proton::check_for_error(cproton_perl::pn_messenger_set_outgoing_window($self->{_impl}, $window), $self);
-}
-
-sub get_outgoing_window {
- my ($self) = @_;
- return cproton_perl::pn_messenger_get_outgoing_window($self->{_impl});
-}
-
-sub set_incoming_window{
- my ($self) = @_;
- my $window = $_[1];
-
- $window = 0 if !defined($window);
- $window = int($window);
-
- qpid::proton::check_for_error(cproton_perl::pn_messenger_set_incoming_window($self->{_impl}, $window), $self);
-}
-
-sub get_incoming_window {
- my ($self) = @_;
- return cproton_perl::pn_messenger_get_incoming_window($self->{_impl});
-}
-
-sub get_error {
- my ($self) = @_;
- my $impl = $self->{_impl};
- my $text = cproton_perl::pn_error_text(cproton_perl::pn_messenger_error($impl));
-
- return $text || "";
-}
-
-sub get_errno {
- my ($self) = @_;
- return cproton_perl::pn_messenger_errno($self->{_impl});
-}
-
-sub start {
- my ($self) = @_;
- qpid::proton::check_for_error(cproton_perl::pn_messenger_start($self->{_impl}), $self);
-}
-
-sub stop {
- my ($self) = @_;
- qpid::proton::check_for_error(cproton_perl::pn_messenger_stop($self->{_impl}), $self);
-}
-
-sub stopped {
- my ($self) = @_;
- my $impl = $self->{_impl};
-
- return cproton_perl::pn_messenger_stopped($impl);
-}
-
-sub subscribe {
- my ($self) = @_;
- cproton_perl::pn_messenger_subscribe($self->{_impl}, $_[1]);
-}
-
-sub set_certificate {
- my ($self) = @_;
- cproton_perl::pn_messenger_set_certificate($self->{_impl}, $_[1]);
-}
-
-sub get_certificate {
- my ($self) = @_;
- return cproton_perl::pn_messenger_get_certificate($self->{_impl});
-}
-
-sub set_private_key {
- my ($self) = @_;
- cproton_perl::pn_messenger_set_private_key($self->{_impl}, $_[1]);
-}
-
-sub get_private_key {
- my ($self) = @_;
- return cproton_perl::pn_messenger_get_private_key($self->{_impl});
-}
-
-sub set_password {
- my ($self) = @_;
-
- qpid::proton::check_for_error(cproton_perl::pn_messenger_set_password($self->{_impl}, $_[1]), $self);
-}
-
-sub get_password {
- my ($self) = @_;
- return cproton_perl::pn_messenger_get_password($self->{_impl});
-}
-
-sub set_trusted_certificates {
- my ($self) = @_;
- cproton_perl::pn_messenger_set_trusted_certificates($self->{_impl}, $_[1]);
-}
-
-sub get_trusted_certificates {
- my ($self) = @_;
- return cproton_perl::pn_messenger_get_trusted_certificates($self->{_impl});
-}
-
-sub put {
- my ($self) = @_;
- my $impl = $self->{_impl};
- my $message = $_[1];
-
- $message->preencode();
- my $msgimpl = $message->get_impl();
- qpid::proton::check_for_error(cproton_perl::pn_messenger_put($impl, $msgimpl), $self);
-
- my $tracker = $self->get_outgoing_tracker();
- return $tracker;
-}
-
-sub get_outgoing_tracker {
- my ($self) = @_;
- my $impl = $self->{_impl};
-
- my $tracker = cproton_perl::pn_messenger_outgoing_tracker($impl);
- if ($tracker != -1) {
- return qpid::proton::Tracker->new($tracker);
- } else {
- return undef;
- }
-}
-
-sub send {
- my ($self) = @_;
- my $n = $_[1];
- $n = -1 if !defined $n;
- qpid::proton::check_for_error(cproton_perl::pn_messenger_send($self->{_impl}, $n), $self);
-}
-
-sub get {
- my ($self) = @_;
- my $impl = $self->{_impl};
- my $message = $_[1] || new proton::Message();
-
- qpid::proton::check_for_error(cproton_perl::pn_messenger_get($impl, $message->get_impl()), $self);
- $message->postdecode();
-
- my $tracker = $self->get_incoming_tracker();
- return $tracker;
-}
-
-sub get_incoming_tracker {
- my ($self) = @_;
- my $impl = $self->{_impl};
- my $result = undef;
-
- my $tracker = cproton_perl::pn_messenger_incoming_tracker($impl);
- if ($tracker != -1) {
- $result = new qpid::proton::Tracker($tracker);
- }
-
- return $result;
-}
-
-sub receive {
- my ($self) = @_;
- my $impl = $self->{_impl};
- my $n = $_[1] || -1;
-
- qpid::proton::check_for_error(cproton_perl::pn_messenger_recv($impl, $n), $self);
-}
-
-sub set_blocking {
- my ($self) = @_;
- my $impl = $self->{_impl};
- my $blocking = int($_[1] || 0);
-
- qpid::proton::check_for_error(cproton_perl::pn_messenger_set_blocking($impl, $blocking));
-}
-
-sub get_blocking {
- my ($self) = @_;
- my $impl = $self->{_impl};
-
- return cproton_perl::pn_messenger_is_blocking($impl);
-}
-
-sub work {
- my ($self) = @_;
- my $impl = $self->{_impl};
- my $timeout = $_[1];
-
- if (!defined($timeout)) {
- $timeout = -1;
- } else {
- $timeout = int($timeout * 1000);
- }
- my $err = cproton_perl::pn_messenger_work($impl, $timeout);
- if ($err == qpid::proton::Errors::TIMEOUT) {
- return 0;
- } else {
- qpid::proton::check_for_error($err);
- return 1;
- }
-}
-
-sub interrupt {
- my ($self) = @_;
-
- qpid::proton::check_for_error(cproton_perl::pn_messenger_interrupt($self->{_impl}), $self);
-}
-
-sub outgoing {
- my ($self) = @_;
- return cproton_perl::pn_messenger_outgoing($self->{_impl});
-}
-
-sub incoming {
- my ($self) = @_;
- return cproton_perl::pn_messenger_incoming($self->{_impl});
-}
-
-sub route {
- my ($self) = @_;
- my $impl = $self->{_impl};
- my $pattern = $_[1];
- my $address = $_[2];
-
- qpid::proton::check_for_error(cproton_perl::pn_messenger_route($impl, $pattern, $address));
-}
-
-sub rewrite {
- my ($self) = @_;
- my $impl = $self->{_impl};
- my $pattern = $_[1];
- my $address = $_[2];
-
- qpid::proton::check_for_error(cproton_perl::pn_messenger_rewrite($impl, $pattern, $address));
-}
-
-sub accept {
- my ($self) = @_;
- my $tracker = $_[1];
- my $flags = 0;
- if (!defined $tracker) {
- $tracker = cproton_perl::pn_messenger_incoming_tracker($self->{_impl});
- $flags = $cproton_perl::PN_CUMULATIVE;
- } else {
- $tracker = $tracker->get_impl;
- }
-
- qpid::proton::check_for_error(cproton_perl::pn_messenger_accept($self->{_impl}, $tracker, $flags), $self);
-}
-
-sub reject {
- my ($self) = @_;
- my $tracker = $_[1];
- my $flags = 0;
- if (!defined $tracker) {
- $tracker = cproton_perl::pn_messenger_incoming_tracker($self->{_impl});
- $flags = $cproton_perl::PN_CUMULATIVE;
- }
- qpid::proton::check_for_error(cproton_perl::pn_messenger_reject($self->{_impl}, $tracker, $flags), $self);
-}
-
-sub status {
- my ($self) = @_;
- my $impl = $self->{_impl};
- my $tracker = $_[1];
-
- if (!defined($tracker)) {
- $tracker = $self->get_incoming_tracker();
- }
-
- return cproton_perl::pn_messenger_status($impl, $tracker->get_impl);
-}
-
-sub settle {
- my ($self) = @_;
- my $impl = $self->{_impl};
- my $tracker = $_[1];
- my $flag = 0;
-
- if (!defined($tracker)) {
- $tracker = $self->get_incoming_tracker();
- $flag = $cproton_perl::PN_CUMULATIVE;
- }
-
- cproton_perl::pn_messenger_settle($impl, $tracker->get_impl, $flag);
-}
-
-1;
http://git-wip-us.apache.org/repos/asf/qpid-proton-j/blob/2f85988e/proton-c/bindings/perl/lib/qpid/proton/Tracker.pm
----------------------------------------------------------------------
diff --git a/proton-c/bindings/perl/lib/qpid/proton/Tracker.pm b/proton-c/bindings/perl/lib/qpid/proton/Tracker.pm
deleted file mode 100644
index 82046e7..0000000
--- a/proton-c/bindings/perl/lib/qpid/proton/Tracker.pm
+++ /dev/null
@@ -1,39 +0,0 @@
-#
-# 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::Tracker;
-
-sub new {
- my ($class) = @_;
- my ($self) = {};
-
- $self->{_impl} = $_[1];
-
- bless $self, $class;
-
- return $self;
-}
-
-sub get_impl {
- my ($self) = @_;
-
- return $self->{_impl};
-}
-
-1;
http://git-wip-us.apache.org/repos/asf/qpid-proton-j/blob/2f85988e/proton-c/bindings/perl/lib/qpid/proton/array_helper.pm
----------------------------------------------------------------------
diff --git a/proton-c/bindings/perl/lib/qpid/proton/array_helper.pm b/proton-c/bindings/perl/lib/qpid/proton/array_helper.pm
deleted file mode 100644
index 40b4b80..0000000
--- a/proton-c/bindings/perl/lib/qpid/proton/array_helper.pm
+++ /dev/null
@@ -1,147 +0,0 @@
-#
-# 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
-
-=head1 MOVING DATA OUT OF A DATA OBJECT
-
-=over
-
-=item qpid::proton::put_array_into( [DATA], [TYPE], [ELEMENTS], [DESCRIBED], [DESCRIPTOR] );
-
-Puts the specified elements into the I<qpid::proton::Data> object specified
-using the specified B<type> value. If the array is described (def. undescribed)
-then the supplied B<descriptor> is used.
-
-=item ($described, $type, @elements) = qpid::proton::get_array_from( [DATA] );
-
-=item ($described, $descriptor, $type, @elements) = qpid::proton::get_array_from( [DATA] );
-
-Retrieves the descriptor, size, type and elements for an array from the
-specified instance of I<qpid::proton::Data>.
-
-If the array is B<described> then the I<descriptor> for the array is returned as well.
-
-=item @elements = qpid::proton::get_list_from( [DATA] );
-
-Retrieves the elements for a list from the specified instance of
-I<qpid::proton::Data>.
-
-=back
-
-=cut
-
-sub put_array_into {
- my $data = $_[0];
- my $type = $_[1];
- my ($values) = $_[2];
- my $described = $_[3] || 0;
- my $descriptor = $_[4];
-
- die "data cannot be nil" if !defined($data);
- die "type cannot be nil" if !defined($type);
- die "values cannot be nil" if !defined($values);
- die "descriptor cannot be nil" if $described && !defined($descriptor);
-
- $data->put_array($described, $type);
- $data->enter;
-
- if ($described && defined($descriptor)) {
- $data->put_symbol($descriptor);
- }
-
- foreach $value (@{$values}) {
- $type->put($data, $value);
- }
- $data->exit;
-}
-
-sub get_array_from {
- my $data = $_[0];
-
- die "data cannot be nil" if !defined($data);
-
- # ensure we're actually on an array
- my $type = $data->get_type;
-
- die "current node is not an array" if !defined($type) ||
- !($type == qpid::proton::ARRAY);
-
- my ($count, $described, $rtype) = $data->get_array;
- my @elements = ();
-
- $data->enter;
-
- if (defined($described) && $described) {
- $data->next;
- $descriptor = $data->get_symbol;
- }
-
- for ($i = 0; $i < $count; $i++) {
- $data->next;
- my $type = $data->get_type;
- my $element = $type->get($data);
- push(@elements, $element);
- }
-
- $data->exit;
-
- if (defined($described) && $described) {
- return ($described, $descriptor, $rtype, @elements) if $described;
- } else {
- return ($described, $rtype, @elements);
- }
-}
-
-sub get_list_from {
- my $data = $_[0];
-
- die "data can not be nil" if !defined($data);
-
- # ensure we're actually on a list
- my $type = $data->get_type;
-
- die "current node is not a list" if !defined($type) ||
- !($type == qpid::proton::LIST);
-
- my $count = $data->get_list;
- $data->enter;
- for($i = 0; $i < $count; $i++) {
- $data->next;
- my $type = $data->get_type;
- my $element = $type->get($data);
- push(@elements, $element);
- }
-
- return @elements;
-}
-
-1;
http://git-wip-us.apache.org/repos/asf/qpid-proton-j/blob/2f85988e/proton-c/bindings/perl/lib/qpid/proton/utils.pm
----------------------------------------------------------------------
diff --git a/proton-c/bindings/perl/lib/qpid/proton/utils.pm b/proton-c/bindings/perl/lib/qpid/proton/utils.pm
deleted file mode 100644
index 0ab4e3e..0000000
--- a/proton-c/bindings/perl/lib/qpid/proton/utils.pm
+++ /dev/null
@@ -1,38 +0,0 @@
-#
-# 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::utils;
-
-sub is_num {
- my $val = $_[0];
-
- return 0 if !defined($val);
- return 0 if $val eq '';
-
- $_[0] ^ $_[0] ? 0 : 1
-}
-
-sub is_float {
- my $val = $_[0];
-
- return 1 if ($val - int($val));
- return 0;
-}
-
-1;
http://git-wip-us.apache.org/repos/asf/qpid-proton-j/blob/2f85988e/proton-c/bindings/perl/lib/qpid_proton.pm
----------------------------------------------------------------------
diff --git a/proton-c/bindings/perl/lib/qpid_proton.pm b/proton-c/bindings/perl/lib/qpid_proton.pm
deleted file mode 100644
index 7e43218..0000000
--- a/proton-c/bindings/perl/lib/qpid_proton.pm
+++ /dev/null
@@ -1,38 +0,0 @@
-#
-# 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 strict;
-use warnings;
-use cproton_perl;
-
-use qpid::proton;
-
-use qpid::proton::utils;
-use qpid::proton::ExceptionHandling;
-use qpid::proton::Data;
-use qpid::proton::Mapping;
-use qpid::proton::Constants;
-use qpid::proton::Tracker;
-use qpid::proton::Messenger;
-use qpid::proton::Message;
-
-package qpid_proton;
-
-1;
-
http://git-wip-us.apache.org/repos/asf/qpid-proton-j/blob/2f85988e/proton-c/bindings/perl/perl.i
----------------------------------------------------------------------
diff --git a/proton-c/bindings/perl/perl.i b/proton-c/bindings/perl/perl.i
deleted file mode 100644
index ebc6915..0000000
--- a/proton-c/bindings/perl/perl.i
+++ /dev/null
@@ -1,216 +0,0 @@
-%module cproton_perl
-
-%{
-#include <proton/engine.h>
-#include <proton/message.h>
-#include <proton/sasl.h>
-#include <proton/messenger.h>
-#include <proton/ssl.h>
-#include <proton/url.h>
-#include <proton/reactor.h>
-#include <proton/handlers.h>
-%}
-
-%include <cstring.i>
-
-%typemap(in) pn_atom_t
-{
- if(!$input)
- {
- $1.type = PN_NULL;
- }
- else
- {
- if(SvIOK($input)) // an integer value
- {
- $1.type = PN_LONG;
- $1.u.as_long = SvIV($input);
- }
- else if(SvNOK($input)) // a floating point value
- {
- $1.type = PN_FLOAT;
- $1.u.as_float = SvNV($input);
- }
- else if(SvPOK($input)) // a string type
- {
- STRLEN len;
- char* ptr;
-
- ptr = SvPV($input, len);
- $1.type = PN_STRING;
- $1.u.as_bytes.start = ptr;
- $1.u.as_bytes.size = strlen(ptr); // len;
- }
- }
-}
-
-%typemap(out) pn_atom_t
-{
- SV* obj = sv_newmortal();
-
- switch($1.type)
- {
- case PN_NULL:
- sv_setsv(obj, &PL_sv_undef);
- break;
-
- case PN_BYTE:
- sv_setiv(obj, (IV)$1.u.as_byte);
- break;
-
- case PN_INT:
- sv_setiv(obj, (IV)$1.u.as_int);
- break;
-
- case PN_LONG:
- sv_setiv(obj, (IV)$1.u.as_long);
- break;
-
- case PN_STRING:
- {
- if($1.u.as_bytes.size > 0)
- {
- sv_setpvn(obj, $1.u.as_bytes.start, $1.u.as_bytes.size);
- }
- else
- {
- sv_setsv(obj, &PL_sv_undef);
- }
- }
- break;
-
- default:
- break;
- }
-
- $result = obj;
- // increment the hidden stack reference before returning
- argvi++;
-}
-
-%typemap(in) pn_bytes_t
-{
- STRLEN len;
- char* ptr;
-
- ptr = SvPV($input, len);
- $1.start = ptr;
- $1.size = strlen(ptr);
-}
-
-%typemap(out) pn_bytes_t
-{
- SV* obj = sv_newmortal();
-
- if($1.start != NULL)
- {
- $result = newSVpvn($1.start, $1.size);
- }
- else
- {
- $result = &PL_sv_undef;
- }
-
- argvi++;
-}
-
-%typemap(in) pn_decimal128_t
-{
- AV *tmpav = (AV*)SvRV($input);
- int index = 0;
-
- for(index = 0; index < 16; index++)
- {
- $1.bytes[index] = SvIV(*av_fetch(tmpav, index, 0));
- $1.bytes[index] = $1.bytes[index] & 0xff;
- }
-}
-
-%typemap(out) pn_decimal128_t
-{
- $result = newSVpvn($1.bytes, 16);
- argvi++;
-}
-
-%typemap(in) pn_uuid_t
-{
- // XXX: I believe there is a typemap or something similar for
- // typechecking the input. We should probably use it.
- AV* tmpav = (AV *) SvRV($input);
- int index = 0;
-
- for(index = 0; index < 16; index++)
- {
- $1.bytes[index] = SvIV(*av_fetch(tmpav, index, 0));
- $1.bytes[index] = $1.bytes[index] & 0xff;
- }
-}
-
-%typemap(out) pn_uuid_t
-{
- $result = newSVpvn($1.bytes, 16);
- argvi++;
-}
-
-%cstring_output_withsize(char *OUTPUT, size_t *OUTPUT_SIZE)
-%cstring_output_allocate_size(char **ALLOC_OUTPUT, size_t *ALLOC_SIZE, free(*$1));
-
-int pn_message_encode(pn_message_t *msg, char *OUTPUT, size_t *OUTPUT_SIZE);
-%ignore pn_message_encode;
-
-ssize_t pn_link_send(pn_link_t *transport, char *STRING, size_t LENGTH);
-%ignore pn_link_send;
-
-%rename(pn_link_recv) wrap_pn_link_recv;
-%inline %{
- int wrap_pn_link_recv(pn_link_t *link, char *OUTPUT, size_t *OUTPUT_SIZE) {
- ssize_t sz = pn_link_recv(link, OUTPUT, *OUTPUT_SIZE);
- if (sz >= 0) {
- *OUTPUT_SIZE = sz;
- } else {
- *OUTPUT_SIZE = 0;
- }
- return sz;
- }
-%}
-%ignore pn_link_recv;
-
-ssize_t pn_transport_input(pn_transport_t *transport, char *STRING, size_t LENGTH);
-%ignore pn_transport_input;
-
-%rename(pn_transport_output) wrap_pn_transport_output;
-%inline %{
- int wrap_pn_transport_output(pn_transport_t *transport, char *OUTPUT, size_t *OUTPUT_SIZE) {
- ssize_t sz = pn_transport_output(transport, OUTPUT, *OUTPUT_SIZE);
- if (sz >= 0) {
- *OUTPUT_SIZE = sz;
- } else {
- *OUTPUT_SIZE = 0;
- }
- return sz;
- }
-%}
-%ignore pn_transport_output;
-
-%rename(pn_delivery) wrap_pn_delivery;
-%inline %{
- pn_delivery_t *wrap_pn_delivery(pn_link_t *link, char *STRING, size_t LENGTH) {
- return pn_delivery(link, pn_dtag(STRING, LENGTH));
- }
-%}
-%ignore pn_delivery;
-
-// Suppress "Warning(451): Setting a const char * variable may leak memory." on pn_delivery_tag_t
-%warnfilter(451) pn_delivery_tag_t;
-%rename(pn_delivery_tag) wrap_pn_delivery_tag;
-%inline %{
- void wrap_pn_delivery_tag(pn_delivery_t *delivery, char **ALLOC_OUTPUT, size_t *ALLOC_SIZE) {
- pn_delivery_tag_t tag = pn_delivery_tag(delivery);
- *ALLOC_OUTPUT = (char *)malloc(tag.size);
- *ALLOC_SIZE = tag.size;
- memcpy(*ALLOC_OUTPUT, tag.start, tag.size);
- }
-%}
-%ignore pn_delivery_tag;
-
-%include "proton/cproton.i"
http://git-wip-us.apache.org/repos/asf/qpid-proton-j/blob/2f85988e/proton-c/bindings/perl/tests/array_helper.t
----------------------------------------------------------------------
diff --git a/proton-c/bindings/perl/tests/array_helper.t b/proton-c/bindings/perl/tests/array_helper.t
deleted file mode 100644
index 2273085..0000000
--- a/proton-c/bindings/perl/tests/array_helper.t
+++ /dev/null
@@ -1,232 +0,0 @@
-#!/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 @values;
-my $result;
-my $length;
-my $descriptor;
-
-#=============================================================================
-# Getting an array from a nil Data instance raises an error.
-#=============================================================================
-$data = qpid::proton::Data->new;
-dies_ok(sub {qpid::proton::get_array_from(undef);},
- "Raise an exception when getting from a nil Data object");
-
-
-#=============================================================================
-# Getting an array fails if the current node is not an array or a list.
-#=============================================================================
-$data = qpid::proton::Data->new;
-$data->put_string("foo");
-$data->rewind;
-$data->next;
-dies_ok(sub {qpid::proton::proton_get_array_from($data, undef);},
- "Raise an exception when getting from a non-list and non-array");
-
-
-#=============================================================================
-# Can get an undescribed array.
-#=============================================================================
-$length = int(rand(256) + 64);
-$data = qpid::proton::Data->new;
-@values= random_integers($length);
-$data->put_array(0, qpid::proton::INT);
-$data->enter;
-foreach $value (@values) {
- $data->put_int($value);
-}
-$data->exit;
-$data->rewind;
-
-{
- $data->next;
- my ($described, $type, @results) = qpid::proton::get_array_from($data);
-
- ok(!$described, "Returned an undescribed array");
- ok($type == qpid::proton::INT, "Returned the correct array type");
- ok(scalar(@results) == $length, "Returns the correct number of elements");
-
- is_deeply([sort @results], [sort @values],
- "Returned the correct set of values");
-}
-
-
-#=============================================================================
-# Raises an error when putting into a null Data object.
-#=============================================================================
-dies_ok(sub {qpid::proton::put_array_into(undef, qpid::proton::INT, @values);},
- "Raises an error when putting into a null Data object");
-
-
-#=============================================================================
-# Raises an error when putting a null type into a Data object.
-#=============================================================================
-$data = qpid::proton::Data->new;
-dies_ok(sub {qpid::proton::put_array_into($data, undef, @values);},
- "Raises an error when putting into a null Data object");
-
-
-#=============================================================================
-# Raises an error when putting a null array into a Data object.
-#=============================================================================
-$data = qpid::proton::Data->new;
-dies_ok(sub {qpid::proton::put_array_into($data, qpid::proton::INT);},
- "Raises an error when putting into a null Data object");
-
-
-#=============================================================================
-# Raises an error when putting a described array with no descriptor.
-#=============================================================================
-$data = qpid::proton::Data->new;
-dies_ok(sub {qpid::proton::put_array_into($data, qpid::proton::INT, \@values, 1);},
- "Raises an error when putting a described array with no descriptor");
-
-
-#=============================================================================
-# Can put an undescribed array into a Data object.
-#=============================================================================
-$length = int(rand(256) + 64);
-$data = qpid::proton::Data->new;
-@values= random_integers($length);
-qpid::proton::put_array_into($data, qpid::proton::INT, \@values, 0);
-$data->rewind;
-
-{
- $data->next;
- my ($described, $type, @results) = qpid::proton::get_array_from($data);
-
- ok(!$described, "Put an undescribed array");
- ok($type == qpid::proton::INT, "Put the correct array type");
- ok(scalar(@results) == $length, "Put the correct number of elements");
-
- is_deeply([sort @results], [sort @values],
- "Returned the correct set of values");
-}
-
-
-#=============================================================================
-# Can get an described array.
-#=============================================================================
-$length = int(rand(256) + 64);
-$data = qpid::proton::Data->new;
-@values= random_strings($length);
-$descriptor = random_string(64);
-$data->put_array(1, qpid::proton::STRING);
-$data->enter;
-$data->put_symbol($descriptor);
-foreach $value (@values) {
- $data->put_string($value);
-}
-
-$data->exit;
-$data->rewind;
-
-{
- $data->next;
- my ($described, $dtor, $type, @results) = qpid::proton::get_array_from($data);
-
- ok($described, "Returned a described array");
- ok($dtor eq $descriptor, "Returned the correct descriptor");
- ok($type == qpid::proton::STRING, "Returned the correct array type");
- ok(scalar(@results) == $length, "Returns the correct number of elements");
-
- is_deeply([sort @results], [sort @values],
- "Returned the correct set of values");
-}
-
-
-#=============================================================================
-# Can put a described array into a Data object.
-#=============================================================================
-$length = int(rand(256) + 64);
-$data = qpid::proton::Data->new;
-@values= random_integers($length);
-$descriptor = random_string(128);
-qpid::proton::put_array_into($data, qpid::proton::INT, \@values, 1, $descriptor);
-$data->rewind;
-
-{
- $data->next;
- my ($described, $dtor, $type, @results) = qpid::proton::get_array_from($data);
-
- ok($described, "Put a described array");
- ok($dtor eq $descriptor, "Put the correct descriptor");
- ok($type == qpid::proton::INT, "Put the correct array type");
- ok(scalar(@results) == $length, "Put the correct number of elements");
-
- is_deeply([sort @results], [sort @values],
- "Returned the correct set of values");
-}
-
-
-#=============================================================================
-# Raises an error when getting a list from a null Data instance
-#=============================================================================
-$data = qpid::proton::Data->new;
-dies_ok(sub {qpid::proton::get_list_from(undef);},
- "Raises error when getting list from null Data object");
-
-
-#=============================================================================
-# Raises an error when the current node is not a list.
-#=============================================================================
-$data = qpid::proton::Data->new;
-$data->put_string(random_string(64));
-$data->rewind;
-$data->next;
-
-dies_ok(sub {qpid::proton::get_list_from($data);},
- "Raises an error when getting a list and it's not currently a list.");
-
-
-#=============================================================================
-# Can get an array
-#=============================================================================
-$length = int(rand(256) + 64);
-$data = qpid::proton::Data->new;
-@values = random_strings($length);
-$data->put_list;
-$data->enter;
-foreach $value (@values) {
- $data->put_string($value);
-}
-$data->exit;
-$data->rewind;
-
-{
- my $result = $data->next;
-
- my @results = qpid::proton::get_list_from($data);
-
- ok(scalar(@results) == $length, "Returned the correct number of elements");
-
- is_deeply([sort @results], [sort @values],
- "Returned the correct list of values");
-}
http://git-wip-us.apache.org/repos/asf/qpid-proton-j/blob/2f85988e/proton-c/bindings/perl/tests/data.t
----------------------------------------------------------------------
diff --git a/proton-c/bindings/perl/tests/data.t b/proton-c/bindings/perl/tests/data.t
deleted file mode 100644
index 2bfdead..0000000
--- a/proton-c/bindings/perl/tests/data.t
+++ /dev/null
@@ -1,536 +0,0 @@
-#!/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::Number::Delta within => 1e-3;
-use Test::Exception;
-
-require 'utils.pm';
-
-BEGIN {use_ok('qpid_proton');}
-require_ok('qpid_proton');
-
-my $data;
-my $value;
-
-# Create without capacity
-$data = qpid::proton::Data->new();
-isa_ok($data, 'qpid::proton::Data');
-
-# Create with capacity
-$data = qpid::proton::Data->new(24);
-isa_ok($data, 'qpid::proton::Data');
-
-# can put a null
-$data = qpid::proton::Data->new();
-$data->put_null();
-ok($data->is_null(), "Data can put a null");
-
-# raises an error on a null boolean
-$data = qpid::proton::Data->new();
-dies_ok(sub {$data->put_bool;}, "Cannot put a null bool");
-
-# can put a true boolean
-$data = qpid::proton::Data->new();
-$data->put_bool(1);
-ok($data->get_bool(), "Data can put a true bool");
-
-# can put a false boolean
-$data = qpid::proton::Data->new();
-$data->put_bool(0);
-ok(!$data->get_bool(), "Data can put a false bool");
-
-# raises an error on a negative ubyte
-$data = qpid::proton::Data->new();
-dies_ok(sub {$data->put_ubyte(0 - (rand(2**7) + 1));},
- "Cannot have a negative ubyte");
-
-# raises an error on a null ubyte
-$data = qpid::proton::Data->new();
-dies_ok(sub {$data->put_ubyte;}, "Cannot put a null ubyte");
-
-# can put a zero ubyte
-$data = qpid::proton::Data->new();
-$data->put_ubyte(0);
-ok($data->get_ubyte() == 0, "Can put a zero ubyte");
-
-# will convert a float to an int ubyte
-$data = qpid::proton::Data->new();
-$value = rand(2**7) + 1;
-$data->put_ubyte($value);
-ok ($data->get_ubyte() == int($value), "Can put a float ubyte");
-
-# can put a ubyte
-$data = qpid::proton::Data->new();
-$value = int(rand(2**7) + 1);
-$data->put_ubyte($value);
-ok($data->get_ubyte() == $value, "Can put a ubyte");
-
-# raises an error on a null byte
-$data = qpid::proton::Data->new();
-dies_ok(sub {$data->put_byte;}, "Cannot put a null byte");
-
-# can put a negative byte
-$data = qpid::proton::Data->new();
-$value = int(0 - (1 + rand(2**7)));
-$data->put_byte($value);
-ok($data->get_byte() == $value, "Can put a negative byte");
-
-# can put a zero byte
-$data = qpid::proton::Data->new();
-$data->put_byte(0);
-ok($data->get_byte() == 0, "Can put a zero byte");
-
-# can put a float as a byte
-$data = qpid::proton::Data->new();
-$value = rand(2**7) + 1;
-$data->put_byte($value);
-ok($data->get_byte() == int($value), "Can put a float as a byte");
-
-# can put a byte
-$data = qpid::proton::Data->new();
-$value = int(1 + rand(2**7));
-$data->put_byte($value);
-ok($data->get_byte() == $value, "Can put a byte");
-
-# raise an error on a null ushort
-$data = qpid::proton::Data->new();
-dies_ok(sub {$data->put_ushort;}, "Cannot put a null ushort");
-
-# raises an error on a negative ushort
-$data = qpid::proton::Data->new();
-$value = 0 - (1 + rand((2**15)));
-dies_ok(sub {$data->put_ushort($value);}, "Cannot put a negative ushort");
-
-# can put a zero ushort
-$data = qpid::proton::Data->new();
-$data->put_ushort(0);
-ok($data->get_ushort() == 0, "Can put a zero ushort");
-
-# can handle a float ushort value
-$data = qpid::proton::Data->new();
-$value = 1 + rand((2**15));
-$data->put_ushort($value);
-ok($data->get_ushort() == int($value), "Can put a float ushort");
-
-# can put a ushort
-$data = qpid::proton::Data->new();
-$value = int(1 + rand((2**15)));
-$data->put_ushort($value);
-ok($data->get_ushort() == $value, "Can put a ushort");
-
-# raises an error on a null short
-$data = qpid::proton::Data->new();
-dies_ok(sub {$data->put_short;}, "Cannot put a null short");
-
-# can put a negative short
-$data = qpid::proton::Data->new();
-$value = int(0 - (1 + rand((2**15))));
-$data->put_short($value);
-ok($data->get_short() == $value, "Can put a negative short");
-
-# can put a zero short
-$data = qpid::proton::Data->new();
-$data->put_short(0);
-ok($data->get_short() == 0, "Can put a zero short");
-
-# can put a float as a short
-$data = qpid::proton::Data->new();
-$value = 1 + rand(2**15);
-$data->put_short($value);
-ok($data->get_short() == int($value), "Can put a float as a short");
-
-# can put a short
-$data = qpid::proton::Data->new();
-$value = int(1 + rand(2**15));
-$data->put_short($value);
-ok($data->get_short() == $value, "Can put a short");
-
-# raises an error on a null uint
-$data = qpid::proton::Data->new();
-dies_ok(sub {$data->put_uint;}, "Cannot set a null uint");
-
-# raises an error on a negative uint
-$data = qpid::proton::Data->new();
-$value = 0 - (1 + rand(2**31));
-dies_ok(sub {$data->put_uint($value);}, "Cannot set a negative uint");
-
-# can put a zero uint
-$data = qpid::proton::Data->new();
-$data->put_uint(0);
-ok($data->get_uint() == 0, "Can put a zero uint");
-
-# can put a float as a uint
-$data = qpid::proton::Data->new();
-$value = 1 + rand(2**31);
-$data->put_uint($value);
-ok($data->get_uint() == int($value), "Can put a float as a uint");
-
-# can put a uint
-$data = qpid::proton::Data->new();
-$value = int(1 + rand(2**31));
-$data->put_uint($value);
-ok($data->get_uint() == $value, "Can put a uint");
-
-# raise an error on a null integer
-$data = qpid::proton::Data->new();
-dies_ok(sub {$data->put_int;}, "Cannot put a null int");
-
-# can put a negative integer
-$data = qpid::proton::Data->new();
-$value = int(0 - (1 + rand(2**31)));
-$data->put_int($value);
-ok($data->get_int() == $value, "Can put a negative int");
-
-# can put a zero integer
-$data = qpid::proton::Data->new();
-$data->put_int(0);
-ok($data->get_int() == 0, "Can put a zero int");
-
-# can put a float as an integer
-$data = qpid::proton::Data->new();
-$value = 1 + (rand(2**31));
-$data->put_int($value);
-ok($data->get_int() == int($value), "Can put a float as an int");
-
-# can put an integer
-$data = qpid::proton::Data->new();
-$value = int(1 + rand(2**31));
-$data->put_int($value);
-ok($data->get_int() == $value, "Can put an int");
-
-# raises an error on a null character
-$data = qpid::proton::Data->new();
-dies_ok(sub {$data->put_char;}, "Cannot put a null char");
-
-# can put a float as a char
-$data = qpid::proton::Data->new();
-$value = 1 + rand(255);
-$data->put_char($value);
-ok($data->get_char() == int($value), "Can put a float as a char");
-
-# can put a character
-$data = qpid::proton::Data->new();
-$value = int(1 + rand(255));
-$data->put_char($value);
-ok($data->get_char() == $value, "Can put a char");
-
-# raise an error on a null ulong
-$data = qpid::proton::Data->new();
-dies_ok(sub {$data->put_ulong;}, "Cannot put a null ulong");
-
-# raises an error on a negative ulong
-$data = qpid::proton::Data->new();
-$value = 0 - (1 + rand(2**63));
-dies_ok(sub {$data->put_ulong($value);}, "Cannot put a negative ulong");
-
-# can put a zero ulong
-$data = qpid::proton::Data->new();
-$data->put_ulong(0);
-ok($data->get_ulong() == 0, "Can put a zero ulong");
-
-# can put a float as a ulong
-$data = qpid::proton::Data->new();
-$value = 1 + rand(2**63);
-$data->put_ulong($value);
-ok($data->get_ulong() == int($value), "Can put a float as a ulong");
-
-# can put a ulong
-$data = qpid::proton::Data->new();
-$value = int(1 + rand(2**63));
-$data->put_ulong($value);
-ok($data->get_ulong() == $value, "Can put a ulong");
-
-# raises an error on a null long
-$data = qpid::proton::Data->new();
-dies_ok(sub {$data->put_long;}, "Cannot put a null long");
-
-# can put a negative long
-$data = qpid::proton::Data->new();
-$value = int(0 - (1 + rand(2**63)));
-$data->put_long($value);
-ok($data->get_long() == $value, "Can put a negative long");
-
-# can put a zero long
-$data = qpid::proton::Data->new();
-$data->put_long(0);
-ok($data->get_long() == 0, "Can put a zero long");
-
-# can put a float as a long
-$data = qpid::proton::Data->new();
-$value = 1 + rand(2**63);
-$data->put_long($value);
-ok($data->get_long() == int($value), "Can put a float as a long");
-
-# can put a long
-$data = qpid::proton::Data->new();
-$value = int(1 + rand(2**63));
-$data->put_long($value);
-ok($data->get_long() == $value, "Can put a long value");
-
-# raises an error on a null timestamp
-$data = qpid::proton::Data->new();
-dies_ok(sub {$data->put_timestamp;}, "Cannot put a null timestamp");
-
-# can put a negative timestamp
-$data = qpid::proton::Data->new();
-$value = int(0 - (1 + rand(2**32)));
-$data->put_timestamp($value);
-ok($data->get_timestamp() == $value, "Can put a negative timestamp");
-
-# can put a zero timestamp
-$data = qpid::proton::Data->new();
-$data->put_timestamp(0);
-ok($data->get_timestamp() == 0, "Can put a zero timestamp");
-
-# can put a float as a timestamp
-$data = qpid::proton::Data->new();
-$value = 1 + (rand(2**32));
-$data->put_timestamp($value);
-ok($data->get_timestamp() == int($value), "Can put a float as a timestamp");
-
-# can put a timestamp
-$data = qpid::proton::Data->new();
-$value = int(1 + rand(2**32));
-$data->put_timestamp($value);
-ok($data->get_timestamp() == $value, "Can put a timestamp");
-
-# raises an error on a null float
-$data = qpid::proton::Data->new();
-dies_ok(sub {$data->put_float;}, "Cannot put a null float");
-
-# can put a negative float
-$data = qpid::proton::Data->new();
-$value = 0 - (1 + rand(2**15));
-$data->put_float($value);
-delta_ok($data->get_float(), $value, "Can put a negative float");
-
-# can put a zero float
-$data = qpid::proton::Data->new();
-$data->put_float(0.0);
-delta_ok($data->get_float(), 0.0, "Can put a zero float");
-
-# can put a float
-$data = qpid::proton::Data->new();
-$value = 1.0 + rand(2**15);
-$data->put_float($value);
-delta_ok($data->get_float(), $value, "Can put a float");
-
-# raises an error on a null double
-$data = qpid::proton::Data->new();
-dies_ok(sub {$data->put_double;}, "Cannot set a null double");
-
-# can put a negative double
-$data = qpid::proton::Data->new();
-$value = 0 - (1 + rand(2**31));
-$data->put_double($value);
-delta_ok($data->get_double(), $value, "Can put a double value");
-
-# can put a zero double
-$data = qpid::proton::Data->new();
-$data->put_double(0.0);
-delta_ok($data->get_double(), 0.0, "Can put a zero double");
-
-# can put a double
-$data = qpid::proton::Data->new();
-$value = 1.0 + rand(2**15);
-$data->put_double($value);
-delta_ok($data->get_double(), $value, "Can put a double");
-
-# raises an error on a null decimal32
-$data = qpid::proton::Data->new();
-dies_ok(sub {$data->put_decimal32;}, "Cannot put a null decimal32");
-
-# can put a decimal32
-$data = qpid::proton::Data->new();
-$value = int(rand(2**32));
-$data->put_decimal32($value);
-ok($data->get_decimal32() == $value, "Can put a decimal32 value");
-
-# raises an error on a null decimal64
-$data = qpid::proton::Data->new();
-dies_ok(sub {$data->put_decimal64();}, "Cannot put a null decimal64");
-
-# can put a decimal64
-$data = qpid::proton::Data->new();
-$value = int(rand(2**64));
-$data->put_decimal64($value);
-ok($data->get_decimal64() == $value, "Can put a decimal64 value");
-
-# raises an error on a null decimal128
-$data = qpid::proton::Data->new();
-dies_ok(sub {$data->put_decimal128;}, "Cannot put a null decimal128");
-
-# can put a decimal128
-$data = qpid::proton::Data->new();
-$value = int(rand(2**31));
-$data->put_decimal128($value);
-ok($data->get_decimal128() == $value, "Can put a decimal128 value");
-
-# raises an error on a null UUID
-$data = qpid::proton::Data->new();
-dies_ok(sub {$data->put_uuid;}, "Cannot put a null UUID");
-
-# raises an error on a malformed UUID
-$data = qpid::proton::Data->new();
-$value = random_string(36);
-dies_ok(sub {$data->put_uuid($value);}, "Cannot put a malformed UUID");
-
-# can put a UUID
-$data = qpid::proton::Data->new();
-$data->put_uuid("fd0289a5-8eec-4a08-9283-81d02c9d2fff");
-ok($data->get_uuid() eq "fd0289a5-8eec-4a08-9283-81d02c9d2fff",
- "Can store a string UUID");
-
-# cannot put a null binary
-$data = qpid::proton::Data->new();
-dies_ok(sub {$data->put_binary;}, "Cannot put a null binary");
-
-# can put an empty binary string
-$data = qpid::proton::Data->new();
-$data->put_binary("");
-ok($data->get_binary() eq "", "Can put an empty binary");
-
-# can put a binary
-$data = qpid::proton::Data->new();
-$value = random_string(128);
-$data->put_binary($value);
-ok($data->get_binary() eq $value, "Can put a binary value");
-
-# cannot put a null string
-$data = qpid::proton::Data->new();
-dies_ok(sub {$data->put_string;}, "Cannot put a null string");
-
-# can put an empty string
-$data = qpid::proton::Data->new();
-$data->put_string("");
-ok($data->get_string() eq "", "Can put an empty string");
-
-# can put a string
-$data = qpid::proton::Data->new();
-$value = random_string(128);
-$data->put_string($value);
-ok($data->get_string() eq $value, "Can put an arbitrary string");
-
-# cannot put a null symbol
-$data = qpid::proton::Data->new();
-dies_ok(sub {$data->put_symbol;}, "Cannot put a null symbol");
-
-# can put a symbol
-$data = qpid::proton::Data->new();
-$value = random_string(64);
-$data->put_symbol($value);
-ok($data->get_symbol eq $value, "Can put a symbol");
-
-# can hold a described value
-$data = qpid::proton::Data->new();
-$data->put_described;
-ok($data->is_described, "Can hold a described value");
-
-# can put an array with undef as described flag
-$data = qpid::proton::Data->new();
-my @values = map { rand } (1..100, );
-lives_ok(sub {$data->put_array(undef, qpid::proton::INT);},
- "Array can have null for described flag");
-
-# arrays must have a specified type
-$data = qpid::proton::Data->new();
-dies_ok(sub {$data->put_array;},
- "Array type cannot be null");
-
-# can put an array
-$data = qpid::proton::Data->new();
-@values = random_integers(100);
-$data->put_array(0, qpid::proton::INT);
-$data->enter;
-foreach $value (@values) {
- $data->put_int($value);
-}
-$data->exit;
-
-@result = ();
-$data->enter;
-foreach $value (@values) {
- $data->next;
- push @result, $data->get_int;
-}
-$data->exit;
-is_deeply((\@result, \@values), "Array was populated correctly");
-
-# can put a described array
-$data = qpid::proton::Data->new();
-@values = random_integers(100);
-$data->put_array(1, qpid::proton::INT);
-$data->enter;
-foreach $value (@values) {
- $data->put_int($value);
-}
-$data->exit;
-
-@result = ();
-$data->enter;
-foreach $value (@values) {
- $data->next;
- push @result, $data->get_int;
-}
-is_deeply((\@result, \@values), "Array was populated correctly");
-
-# can put a list
-$data = qpid::proton::Data->new();
-@values = random_integers(100);
-$data->put_list;
-$data->enter;
-foreach $value (@values) {
- $data->put_int($value);
-}
-$data->exit;
-
-@result = ();
-$data->enter;
-foreach $value (@values) {
- $data->next;
- push @result, $data->get_int;
-}
-$data->exit;
-is_deeply((\@result, \@values), "List was populated correctly");
-
-
-# can put a map
-$data = qpid::proton::Data->new();
-my $map = random_hash(100);
-$data->put_map;
-$data->enter;
-foreach my $key (keys %{$map}) {
- $data->put_string($key);
- $data->put_string($map->{$key});
-}
-$data->exit;
-
-my $result = {};
-$data->enter;
-foreach my $key (keys %{$map}) {
- $data->next;
- my $rkey = $data->get_string;
- $data->next;
- my $rval = $data->get_string;
- $result{$rkey} = $rval;
-}
-$data->exit;
-ok(eq_hash(\%result, \%{$map}), "Map was populated correctly");
http://git-wip-us.apache.org/repos/asf/qpid-proton-j/blob/2f85988e/proton-c/bindings/perl/tests/hash_helper.t
----------------------------------------------------------------------
diff --git a/proton-c/bindings/perl/tests/hash_helper.t b/proton-c/bindings/perl/tests/hash_helper.t
deleted file mode 100644
index 8f1ea3d..0000000
--- a/proton-c/bindings/perl/tests/hash_helper.t
+++ /dev/null
@@ -1,74 +0,0 @@
-#!/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");
-}
http://git-wip-us.apache.org/repos/asf/qpid-proton-j/blob/2f85988e/proton-c/bindings/perl/tests/message.t
----------------------------------------------------------------------
diff --git a/proton-c/bindings/perl/tests/message.t b/proton-c/bindings/perl/tests/message.t
deleted file mode 100644
index ee55361..0000000
--- a/proton-c/bindings/perl/tests/message.t
+++ /dev/null
@@ -1,254 +0,0 @@
-#!/usr/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');
-
-# Create a new message.
-my $message = qpid::proton::Message->new();
-isa_ok($message, 'qpid::proton::Message');
-
-# Verify the message mutators.
-
-# durable
-$message->set_durable(1);
-ok($message->get_durable(), 'Durable can be set');
-$message->set_durable(0);
-ok(!$message->get_durable(), 'Durable can be unset');
-
-# priority
-my $priority = int(rand(256) + 1);
-
-dies_ok(sub {$message->set_priority('abc')}, 'Priority must be numeric');
-dies_ok(sub {$message->set_priority(0 - $priority)}, 'Priority cannot be negative');
-
-$message->set_priority(0);
-ok($message->get_priority() == 0, 'Priority can be zero');
-$message->set_priority($priority);
-ok($message->get_priority() == $priority, 'Priority can be positive');
-
-# Time to live
-my $ttl = int(rand(65535) + 1);
-
-dies_ok(sub {$message->set_ttl('def')}, 'TTL must be numeric');
-dies_ok(sub {$message->set_ttl(0 - $ttl)}, 'TTL cannot be negative');
-
-$message->set_ttl(0);
-ok($message->get_ttl() == 0, 'TTL can be zero');
-$message->set_ttl($ttl);
-ok($message->get_ttl() == $ttl, 'TTL can be postive');
-
-# first acquirer
-$message->set_first_acquirer(1);
-ok($message->get_first_acquirer(), 'First acquirer can be set');
-$message->set_first_acquirer(0);
-ok(!$message->get_first_acquirer(), 'First acquirer can be unset');
-
-# delivery count
-my $delivery_count = int(rand(65535) + 1);
-
-dies_ok(sub {$message->set_delivery_count("abc");},
- 'Messages cannot have non-numeric delivery counts');
-dies_ok(sub {$message->set_delivery_count(0 - $delivery_count)},
- 'Messages cannot have negative delivery counts');
-$message->set_delivery_count(0);
-ok($message->get_delivery_count() == 0, 'Delivery count can be zero');
-$message->set_delivery_count($delivery_count);
-ok ($message->get_delivery_count() == $delivery_count, 'Delivery count can be postiive');
-
-# message id
-my $message_id = random_string(16);
-
-dies_ok (sub {$message->set_id(undef);},
- 'Message id cannot be null');
-$message->set_id($message_id);
-ok($message->get_id(), 'Message id was set');
-ok($message->get_id() eq $message_id, 'Message id was set correctly');
-
-# user id
-my $user_id = random_string(16);
-
-dies_ok (sub {$message->set_user_id(undef);},
- 'User id cannot be null');
-$message->set_user_id($user_id);
-ok($message->get_user_id(), 'User id was set');
-ok($message->get_user_id() eq $user_id, 'User id was set correctly');
-
-# address
-my $address = "amqp://0.0.0.0";
-
-$message->set_address(undef);
-ok(!$message->get_address(), 'Address can be null');
-
-$message->set_address($address);
-ok($message->get_address() eq $address, 'Address is set correctly');
-
-# subject
-my $subject = random_string(25);
-
-$message->set_subject(undef);
-ok(!$message->get_subject(), 'Subject can be null');
-
-$message->set_subject($subject);
-ok($message->get_subject() eq $subject, 'Subject was set correctly');
-
-# reply to
-$reply_to = "amqp://0.0.0.0";
-
-$message->set_reply_to(undef);
-ok(!$message->get_reply_to(), "Reply to can be null");
-
-$message->set_reply_to($reply_to);
-ok($message->get_reply_to() eq $reply_to, 'Reply to was set correctly');
-
-# correlation id
-my $correlation_id = random_string(16);
-
-$message->set_correlation_id(undef);
-ok(!$message->get_correlation_id(), 'Correlation id can be null');
-
-$message->set_correlation_id($correlation_id);
-ok($message->get_correlation_id() eq $correlation_id,
- 'Correlation id was set correctly');
-
-# content type
-my $content_type = "text/" . random_string(12);
-
-$message->set_content_type(undef);
-ok(!$message->get_content_type(), 'Content type can be null');
-
-$message->set_content_type($content_type);
-ok($message->get_content_type() eq $content_type,
- 'Content type was set correctly');
-
-# content encoding
-my $content_encoding = random_string(16);
-
-$message->set_content_encoding(undef);
-ok(!$message->get_content_encoding(), 'Content encoding can be null');
-
-$message->set_content_encoding($content_encoding);
-ok($message->get_content_encoding() eq $content_encoding,
- 'Content encoding was set correctly');
-
-# expiry time
-my $expiry_time = random_timestamp();
-
-dies_ok(sub {$message->set_expiry_time(undef);},
- 'Expiry cannot be null');
-
-dies_ok(sub {$message->set_expiry_time(0 - $expiry_time);},
- 'Expiry cannot be negative');
-
-$message->set_expiry_time(0);
-ok($message->get_expiry_time() == 0,
- 'Expiry time can be zero');
-
-$message->set_expiry_time($expiry_time);
-ok($message->get_expiry_time() == int($expiry_time),
- 'Expiry time was set correctly');
-
-# creation time
-my $creation_time = random_timestamp();
-
-dies_ok(sub {$message->set_creation_time(undef);},
- 'Creation time cannot be null');
-
-dies_ok(sub {$message->set_creation_time(0 - $creation_time);},
- 'Creation time cannot be negative');
-
-$message->set_creation_time($creation_time);
-ok($message->get_creation_time() == $creation_time,
- 'Creation time was set correctly');
-
-# group id
-my $group_id = random_string(16);
-
-$message->set_group_id(undef);
-ok(!$message->get_group_id(), 'Group id can be null');
-
-$message->set_group_id($group_id);
-ok($message->get_group_id() eq $group_id,
- 'Group id was set correctly');
-
-# group sequence
-my $group_sequence = rand(2**31) + 1;
-
-dies_ok(sub {$message->set_group_sequence(undef);},
- 'Sequence id cannot be null');
-
-$message->set_group_sequence(0 - $group_sequence);
-ok($message->get_group_sequence() == int(0 - $group_sequence),
- 'Group sequence can be negative');
-
-$message->set_group_sequence(0);
-ok($message->get_group_sequence() == 0,
- 'Group sequence can be zero');
-
-$message->set_group_sequence($group_sequence);
-ok($message->get_group_sequence() == int($group_sequence),
- 'Group sequence can be positive');
-
-# reply to group id
-my $reply_to_group_id = random_string(16);
-
-$message->set_reply_to_group_id(undef);
-ok(!$message->get_reply_to_group_id(), 'Reply-to group id can be null');
-
-$message->set_reply_to_group_id($reply_to_group_id);
-ok($message->get_reply_to_group_id() eq $reply_to_group_id,
- 'Reply-to group id was set correctly');
-
-# format
-my @formats = ($qpid::proton::Message::DATA_FORMAT,
- $qpid::proton::Message::TEXT_FORMAT,
- $qpid::proton::Message::AMQP_FORMAT,
- $qpid::proton::Message::JSON_FORMAT);
-
-dies_ok(sub {$message->set_format(undef);}, 'Format cannot be null');
-
-foreach (@formats)
-{
- my $format = $_;
-
- $message->set_format($format);
- ok($message->get_format() == $format,
- 'Format was set correctly');
-}
-
-# reset the format
-$message->set_format($qpid::proton::Message::TEXT_FORMAT);
-
-# content
-my $content_size = rand(512);
-my $content = random_string($content_size);
-
-$message->set_content(undef);
-ok(!$message->get_content(), 'Content can be null');
-
-$message->set_content($content);
-ok($message->get_content() eq $content,
- 'Content was saved correctly');
-
http://git-wip-us.apache.org/repos/asf/qpid-proton-j/blob/2f85988e/proton-c/bindings/perl/tests/messenger.t
----------------------------------------------------------------------
diff --git a/proton-c/bindings/perl/tests/messenger.t b/proton-c/bindings/perl/tests/messenger.t
deleted file mode 100644
index 7c3ca21..0000000
--- a/proton-c/bindings/perl/tests/messenger.t
+++ /dev/null
@@ -1,129 +0,0 @@
-#!/usr/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');
-
-# Create a new message.
-my $messenger = qpid::proton::Messenger->new();
-isa_ok($messenger, 'qpid::proton::Messenger');
-
-# name
-ok($messenger->get_name(), 'Messenger has a default name');
-
-{
- my $name = random_string(16);
- my $messenger1 = qpid::proton::Messenger->new($name);
-
- ok($messenger1->get_name() eq $name, 'Messenger saves name correctly');
-}
-
-# certificate
-my $certificate = random_string(255);
-
-$messenger->set_certificate(undef);
-ok(!$messenger->get_certificate(), 'Certificate can be null');
-
-$messenger->set_certificate($certificate);
-ok($messenger->get_certificate() eq $certificate,
- 'Certificate was set correctly');
-
-# private key
-my $key = random_string(255);
-
-$messenger->set_private_key(undef);
-ok(!$messenger->get_private_key(), 'Private key can be null');
-
-$messenger->set_private_key($key);
-ok($messenger->get_private_key() eq $key, 'Private key was set correctly');
-
-# password
-my $password = random_string(64);
-
-$messenger->set_password(undef);
-ok(!$messenger->get_password(), 'Password can be null');
-
-$messenger->set_password($password);
-ok($messenger->get_password() eq $password, 'Password set correctly');
-
-# trusted certificates
-my $trusted_certificate = random_string(255);
-
-$messenger->set_trusted_certificates(undef);
-ok(!$messenger->get_trusted_certificates(), 'Trusted certificates can be null');
-
-$messenger->set_trusted_certificates($trusted_certificate);
-ok($messenger->get_trusted_certificates() eq $trusted_certificate,
- 'Trusted certificates was set correctly');
-
-# timeout
-my $timeout = rand(2**31) + 1;
-
-$messenger->set_timeout(undef);
-ok($messenger->get_timeout() == 0, 'Null timeout is treated as 0');
-
-$messenger->set_timeout(0 - $timeout);
-ok($messenger->get_timeout() == int(0 - $timeout), 'Timeout can be negative');
-
-$messenger->set_timeout(0);
-ok($messenger->get_timeout() == 0, 'Timeout can be zero');
-
-$messenger->set_timeout($timeout);
-ok($messenger->get_timeout() == int($timeout), 'Timeout can be positive');
-
-# outgoing window
-my $outgoing_window = rand(2**9);
-
-$messenger->set_outgoing_window(undef);
-ok($messenger->get_outgoing_window() == 0, 'Null outgoing window is treated as zero');
-
-$messenger->set_outgoing_window(0);
-ok($messenger->get_outgoing_window() == 0, 'Outgoing window can be zero');
-
-$messenger->set_outgoing_window(0 - $outgoing_window);
-ok($messenger->get_outgoing_window() == int(0 - $outgoing_window),
- 'Outgoing window can be negative');
-
-$messenger->set_outgoing_window($outgoing_window);
-ok($messenger->get_outgoing_window() == int($outgoing_window),
- 'Outgoing window can be positive');
-
-# incoming window
-my $incoming_window = rand(2**9);
-
-$messenger->set_incoming_window(undef);
-ok($messenger->get_incoming_window() == 0, 'Null incoming window is treated as zero');
-
-$messenger->set_incoming_window(0);
-ok($messenger->get_incoming_window() == 0, 'Incoming window can be zero');
-
-$messenger->set_incoming_window(0 - $incoming_window);
-ok($messenger->get_incoming_window() == int(0 - $incoming_window),
- 'Incoming window can be negative');
-
-$messenger->set_incoming_window($incoming_window);
-ok($messenger->get_incoming_window() == int($incoming_window),
- 'Incoming window can be positive');
-
http://git-wip-us.apache.org/repos/asf/qpid-proton-j/blob/2f85988e/proton-c/bindings/perl/tests/utils.pm
----------------------------------------------------------------------
diff --git a/proton-c/bindings/perl/tests/utils.pm b/proton-c/bindings/perl/tests/utils.pm
deleted file mode 100644
index 3f36126..0000000
--- a/proton-c/bindings/perl/tests/utils.pm
+++ /dev/null
@@ -1,60 +0,0 @@
-sub random_integers
-{
- my $len = shift;
- my @result;
-
- foreach (1..$len) {
- my $value = int(rand(100));
- push @result, $value;
- }
-
- return @result;
-}
-
-sub random_hash
-{
- my $len = shift;
- my %result;
-
- foreach (1..$len) {
- my $key = random_string(32);
- my $val = random_string(128);
- $result{$key} = $val;
- }
-
- return \%result;
-}
-
-sub random_string
-{
- my $len=$_[0];
-
- my @chars=('a'..'z','A'..'Z','0'..'9','_');
- my $result;
- foreach (1..$len) {
- $result .= $chars[rand @chars];
- }
- return $result;
-}
-
-sub random_strings
-{
- my $len = $_[0];
- my @result = ();
-
- foreach (1..$len) {
- my $strlen = rand(64) + 32;
- push(@result, random_string($strlen));
- }
-
- return @result;
-}
-
-sub random_timestamp
-{
- my $result = rand(2**63) + 1;
-
- return $result;
-}
-
-1;
http://git-wip-us.apache.org/repos/asf/qpid-proton-j/blob/2f85988e/proton-c/bindings/php/.gitignore
----------------------------------------------------------------------
diff --git a/proton-c/bindings/php/.gitignore b/proton-c/bindings/php/.gitignore
deleted file mode 100644
index 59854a6..0000000
--- a/proton-c/bindings/php/.gitignore
+++ /dev/null
@@ -1 +0,0 @@
-/php.ini
http://git-wip-us.apache.org/repos/asf/qpid-proton-j/blob/2f85988e/proton-c/bindings/php/CMakeLists.txt
----------------------------------------------------------------------
diff --git a/proton-c/bindings/php/CMakeLists.txt b/proton-c/bindings/php/CMakeLists.txt
deleted file mode 100644
index 558269d..0000000
--- a/proton-c/bindings/php/CMakeLists.txt
+++ /dev/null
@@ -1,117 +0,0 @@
-#
-# 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 Swig to generate a PHP binding to the Proton API
-##------------------------------------------------------
-
-# Uses the php-config command line tool from PHP to extract the location of the PHP header
-# files
-execute_process(COMMAND ${PHP_CONFIG_EXE} --includes
- OUTPUT_VARIABLE PHP_INCLUDES
- RESULT_VARIABLE retval
- ERROR_VARIABLE errmsg
- OUTPUT_STRIP_TRAILING_WHITESPACE)
-
-set_source_files_properties(${CMAKE_CURRENT_SOURCE_DIR}/php.i PROPERTIES SWIG_FLAGS "-I${PROJECT_SOURCE_DIR}/include")
-list(APPEND SWIG_MODULE_cproton_EXTRA_DEPS
- ${CMAKE_SOURCE_DIR}/proton-c/include/proton/cproton.i
- ${PROTON_HEADERS}
-)
-swig_add_module(cproton php ${CMAKE_CURRENT_SOURCE_DIR}/php.i)
-set_source_files_properties(${swig_generated_file_fullname} PROPERTIES COMPILE_FLAGS "${PHP_INCLUDES}")
-swig_link_libraries(cproton ${BINDING_DEPS})
-# PHP modules must be linked with unresolved symbols as they are presumably satisfied only when loaded by php itself
-set_target_properties(cproton
- PROPERTIES
- PREFIX ""
- LINK_FLAGS "${ALLOW_UNDEFINED}")
-
-if (CHECK_SYSINSTALL_PHP)
- execute_process(COMMAND ${PHP_CONFIG_EXE} --extension-dir
- OUTPUT_VARIABLE PHP_EXT_DIR_DEFAULT
- OUTPUT_STRIP_TRAILING_WHITESPACE)
- execute_process(COMMAND ${PHP_CONFIG_EXE} --prefix
- OUTPUT_VARIABLE QPHP_PREFIX
- OUTPUT_STRIP_TRAILING_WHITESPACE)
- execute_process(COMMAND ${PHP_CONFIG_EXE} --config-options
- OUTPUT_VARIABLE PHP_OPTS
- OUTPUT_STRIP_TRAILING_WHITESPACE)
-
- set(GET_INCLUDE_DIR ${CMAKE_CURRENT_SOURCE_DIR}/get_include_dir.php)
- execute_process(COMMAND ${PHP_EXE} -n ${GET_INCLUDE_DIR} ${QPHP_PREFIX}
- OUTPUT_VARIABLE PHP_INCLUDE_DIR_DEFAULT
- OUTPUT_STRIP_TRAILING_WHITESPACE)
-
- if ("${PHP_INCLUDE_DIR_DEFAULT}" STREQUAL "")
- set(PHP_INCLUDE_DIR_DEFAULT "/usr/share/php")
- endif()
-
- string(REGEX MATCH "--with-config-file-scan-dir=([^ ]*)" PHP_OPT_MATCH ${PHP_OPTS})
- set (PHP_INI_DIR_DEFAULT ${CMAKE_MATCH_1})
-
- if ("${PHP_INI_DIR_DEFAULT}" STREQUAL "")
- set(PHP_INI_DIR_DEFAULT "/etc/php.d")
- endif()
-else (CHECK_SYSINSTALL_PHP)
- set (PHP_EXT_DIR_DEFAULT ${BINDINGS_DIR}/php)
- set (PHP_INI_DIR_DEFAULT ${BINDINGS_DIR}/php)
- set (PHP_INCLUDE_DIR_DEFAULT ${BINDINGS_DIR}/php)
-endif (CHECK_SYSINSTALL_PHP)
-
-# PHP extensions directory
-if (NOT PHP_EXT_DIR)
- set (PHP_EXT_DIR ${PHP_EXT_DIR_DEFAULT})
-endif()
-# PHP ini directory
-if (NOT PHP_INI_DIR)
- set (PHP_INI_DIR ${PHP_INI_DIR_DEFAULT})
-endif()
-# PHP include directory
-if (NOT PHP_INCLUDE_DIR)
- set (PHP_INCLUDE_DIR ${PHP_INCLUDE_DIR_DEFAULT})
-endif()
-
-if (CHECK_SYSINSTALL_PHP)
- set (PROTON_INI "extension=cproton.so")
-else ()
- pn_absolute_install_dir(PHP_INCLUDE_PATH ${PHP_INCLUDE_DIR} ${CMAKE_INSTALL_PREFIX})
- pn_absolute_install_dir(PHP_EXTENSION_LIB ${PHP_EXT_DIR}/cproton.so ${CMAKE_INSTALL_PREFIX})
- set (PROTON_INI "include_path=${PHP_INCLUDE_PATH}\nextension=${PHP_EXTENSION_LIB}")
-endif()
-
-configure_file (${CMAKE_CURRENT_SOURCE_DIR}/proton.ini.in
- ${CMAKE_CURRENT_BINARY_DIR}/proton.ini
- @ONLY)
-
-install(TARGETS cproton
- DESTINATION ${PHP_EXT_DIR}
- COMPONENT PHP)
-install(FILES ${CMAKE_CURRENT_BINARY_DIR}/cproton.php
- DESTINATION ${PHP_INCLUDE_DIR}
- COMPONENT PHP)
-install(FILES ${CMAKE_CURRENT_SOURCE_DIR}/proton.php
- DESTINATION ${PHP_INCLUDE_DIR}
- COMPONENT PHP)
-
-if (NOT ${PHP_INI_DIR} STREQUAL "")
- install(FILES ${CMAKE_CURRENT_BINARY_DIR}/proton.ini
- DESTINATION ${PHP_INI_DIR}
- COMPONENT PHP)
-endif ()
http://git-wip-us.apache.org/repos/asf/qpid-proton-j/blob/2f85988e/proton-c/bindings/php/compat.swg
----------------------------------------------------------------------
diff --git a/proton-c/bindings/php/compat.swg b/proton-c/bindings/php/compat.swg
deleted file mode 100644
index d7ffce0..0000000
--- a/proton-c/bindings/php/compat.swg
+++ /dev/null
@@ -1,50 +0,0 @@
-/*
- * 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.
- */
-
-%define CONVERT_LONG_LONG_IN(lvar,t,invar)
- switch ((*(invar))->type) {
- case IS_DOUBLE:
- lvar = (t) (*(invar))->value.dval;
- break;
- case IS_STRING: {
- char * endptr;
- errno = 0;
- lvar = (t) strtoll((*(invar))->value.str.val, &endptr, 10);
- if (*endptr && !errno) break;
- /* FALL THRU */
- }
- default:
- convert_to_long_ex(invar);
- lvar = (t) (*(invar))->value.lval;
- }
-%enddef
-
-%pass_by_val(long long, CONVERT_LONG_LONG_IN);
-
-%typemap(out) long long
-%{
- if ((long long)LONG_MIN <= $1 && $1 <= (long long)LONG_MAX) {
- return_value->value.lval = (long)($1);
- return_value->type = IS_LONG;
- } else {
- char temp[256];
- sprintf(temp, "%lld", (long long)$1);
- ZVAL_STRING(return_value, temp, 1);
- }
-%}
http://git-wip-us.apache.org/repos/asf/qpid-proton-j/blob/2f85988e/proton-c/bindings/php/cproton.ini
----------------------------------------------------------------------
diff --git a/proton-c/bindings/php/cproton.ini b/proton-c/bindings/php/cproton.ini
deleted file mode 100644
index dab3941..0000000
--- a/proton-c/bindings/php/cproton.ini
+++ /dev/null
@@ -1,21 +0,0 @@
-;;
-; 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.
-;;
-
-; Enable cproton extension module
-extension=cproton.so
---------------------------------------------------------------------
To unsubscribe, e-mail: commits-unsubscribe@qpid.apache.org
For additional commands, e-mail: commits-help@qpid.apache.org