From commits-return-44248-archive-asf-public=cust-asf.ponee.io@qpid.apache.org Tue Mar 20 19:33:40 2018 Return-Path: X-Original-To: archive-asf-public@cust-asf.ponee.io Delivered-To: archive-asf-public@cust-asf.ponee.io Received: from mail.apache.org (hermes.apache.org [140.211.11.3]) by mx-eu-01.ponee.io (Postfix) with SMTP id B49A118077A for ; Tue, 20 Mar 2018 19:33:37 +0100 (CET) Received: (qmail 92007 invoked by uid 500); 20 Mar 2018 18:33:36 -0000 Mailing-List: contact commits-help@qpid.apache.org; run by ezmlm Precedence: bulk List-Help: List-Unsubscribe: List-Post: List-Id: Reply-To: dev@qpid.apache.org Delivered-To: mailing list commits@qpid.apache.org Received: (qmail 91851 invoked by uid 99); 20 Mar 2018 18:33:36 -0000 Received: from git1-us-west.apache.org (HELO git1-us-west.apache.org) (140.211.11.23) by apache.org (qpsmtpd/0.29) with ESMTP; Tue, 20 Mar 2018 18:33:36 +0000 Received: by git1-us-west.apache.org (ASF Mail Server at git1-us-west.apache.org, from userid 33) id 2A38AF670D; Tue, 20 Mar 2018 18:33:36 +0000 (UTC) Content-Type: text/plain; charset="us-ascii" MIME-Version: 1.0 Content-Transfer-Encoding: 7bit From: jross@apache.org To: commits@qpid.apache.org Date: Tue, 20 Mar 2018 18:33:39 -0000 Message-Id: <8ad422f05f1f436b8dfa49f94b108661@git.apache.org> In-Reply-To: <56df3dae204c49cd88a971cc0fbde2bd@git.apache.org> References: <56df3dae204c49cd88a971cc0fbde2bd@git.apache.org> X-Mailer: ASF-Git Admin Mailer Subject: [4/9] qpid-proton git commit: PROTON-1799: Remove deprecated bindings and APIs http://git-wip-us.apache.org/repos/asf/qpid-proton/blob/0c9bb9ff/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. If unspecified, the body type will default to -B. - -=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/blob/0c9bb9ff/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/blob/0c9bb9ff/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/blob/0c9bb9ff/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 object specified -using the specified B value. If the array is described (def. undescribed) -then the supplied B 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. - -If the array is B then the I 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. - -=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/blob/0c9bb9ff/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/blob/0c9bb9ff/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/blob/0c9bb9ff/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 -#include -#include -#include -#include -#include -#include -#include -%} - -%include - -%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/blob/0c9bb9ff/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/blob/0c9bb9ff/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/blob/0c9bb9ff/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 45277a6..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 from a 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/blob/0c9bb9ff/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 d907207..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 positive'); - -# 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 positive'); - -# 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/blob/0c9bb9ff/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/blob/0c9bb9ff/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/blob/0c9bb9ff/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/blob/0c9bb9ff/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 696dc38..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_library(cproton LANGUAGE php SOURCES 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/blob/0c9bb9ff/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/blob/0c9bb9ff/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