diff options
Diffstat (limited to 'cpp/bindings/qpid/perl')
20 files changed, 3437 insertions, 5 deletions
diff --git a/cpp/bindings/qpid/perl/CMakeLists.txt b/cpp/bindings/qpid/perl/CMakeLists.txt index 0d66c144db..a1380fa4d0 100644 --- a/cpp/bindings/qpid/perl/CMakeLists.txt +++ b/cpp/bindings/qpid/perl/CMakeLists.txt @@ -21,18 +21,25 @@ ## Use Swig to generate a literal binding to the C++ API ##------------------------------------------------------ set_source_files_properties(${CMAKE_CURRENT_SOURCE_DIR}/perl.i PROPERTIES CPLUSPLUS ON) -set_source_files_properties(${CMAKE_CURRENT_SOURCE_DIR}/perl.i PROPERTIES SWIG_FLAGS "-I${qpid-cpp_SOURCE_DIR}/include") +set_source_files_properties(${CMAKE_CURRENT_SOURCE_DIR}/perl.i + PROPERTIES SWIG_FLAGS "-I${qpid-cpp_SOURCE_DIR}/include;-I${qpid-cpp_SOURCE_DIR}/include;-I${qpid-cpp_SOURCE_DIR}/bindings") swig_add_module(cqpid_perl perl ${CMAKE_CURRENT_SOURCE_DIR}/perl.i) swig_link_libraries(cqpid_perl qpidmessaging qpidtypes qmf2 ${PERL_LIBRARY}) -set_source_files_properties(${swig_generated_file_fullname} PROPERTIES COMPILE_FLAGS "-fno-strict-aliasing -I${PERL_INCLUDE_PATH} -I${qpid-cpp_SOURCE_DIR}/include") +set_source_files_properties(${swig_generated_file_fullname} PROPERTIES COMPILE_FLAGS "-fno-strict-aliasing") +include_directories(${PERL_INCLUDE_PATH} + ${qpid-cpp_SOURCE_DIR}/include + ${qpid-cpp_SOURCE_DIR}/bindings) ##---------------------------------- ## Install the complete Perl binding ##---------------------------------- install(FILES ${CMAKE_CURRENT_BINARY_DIR}/libcqpid_perl.so ${CMAKE_CURRENT_BINARY_DIR}/cqpid_perl.pm - DESTINATION ${PERL_ARCHLIB} + ${CMAKE_CURRENT_SOURCE_DIR}/qpid.pm + ${CMAKE_CURRENT_SOURCE_DIR}/LICENSE + ${CMAKE_CURRENT_SOURCE_DIR}/Makefile.PL + DESTINATION ${PERL_PFX_ARCHLIB} COMPONENT ${QPID_COMPONENT_CLIENT} ) diff --git a/cpp/bindings/qpid/perl/ChangeLog b/cpp/bindings/qpid/perl/ChangeLog new file mode 100644 index 0000000000..72685443b1 --- /dev/null +++ b/cpp/bindings/qpid/perl/ChangeLog @@ -0,0 +1,6 @@ +Version 0.22 (TBA): + * QPID-4466: qpid::messaging::Duration now supports multiplication + * QPID-4416: Messages with embedded nulls won't break on getContentPtr + * QPID-4505: Provides unit tests for Address, Duration and Message + * QPID-4504: Broke up the Per classes into separate source modules + * QPID-4580: Added perldoc markup to each source module diff --git a/cpp/bindings/qpid/perl/LICENSE b/cpp/bindings/qpid/perl/LICENSE new file mode 100644 index 0000000000..bc46b77047 --- /dev/null +++ b/cpp/bindings/qpid/perl/LICENSE @@ -0,0 +1,206 @@ +========================================================================= +== Apache License == +========================================================================= + + Apache License + Version 2.0, January 2004 + http://www.apache.org/licenses/ + + TERMS AND CONDITIONS FOR USE, REPRODUCTION, AND DISTRIBUTION + + 1. Definitions. + + "License" shall mean the terms and conditions for use, reproduction, + and distribution as defined by Sections 1 through 9 of this document. + + "Licensor" shall mean the copyright owner or entity authorized by + the copyright owner that is granting the License. + + "Legal Entity" shall mean the union of the acting entity and all + other entities that control, are controlled by, or are under common + control with that entity. For the purposes of this definition, + "control" means (i) the power, direct or indirect, to cause the + direction or management of such entity, whether by contract or + otherwise, or (ii) ownership of fifty percent (50%) or more of the + outstanding shares, or (iii) beneficial ownership of such entity. + + "You" (or "Your") shall mean an individual or Legal Entity + exercising permissions granted by this License. + + "Source" form shall mean the preferred form for making modifications, + including but not limited to software source code, documentation + source, and configuration files. + + "Object" form shall mean any form resulting from mechanical + transformation or translation of a Source form, including but + not limited to compiled object code, generated documentation, + and conversions to other media types. + + "Work" shall mean the work of authorship, whether in Source or + Object form, made available under the License, as indicated by a + copyright notice that is included in or attached to the work + (an example is provided in the Appendix below). + + "Derivative Works" shall mean any work, whether in Source or Object + form, that is based on (or derived from) the Work and for which the + editorial revisions, annotations, elaborations, or other modifications + represent, as a whole, an original work of authorship. For the purposes + of this License, Derivative Works shall not include works that remain + separable from, or merely link (or bind by name) to the interfaces of, + the Work and Derivative Works thereof. + + "Contribution" shall mean any work of authorship, including + the original version of the Work and any modifications or additions + to that Work or Derivative Works thereof, that is intentionally + submitted to Licensor for inclusion in the Work by the copyright owner + or by an individual or Legal Entity authorized to submit on behalf of + the copyright owner. For the purposes of this definition, "submitted" + means any form of electronic, verbal, or written communication sent + to the Licensor or its representatives, including but not limited to + communication on electronic mailing lists, source code control systems, + and issue tracking systems that are managed by, or on behalf of, the + Licensor for the purpose of discussing and improving the Work, but + excluding communication that is conspicuously marked or otherwise + designated in writing by the copyright owner as "Not a Contribution." + + "Contributor" shall mean Licensor and any individual or Legal Entity + on behalf of whom a Contribution has been received by Licensor and + subsequently incorporated within the Work. + + 2. Grant of Copyright License. Subject to the terms and conditions of + this License, each Contributor hereby grants to You a perpetual, + worldwide, non-exclusive, no-charge, royalty-free, irrevocable + copyright license to reproduce, prepare Derivative Works of, + publicly display, publicly perform, sublicense, and distribute the + Work and such Derivative Works in Source or Object form. + + 3. Grant of Patent License. Subject to the terms and conditions of + this License, each Contributor hereby grants to You a perpetual, + worldwide, non-exclusive, no-charge, royalty-free, irrevocable + (except as stated in this section) patent license to make, have made, + use, offer to sell, sell, import, and otherwise transfer the Work, + where such license applies only to those patent claims licensable + by such Contributor that are necessarily infringed by their + Contribution(s) alone or by combination of their Contribution(s) + with the Work to which such Contribution(s) was submitted. If You + institute patent litigation against any entity (including a + cross-claim or counterclaim in a lawsuit) alleging that the Work + or a Contribution incorporated within the Work constitutes direct + or contributory patent infringement, then any patent licenses + granted to You under this License for that Work shall terminate + as of the date such litigation is filed. + + 4. Redistribution. You may reproduce and distribute copies of the + Work or Derivative Works thereof in any medium, with or without + modifications, and in Source or Object form, provided that You + meet the following conditions: + + (a) You must give any other recipients of the Work or + Derivative Works a copy of this License; and + + (b) You must cause any modified files to carry prominent notices + stating that You changed the files; and + + (c) You must retain, in the Source form of any Derivative Works + that You distribute, all copyright, patent, trademark, and + attribution notices from the Source form of the Work, + excluding those notices that do not pertain to any part of + the Derivative Works; and + + (d) If the Work includes a "NOTICE" text file as part of its + distribution, then any Derivative Works that You distribute must + include a readable copy of the attribution notices contained + within such NOTICE file, excluding those notices that do not + pertain to any part of the Derivative Works, in at least one + of the following places: within a NOTICE text file distributed + as part of the Derivative Works; within the Source form or + documentation, if provided along with the Derivative Works; or, + within a display generated by the Derivative Works, if and + wherever such third-party notices normally appear. The contents + of the NOTICE file are for informational purposes only and + do not modify the License. You may add Your own attribution + notices within Derivative Works that You distribute, alongside + or as an addendum to the NOTICE text from the Work, provided + that such additional attribution notices cannot be construed + as modifying the License. + + You may add Your own copyright statement to Your modifications and + may provide additional or different license terms and conditions + for use, reproduction, or distribution of Your modifications, or + for any such Derivative Works as a whole, provided Your use, + reproduction, and distribution of the Work otherwise complies with + the conditions stated in this License. + + 5. Submission of Contributions. Unless You explicitly state otherwise, + any Contribution intentionally submitted for inclusion in the Work + by You to the Licensor shall be under the terms and conditions of + this License, without any additional terms or conditions. + Notwithstanding the above, nothing herein shall supersede or modify + the terms of any separate license agreement you may have executed + with Licensor regarding such Contributions. + + 6. Trademarks. This License does not grant permission to use the trade + names, trademarks, service marks, or product names of the Licensor, + except as required for reasonable and customary use in describing the + origin of the Work and reproducing the content of the NOTICE file. + + 7. Disclaimer of Warranty. Unless required by applicable law or + agreed to in writing, Licensor provides the Work (and each + Contributor provides its Contributions) on an "AS IS" BASIS, + WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or + implied, including, without limitation, any warranties or conditions + of TITLE, NON-INFRINGEMENT, MERCHANTABILITY, or FITNESS FOR A + PARTICULAR PURPOSE. You are solely responsible for determining the + appropriateness of using or redistributing the Work and assume any + risks associated with Your exercise of permissions under this License. + + 8. Limitation of Liability. In no event and under no legal theory, + whether in tort (including negligence), contract, or otherwise, + unless required by applicable law (such as deliberate and grossly + negligent acts) or agreed to in writing, shall any Contributor be + liable to You for damages, including any direct, indirect, special, + incidental, or consequential damages of any character arising as a + result of this License or out of the use or inability to use the + Work (including but not limited to damages for loss of goodwill, + work stoppage, computer failure or malfunction, or any and all + other commercial damages or losses), even if such Contributor + has been advised of the possibility of such damages. + + 9. Accepting Warranty or Additional Liability. While redistributing + the Work or Derivative Works thereof, You may choose to offer, + and charge a fee for, acceptance of support, warranty, indemnity, + or other liability obligations and/or rights consistent with this + License. However, in accepting such obligations, You may act only + on Your own behalf and on Your sole responsibility, not on behalf + of any other Contributor, and only if You agree to indemnify, + defend, and hold each Contributor harmless for any liability + incurred by, or claims asserted against, such Contributor by reason + of your accepting any such warranty or additional liability. + + END OF TERMS AND CONDITIONS + + APPENDIX: How to apply the Apache License to your work. + + To apply the Apache License to your work, attach the following + boilerplate notice, with the fields enclosed by brackets "[]" + replaced with your own identifying information. (Don't include + the brackets!) The text should be enclosed in the appropriate + comment syntax for the file format. We also recommend that a + file or class name and description of purpose be included on the + same "printed page" as the copyright notice for easier + identification within third-party archives. + + Copyright [yyyy] [name of copyright owner] + + Licensed 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. + diff --git a/cpp/bindings/qpid/perl/Makefile.PL b/cpp/bindings/qpid/perl/Makefile.PL new file mode 100644 index 0000000000..7a4d7f03dc --- /dev/null +++ b/cpp/bindings/qpid/perl/Makefile.PL @@ -0,0 +1,13 @@ +#!/usr/bin/perl -w + +use strict; + +use ExtUtils::MakeMaker; +use Config; + +WriteMakefile( + NAME => 'cqpid_perl', + PREREQ_PM => {}, + LIBS => ["-lqpidmessaging -lqpidtypes"], + C => ['cqpid_perl.cpp'], +); diff --git a/cpp/bindings/qpid/perl/README b/cpp/bindings/qpid/perl/README new file mode 100644 index 0000000000..ca5a96e539 --- /dev/null +++ b/cpp/bindings/qpid/perl/README @@ -0,0 +1,15 @@ +Qpid Perl Language Bindings +=========================== + +How to get help +=============== + +You can use the perldoc command to display API help for working with Qpid. + + perldoc qpid_messaging.pm + +will show a simple example application written in Perl that uses the APIs. +From there you can display the individual module documentation by typing: + + perldoc [module] + diff --git a/cpp/bindings/qpid/perl/lib/qpid/messaging/Address.pm b/cpp/bindings/qpid/perl/lib/qpid/messaging/Address.pm new file mode 100644 index 0000000000..d417770b1c --- /dev/null +++ b/cpp/bindings/qpid/perl/lib/qpid/messaging/Address.pm @@ -0,0 +1,338 @@ +# +# 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::messaging::Address + +=head1 DESCRIPTION + +An B<Address> represents an address to which messages can be sent or +from which they can be received. + +=head2 THE ADDRESS STRING + +An address can be described suing the following pattern: + +E<lt>addressE<gt> [ / E<lt>subjectE<gt> ]= ; [ { E<lt>keyE<gt> : E<lt>valueE<gt> , ... } ] + +where B<address> is a simple name and B<subject> is a subject or subject +pattern. + +=head3 ADDRESS OPTIONS + +The options, encluded in curly braces, are key:value pairs delimited by a comma. +The values can be nested maps also enclosed in curly braces. Or they can be +lists of values, where they are contained within square brackets but still comma +delimited, such as: + + [value1,value2,value3] + +The following are the list of supported options: + +=over + +=item B<create> + +Indicates if the address should be created; values are B<always>, B<never>, +B<sender> or B<receiver> + +=item B<assert> + +Indicates whether or not to assert any specified node properties; values are +B<always>, B<never>, B<sender> or B<receiver> + +=item B<delete> + +Indicates whether or not to delete the addressed node when a sender or receiver +is cancelled; values are B<always>, B<never>, B<sender> or B<receiver> + +=item B<node> + +A nested map describing properties for the addressed node. Properties are +B<type> (B<topic> or B<queue>), B<durable> (a boolean), B<x-declare> (a nested +map of AMQP 0.10-specific options) and B<x-bindings> (a nested list which +specifies a queue, exchange or a binding key and arguments). + +=item B<link> + +=item B<mode> + +=back + +=cut + +package qpid::messaging::Address; + +use overload ( + 'bool' => \& boolify, + '""' => \& stringify, + ); + +sub boolify { + my ($self) = @_; + my $impl = $self->{_impl}; + + return length($impl->getName()); +} + +sub stringify { + my ($self) = @_; + my $impl = $self->{_impl}; + + return $self->str(); +} + +sub str { + my ($self) = @_; + + return $self->get_implementation()->str(); +} + +=pod + +=head1 CONSTRUCTOR + +Creates an B<Address> + +=over + +=item $address = new qpid::messaging::Address( addr ) + +=back + +=head3 ARGUMENTS + +=over + +=item * addr + +The address string. + +=back + +=cut +sub new { + my ($class) = @_; + my ($self) = {}; + + # 2 args: either a string address or a cqpid_perl::Address + # 3+ args: name + subject + options + type + if (@_ eq 2) { + my $address = $_[1]; + + if (ref($address) eq 'cqpid_perl::Address') { + $self->{_impl} = $address; + } else { + $self->{_impl} = new cqpid_perl::Address($_[1]); + } + } elsif (@_ >= 4) { + my $impl = new cqpid_perl::Address($_[1], $_[2], $_[3]); + + $impl->setType($_[4]) if @_ >= 5; + + $self->{_impl} = $impl; + } else { + die "You must specify an address." + } + + bless $self, $class; + return $self; +} + +sub get_implementation { + my ($self) = @_; + return $self->{_impl}; +} + +=pod + +=head1 ATTRIBUTES + +=cut + +=pod + +=head2 NAME + +The name portion of the address. + +=over + +=item $address->set_name( name ) + +=item $name = $address->get_name + +=back + +=head3 ARGUMENTS + +=over + +=item * name + +See the address string explanation. + +=back + +=cut +sub set_name { + my ($self) = @_; + my $impl = $self->{_impl}; + + $impl->setName($_[1]); +} + +sub get_name { + my ($self) = @_; + my $impl = $self->{_impl}; + + return $impl->getName(); +} + +=pod + +=head2 SUBJECT + +The subject portion of the address. + +=over + +=item $address->set_subject( subject ) + +=item $subject = $address->get_subject + +=back + +=head3 ARGUMENTS + +=over + +=item * subject + +See the address string explanation. + +=back + +=cut +sub set_subject { + my ($self) = @_; + my $impl = $self->{_impl}; + + $impl->setSubject($_[1]); +} + +sub get_subject { + my ($self) = @_; + my $impl = $self->{_impl}; + + return $impl->getSubject; +} + +=pod + +=head2 OPTIONS + +The address options. + +=over + +=item $address->set_options( options ) + +=item @opts = $address->get_options + +=back + +=head3 ARGUMENTS + +=over + +=item * options + +The set of name:value pairs for the address. See the address string explanation. + +=back + +=cut +sub set_options { + my ($self) = @_; + my $impl = $self->{_impl}; + my $options = $_[1]; + + die "Options cannot be null" if !defined($options); + + $impl->setOptions($_[1]); +} + +sub get_options { + my ($self) = @_; + my $impl = $self->{_impl}; + + return $impl->getOptions; +} + +=pod + +=head2 TYPE + +The type of the address determines how B<Sender> and B<Receiver> objects are +constructed for it. It also affects how a b<reply-to> address is encoded. + +If no type is specified then it willb e determined by querying the broker. +Explicitly setting the type prevents this. + +=over + +=item $address->set_type( type ) + +=item $type = $address->get_type + +=back + +=head3 ARGUMENTS + +=over + +=item * type + +Values can be either B<queue> or B<type>. + +=back + +=cut +sub set_type { + my ($self) = @_; + my $impl = $self->{_impl}; + my $type = $_[1]; + + die "Type must be defined" if !defined($type); + + $impl->setType($type); +} + +sub get_type { + my ($self) = @_; + my $impl = $self->{_impl}; + + return $impl->getType; +} + +1; diff --git a/cpp/bindings/qpid/perl/lib/qpid/messaging/Connection.pm b/cpp/bindings/qpid/perl/lib/qpid/messaging/Connection.pm new file mode 100644 index 0000000000..6d478cdf0c --- /dev/null +++ b/cpp/bindings/qpid/perl/lib/qpid/messaging/Connection.pm @@ -0,0 +1,291 @@ +# +# 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::messaging::Connection + +=head1 DESCRIPTION + +A B<qpid::messaging::Connection> represents a network connection to a remote +endpoint. + +=cut + +package qpid::messaging::Connection; + +=pod + +=head1 CONSTRUCTOR + +=over + +=item $conn = new qpid::messaging::Connection + +=item $conn = new qpid::messaging::Connection( url ) + +=item $conn = new qpid::messaging::Connection( url, options ) + +Creates a connection object. Raises a C<MessagingError> if an invalid +connection option is used. + +=back + +=head3 ARGUMENTS + +=over + +=item * url + +The URL for the broker. See B<qpid::messaging::Address> for more on + address strings + +=item * options + +The connection options. + +=back + +=cut + +sub new { + my ($class) = @_; + my $self = { + _url => $_[1] || "localhost:5672", + _options => $_[2] || {}, + _impl => $_[3], + }; + + bless $self, $class; + return $self; +} + +=pod + +=head1 ACTIONS + +=cut + + +=pod + +=head2 OPENING AND CLOSING CONNECTIONS + +=cut + + +=pod + +=over + +=item $conn->open + +Establishes the connection to the broker. + +=back + +=cut +sub open { + my ($self) = @_; + my $impl = $self->{_impl}; + + # if we have an implementation instance then use it, otherwise + # create a new implementation instance + unless (defined($impl)) { + my $url = $self->{_url}; + my ($options) = $self->{_options}; + + $impl = new cqpid_perl::Connection($url, $options); + $self->{_impl} = $impl + } + + $impl->open() unless $impl->isOpen() +} + +=pod + +=over + +=item $conn->is_open + +Reports whether the connection is open. + +=back + +=cut +sub is_open { + my ($self) = @_; + my $impl = $self->{_impl}; + + if (defined($impl) && $impl->isOpen()) { + 1; + } else { + 0; + } +} + +=pod + +=over + +=item $conn->close + +Closes the connection. + +=back + +=cut +sub close { + my ($self) = @_; + + if ($self->is_open) { + my $impl = $self->{_impl}; + + $impl->close; + $self->{_impl} = undef; + } +} + +=pod + +=head2 SESSIONS + +=cut + + +=pod + +=over + +=item $session = $conn->create_session + +=item $conn->create_session( name ) + +Creates a new session. + +=back + +=head3 ARGUMENTS + +=over + +=item * name + +Specifies a name for the session. + +=back + +=cut +sub create_session { + my ($self) = @_; + + die "No connection available." unless ($self->open); + + my $impl = $self->{_impl}; + my $name = $_[1] || ""; + my $session = $impl->createSession($name); + + return new qpid::messaging::Session($session, $self); +} + +=pod + +=over + +=item $session = $conn->create_transactional_session + +=item $session = $conn->create_transaction_session( name ) + +Creates a transactional session. + +=back + +=head3 ARGUMENTS + +=over + +=item * name + +Specifies a name for the session. + +=back + +=cut +sub create_transactional_session { + my ($self) = @_; + + die "No connection available." unless ($self->open); + + my $impl = $self->{_impl}; + my $name = $_[1] || ""; + my $session = $impl->createTransactionalSession($name); + + return new qpid::messaging::Session($session, $self); +} + +=pod + +=over + +=item $session = $conn->get_session( name ) + +Returns the session with the specified name. + +=over + +=item $name + +The name given to the session when it was created. + +=back + +=back + +=cut +sub get_session { + my ($self) = @_; + my $impl = $self->{_impl}; + + return $impl->getSession($_[1]); +} + +=pod + +=over + +=item $uname = $conn->get_authenticated_username + +Returns the username user to authenticate with the broker. + +If the conneciton did not use authentication credentials, then the +username returned is "anonymous". + +=back + +=cut +sub get_authenticated_username { + my ($self) = @_; + my $impl = $self->{_impl}; + + return $impl->getAuthenticatedUsername; +} + +1; diff --git a/cpp/bindings/qpid/perl/lib/qpid/messaging/Duration.pm b/cpp/bindings/qpid/perl/lib/qpid/messaging/Duration.pm new file mode 100644 index 0000000000..7d05daeeab --- /dev/null +++ b/cpp/bindings/qpid/perl/lib/qpid/messaging/Duration.pm @@ -0,0 +1,204 @@ +# +# 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::messaging::Duration + +=head1 DESCRIPTION + +A B<qpid::messaging::Duration> represents a period of time in milliseconds. + +=head1 NAMED DURATIONS + +The following named durations are available as constants + +=over + +=item B<FOREVER> + +The maximum wait time, equal to the maximum integer value for the platform. +Effective this will wait forever. + +=item B<IMMEDIATE> + +An alias for 0 milliseconds. + +=item B<SECOND> + +An alias for 1,000 milliseconds. + +=item B<MINUTE> + +An alias for 60,000 milliseconds. + +=back + +=cut + +package qpid::messaging::Duration; + +=pod + +=head1 OPERATORS + +=cut + +use overload ( + "*" => \&multiply, + "==" => \&equalify, + "!=" => \&unequalify, + ); + +=pod + +=over + +=item $doubled = $duration * $factor + +=item $doubled = $duration * 2 + +Multiplies the duration and returns a new instance. + +=over + +=item $factor + +A factor for multiplying the duration. + +=back + +=back + +=cut +sub multiply { + my ($self) = @_; + my $factor = $_[1]; + + die "Factor must be non-negative values" if !defined($factor) || ($factor < 0); + + my $duration = $self->{_impl} * $factor; + + return new qpid::messaging::Duration($duration); +} + +sub equalify { + my ($self) = @_; + my $that = $_[1]; + + return 0 if !defined($that) || !UNIVERSAL::isa($that, 'qpid::messaging::Duration');; + + return ($self->get_milliseconds() == $that->get_milliseconds()) ? 1 : 0; +} + +sub unequalify { + my ($self) = @_; + my $that = $_[1]; + + return 1 if !defined($that) || !UNIVERSAL::isa($that, 'qpid::messaging::Duration');; + + return ($self->get_milliseconds() != $that->get_milliseconds()) ? 1 : 0; +} + +=pod + +=head1 CONSTRUCTOR + +Creates a new instance. + +=over + +=item duration = new qpid::messaging::Duration( time ) + +=back + +=head3 ARGUMENTS + +=over + +=item * time + +The duration in B<milliseconds>. + +=back + +=cut +sub new { + my ($class) = @_; + my $duration = $_[1]; + + die "Duration time period must be defined" if !defined($duration); + + if (!UNIVERSAL::isa($duration, 'cqpid_perl::Duration')) { + die "Duration must be non-negative" if $duration < 0; + $duration = new cqpid_perl::Duration($duration); + } + + my ($self) = { + _impl => $duration, + }; + + bless $self, $class; + return $self; +} + +=pod + +=head1 ATTRIBUTES + +=cut + + +=pod + +=head2 MILLISECONDS + +The length of time is measured in milliseconds. + +=over + +=item time = $duration->get_milliseconds + +=back + +=cut +sub get_milliseconds { + my ($self) = @_; + my $impl = $self->{_impl}; + + return $impl->getMilliseconds(); +} + +sub get_implementation { + my ($self) = @_; + + return $self->{_impl}; +} + +# TODO: Need a better way to define FOREVER +use constant { + FOREVER => new qpid::messaging::Duration(1000000), + IMMEDIATE => new qpid::messaging::Duration(0), + SECOND => new qpid::messaging::Duration(1000), + MINUTE => new qpid::messaging::Duration(60000), +}; + +1; diff --git a/cpp/bindings/qpid/perl/lib/qpid/messaging/Message.pm b/cpp/bindings/qpid/perl/lib/qpid/messaging/Message.pm new file mode 100644 index 0000000000..6437290244 --- /dev/null +++ b/cpp/bindings/qpid/perl/lib/qpid/messaging/Message.pm @@ -0,0 +1,584 @@ +# +# 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::messaging::Message + +=head1 DESCRIPTION + +A B<qpid::messaging::Message> a routable piece of information. + +=cut + +package qpid::messaging::Message; + + +=pod + +=head1 CONSTRUCTOR + +Creates a B<Message>. + +=over + +=item $msg = new qpid::messaging::Message + +=item $msg = new qpid::messaging::Message( $content ) + +=back + +=head3 ARGUMENTS + +=over + +=item * $content + +The message's content. + +=back + +=cut +sub new { + my ($class) = @_; + my $content = $_[1] if (@_ > 1); + my $impl = $_[2] if (@_ > 2); + my ($self) = { + _content => $content || "", + _impl => $impl || undef, + }; + + unless (defined($self->{_impl})) { + my $impl = new cqpid_perl::Message($self->{_content}); + + $self->{_impl} = $impl; + } + + bless $self, $class; + return $self; +} + +sub get_implementation { + my ($self) = @_; + + return $self->{_impl}; +} + + +=pod + +=head1 ATTRIBUTES + +=cut + +=pod + +=head2 REPLY TO ADDRESS + +The reply-to address tells a receiver where to send any responses. + +=over + +=item $msg->set_reply_to( "#reqly-queue;{create:always}" ) + +=item $msg->set_reply_to( address ) + +=item $address = $msg->get_reply_to + +=back + +=head3 ARGUMENTS + +=over + +=item * address + +The address. Can be either an instance of B<qpid::messaging::Address> or else an +address string. + +=back + +=cut +sub set_reply_to { + my ($self) = @_; + my $impl = $self->{_impl}; + my $address = $_[1]; + + # if the address was a string, then wrap it + # in a qpid::messaging::Address instance + if (!UNIVERSAL::isa($address, 'qpid::messaging::Address')) { + $address = new qpid::messaging::Address($_[1]); + } + + $impl->setReplyTo($address->get_implementation()); +} + +sub get_reply_to { + my ($self) = @_; + my $impl = $self->{_impl}; + + return new qpid::messaging::Address($impl->getReplyTo()); +} + +=pod + +=head2 SUBJECT + +=over + +=item $msg->set_subject( "responses" ) + +=item $msg->set_subject( subject ) + +=item $subject = $msg->get_subject + +=back + +=cut +sub set_subject { + my ($self) = @_; + my $impl = $self->{_impl}; + + $impl->setSubject($_[1]); +} + +sub get_subject { + my ($self) = @_; + my $impl = $self->{_impl}; + + return $impl->getSubject; +} + +=pod + +=head2 CONTENT TYPE + +This should be set by the sending application and indicates to the +recipients of the message how to interpret or decide the content. + +By default, only dictionaries and maps are automatically given a content +type. If this content type is replaced then retrieving the content will +not behave correctly. + +=over + +=item $msg->set_content_type( content_type ) + +=back + +=head3 ARGUMENTS + +=over + +=item * content_type + +The content type. For a list this would be C<amqp/list> and for a hash it is +C<amqp/map>. + +=back + +=cut +sub set_content_type { + my ($self) = @_; + my $type = $_[1]; + + my $impl = $self->{_impl}; + $impl->setContentType($type); +} + +sub get_content_type { + my ($self) = @_; + my $impl = $self->{_impl}; + + return $impl->getContentType; +} + +=pod + +=head2 MESSAGE ID + +A message id must be a UUID type. A non-UUID value will be converted +to a zero UUID, thouygh a blank ID will be left untouched. + +=over + +=item $msg->set_message_id( id ) + +=item $id = $msg->get_message_id + +=back + +=cut +sub set_message_id { + my ($self) = @_; + my $impl = $self->{_impl}; + my $id = $_[1]; + + die "message id must be defined" if !defined($id); + + $impl->setMessageId($id); +} + +sub get_message_id { + my ($self) = @_; + my $impl = $self->{_impl}; + + return $impl->getMessageId; +} + +=pod + +=head2 USER ID + +The user id should, in general, be the user-id which was used when +authenticating the connection itself, as the messaging infrastructure +will verify this. + +See B<qpid::messaging::Address#authenticated_username>. + +=over + +=item $msg->set_user_id( id ) + +=item $id = $msg->get_user_id + +=back + +=cut +sub set_user_id { + my ($self) = @_; + my $impl = $self->{_impl}; + + $impl->setUserId($_[1]); +} + +sub get_user_id { + my ($self) = @_; + my $impl = $self->{_impl}; + + return $impl->getUserId; +} + +=pod + +=head2 CORRELATION ID + +The correlation id can be used as part of a protocol for message exchange +patterns; e.g., a request-response pattern might require the correlation id +of the request and hte response to match, or it might use the message id of +the request as the correlation id on the response. + +B<NOTE:> If the id is not a string then the id is setup using the object's +string representation. + +=over + +=item $msg->set_correlation_id( id ) + +=item $id = $msg->get_correlation_id + +=back + +=cut +sub set_correlation_id { + my ($self) = @_; + my $impl = $self->{_impl}; + + $impl->setCorrelationId($_[1]); +} + +sub get_correlation_id { + my ($self) = @_; + my $impl = $self->{_impl}; + + return $impl->getCorrelationId; +} + +=pod + +=head2 PRIORITY + +The priority may be used by the messaging infrastructure to prioritize +delivery of messages with higher priority. + +B<NOTE:> If the priority is not an integer type then it is set using the +object's integer represtation. If the integer value is greater than an +8-bit value then only 8-bits are used. + +=over + +=item $msg->set_priority( priority ) + +=item $priority = $msg->get_priority + +=back + +=cut +sub set_priority { + my ($self) = @_; + my $impl = $self->{_impl}; + my $priority = $_[1]; + + die "Priority must be provided" if !defined($priority); + + $priority = int($priority); + die "Priority must be non-negative" if $priority < 0; + + $impl->setPriority($priority); +} + +sub get_priority { + my ($self) = @_; + my $impl = $self->{_impl}; + + return $impl->getPriority; +} + +=pod + +=head2 TIME TO LIVE + +This can be used by the messaging infrastructure to discard messages +that are no longer of relevance. + +=over + +=item $msg->set_ttl( ttl ) + +=item $ttl = $msg->get_ttl + +=back + +=head3 ARGUMENTS + +=over + +=item * ttl + +A B<qpid::messaging::Duration> instance. If it is not, then a new instance +is created using the integer value for the argument. + +A B<negative> value is treated as the equipment of +B<qpid::messaging::Duration::FOREVER>. + +=back + +=cut +sub set_ttl { + my ($self) = @_; + my $impl = $self->{_impl}; + my $duration = $_[1]; + + die "Duration must be provided" if !defined($duration); + if (!UNIVERSAL::isa($duration, 'qpid::messaging::Duration')) { + $duration = int($duration); + + if ($duration < 0) { + $duration = qpid::messaging::Duration::FOREVER; + } elsif ($duration == 0) { + $duration = qpid::messaging::Duration::IMMEDIATE; + } else { + $duration = new qpid::messaging::Duration(int($duration)); + } + } + + $impl->setTtl($duration->get_implementation()); +} + +sub get_ttl { + my ($self) = @_; + my $impl = $self->{_impl}; + + return new qpid::messaging::Duration($impl->getTtl); +} + +=pod + +=head2 DURABILITY + +The durability of a B<Message> is a hint to the messaging infrastructure that +the message should be persisted or otherwise stored. This helps to ensure that +the message is not lost due to failures or a shutdown. + +=over + +=item $msg->set_durable( 1 ) + +=item $durable = $msg->get_durable + +=back + +=cut +sub set_durable { + my ($self) = @_; + my $impl = $self->{_impl}; + my $durable = $_[1]; + + die "Durable must be specified" if !defined($durable); + + $impl->setDurable($durable); +} + +sub get_durable { + my ($self) = @_; + my $impl = $self->{_impl}; + + return $impl->getDurable; +} + +=pod + +=head2 REDELIVERED + +This is a hint to the messaging infrastructure that if de-duplication is +required, that this message should be examined to determine if it is a +duplicate. + +=over + +=item $msg->set_redelivered( 1 ) + +=item $redelivered = $msg->get_redelivered + +=back + +=cut +sub set_redelivered { + my ($self) = @_; + my $impl = $self->{_impl}; + my $redelivered = $_[1]; + + die "Redelivered must be specified" if !defined($redelivered); + + $impl->setRedelivered($redelivered); +} + +sub get_redelivered { + my ($self) = @_; + my $impl = $self->{_impl}; + + return $impl->getRedelivered; +} + +=pod + +=head2 PROPERTIES + +Named properties for the message are name/value pairs. + +=over + +=item $msg->set_property( name, value ) + +=item $value = $msg->get_property( name ) + +=item @props = $msg->get_properties + +=back + +=head3 ARGUMENTS + +=over + +=item * name + +The property name. + +=item * value + +The property value. + +=back + +=cut +sub set_property { + my ($self) = @_; + my $impl = $self->{_impl}; + my $key = $_[1]; + my $value = $_[2]; + + $impl->setProperty($key, $value); +} + +sub get_properties { + my ($self) = @_; + my $impl = $self->{_impl}; + + return $impl->getProperties; +} + +=pod + +=head2 CONTENT + +The message content. + +=begin _private + +TODO: Need to make the content automatically encode and decode for +hashes and lists. + +=end _private + +=over + +=item $msg->set_content( content ) + +=item $content = $msg->get_content + +=item $length = $msg->get_content_size + +=back + +=cut +sub set_content { + my ($self) = @_; + my $content = $_[1]; + my $impl = $self->{_impl}; + + die "Content must be provided" if !defined($content); + + $self->{_content} = $content; + + qpid::messaging::encode($content, $self); +} + +sub get_content { + my ($self) = @_; + my $impl = $self->{_impl}; + $content = $self->{_content} || undef; + + if(!defined($content)) { + $content = qpid::messaging::decode($self); + $self->{_content} = $content; + } + + return $content; +} + +sub get_content_size { + my ($self) = @_; + my $impl = $self->{_impl}; + + return $impl->getContentSize; +} + +1; diff --git a/cpp/bindings/qpid/perl/lib/qpid/messaging/Receiver.pm b/cpp/bindings/qpid/perl/lib/qpid/messaging/Receiver.pm new file mode 100644 index 0000000000..c3bc4bb8a8 --- /dev/null +++ b/cpp/bindings/qpid/perl/lib/qpid/messaging/Receiver.pm @@ -0,0 +1,317 @@ +# +# 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::messaging::Receiver + +=head1 DESCRIPTION + +A B<qpid::messaging::Receiver> is the entity though which messages are received. + +An instance can only be created using an active (i.e., not previously closed) +B<qpid::messaging::Session>. + +=head1 EXAMPLE + + # create a connection and a session + my $conn = new qpid::messaging::Connection("mybroker:5672"); + conn->open; + my $session = $conn->create_session; + + # create a receiver that listens on the "updates" topic of "alerts" + my $recv = $session->create_receiver("alerts/updates"); + + # set the local queue size to hold a maximum of 100 messages + $recv->set_capacity(100); + + # wait for an incoming message and process it + my $incoming = $recv->get; + process($incoming) + +=cut + +package qpid::messaging::Receiver; + +sub new { + my ($class) = @_; + my ($self) = { + _impl => $_[1], + _session => $_[2], + }; + + die "Must provide an implementation." unless defined($self->{_impl}); + die "Must provide a Session." unless defined($self->{_session}); + + bless $self, $class; + return $self; +} + +=pod + +=head1 ACTIONS + +=cut + + +=pod + +There are two ways to retrieve messages: from the local queue or from the +remote queue. + +=head2 GETTING FROM THE LOCAL QUEUE + +Messages can be held locally in message queues. + +=over + +=item $incoming = $receiver->get + +=item $incoming = $receiver->get( timeout) + +=back + +=head3 ARGUMENTS + +=over + +=item * timeout + +The period of time to wait for a message before raising an exception. If no +period of time is specified then the default is to wait B<forever>. + +=back + +=cut +sub get { + my ($self) = @_; + my $duration = $_[1]; + my $impl = $self->{_impl}; + + $duration = $duration->get_implementation() if defined($duration); + + my $message = undef; + + if (defined($duration)) { + $message = $impl->get($duration); + } else { + $message = $impl->get; + } +} + +=pod + +=head2 FETCHING FROM THE REMOTE QUEUE + +Messages held in the remote queue must be fetched from the broker in order +to be processed. + +=over + +=item $incoming = $receiver->fetch + +=item $incoming = $receiver->fetch( time ) + +=back + +=head3 ARGUMENTS + +=over + +=item * timeout + +The period of time to wait for a message before raising an exception. If no +period of time is specified then the default is to wait B<forever>. + +=back + +=cut +sub fetch { + my ($self) = @_; + my $duration = $_[1]; + my $impl = $self->{_impl}; + my $message = undef; + + if (defined($duration)) { + $message = $impl->fetch($duration->get_implementation()); + } else { + $message = $impl->fetch; + } + + return new qpid::messaging::Message("", $message); +} + +=pod + +=head2 CLOSING THE RECEIVER + +=over + +=item receiver->close + +Closes the receiver. + +=back + +=cut +sub close { + my ($self) = @_; + my $impl = $self->{_impl}; + + $impl->close; +} + +=pod + +=head1 ATTRIBUTES + +=cut + + +=pod + +=head2 CAPACITY + +The maximum number of messages that are prefected and held locally is +determined by the capacity of the receiver. + +=over + +=item $receiver->set_capacity( size ) + +=item $size = $receiver->get_capacity + +=back + +=cut +sub set_capacity { + my ($self) = @_; + my $capacity = $_[1]; + my $impl = $self->{_impl}; + + $impl->setCapacity($capacity); +} + +sub get_capacity { + my ($self) = @_; + my $impl = $self->{_impl}; + + return $impl->getCapacity; +} + +=pod + +=head2 AVAILABLE + +The number of messages waiting in the local queue. + +The value is always in the range 0 <= B<available> <= B<capacity>. + +=over + +=item $count = $receiver->get_available + +=back + +=cut + +sub get_available { + my ($self) = @_; + my $impl = $self->{_impl}; + + return $impl->getAvailable; +} + +=pod + +=over + +=item $count = $receiver->get_unsettled + +Returns the number of messages that have been received and acknowledged but +whose acknowledgements have not been confirmed by the sender. + +=back + +=cut +sub get_unsettled { + my ($self) = @_; + my $impl = $self->{_impl}; + + return $impl->getUnsettled; +} + +=pod + +=over + +=item $name = $receiver->get_name + +Returns the name of the receiver. + +=back + +=cut +sub get_name { + my ($self) = @_; + my $impl = $self->{_impl}; + + return $impl->getName; +} + +=pod + +=over + +=item $session = $receiver->get_session + +Returns the B<qpid::messaging::Session> instance from which this +receiver was created. + +=back + +=cut +sub get_session { + my ($self) = @_; + my $impl = $self->{_impl}; + + return $impl->{_session}; +} + +=pod + +=over + +=item $receiver->is_closed + +Returns whether the receiver is closed. + +=back + +=cut +sub is_closed { + my ($self) = @_; + my $impl = $self->{_impl}; + + return $impl->isClosed; +} + +1; diff --git a/cpp/bindings/qpid/perl/lib/qpid/messaging/Sender.pm b/cpp/bindings/qpid/perl/lib/qpid/messaging/Sender.pm new file mode 100644 index 0000000000..5d0896ff79 --- /dev/null +++ b/cpp/bindings/qpid/perl/lib/qpid/messaging/Sender.pm @@ -0,0 +1,258 @@ +# +# 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::messaging::Sender + +=head1 DESCRIPTION + +A B<qpid::messaging::Sender> is the entity through which messages are sent. + +An instance can only be created using an active (i.e., not previously closed) +B<qpid::messaging::Session>. + +=head1 EXAMPLE + + # create a connection and a session + my $conn = new qpid::messaging::Connection("mybroker:5672"); + conn->open; + my $session = $conn->create_session; + + # create a sender that posts messages to the "updates" queue + my $sender = $session->create_sender "updates;{create:always}" + + # begin sending updates + while( 1 ) { + my $content = wait_for_event; + $sender->send(new qpid::messaging::Message($content)); + } + +=cut + +package qpid::messaging::Sender; + +sub new { + my ($class) = @_; + my ($self) = { + _impl => $_[1], + _session => $_[2], + }; + + die "Must provide an implementation." unless defined($self->{_impl}); + die "Must provide a Session." unless defined($self->{_session}); + + bless $self, $class; + return $self; +} + +=pod + +=head1 ACTIONS + +=cut + + +=pod + +=head2 SENDING MESSAGES + +=over + +=item $sender->send( message ) + +=item $sender->send( message, block) + +Sends a message, optionally blocking until the message is received by +the broker. + +=back + +=head3 ARGUMENTS + +=over + +=item * message + +The message to be sent. + +=item * block + +If true then blocks until the message is received. + +=back + +=cut +sub send { + my ($self) = @_; + my $message = $_[1]; + my $sync = $_[2] || 0; + + die "No message to send." unless defined($message); + + my $impl = $self->{_impl}; + + $impl->send($message->get_implementation, $sync); +} + +=pod + +=head2 CLOSING THE SENDER + +=item sender->close + +Closes the sender. + +This does not affect the ownering B<Session> or B<Connection> + +=back + +=cut +sub close { + my ($self) = @_; + my $impl = $self->{_impl}; + + $impl->close; +} + +=pod + +=head1 ATTRIBUTES + +=cut + +=pod + +=head2 CAPACITY + +The capacity is the number of outoing messages that can be held pending +confirmation of receipt by the broker. + +=over + +=item sender->set_capacity( size ) + +=item $size = sender->get_capacity + +=back + +=back + +=cut +sub set_capacity { + my ($self) = @_; + my $impl = $self->{_impl}; + + $impl->setCapacity($_[1]); +} + +sub get_capacity { + my ($self) = @_; + my $impl = $self->{_impl}; + + return $impl->getCapacity; +} + +=pod + +=head2 UNSETTLED + +The number of messages sent that are pending receipt confirmation by the broker. + +=over + +=item $count = sender->get_unsettled + +=back + +=cut +sub get_unsettled { + my ($self) = @_; + my $impl = $self->{_impl}; + + return $impl->getUnsettled; +} + +=pod + +=head2 AVAILABLE + +The available slots for sending messages. + +This differences form B<capacity> in that it is the available slots in the +senders capacity for holding outgoing messages. The difference between +capacity and available is the number of messages that have no been delivered +yet. + +=over + +=item $slots = sender->get_available + +=back + +=cut +sub get_available { + my ($self) = @_; + my $impl = $self->{_impl}; + + return $impl->getAvailable(); +} + +=pod + +=head2 NAME + +The human-readable name for this sender. + +=over + +=item $name = sender-get_name + +=back + +=cut +sub get_name { + my ($self) = @_; + my $impl = $self->{_impl}; + + return $impl->getName; +} + +=pod + +=head2 SESSION + +The owning session from which the sender was created. + +=over + +=item $session = $sender->get_session + +=back + +=cut +sub get_session { + my ($self) = @_; + + return $self->{_session}; +} + +1; diff --git a/cpp/bindings/qpid/perl/lib/qpid/messaging/Session.pm b/cpp/bindings/qpid/perl/lib/qpid/messaging/Session.pm new file mode 100644 index 0000000000..af85731685 --- /dev/null +++ b/cpp/bindings/qpid/perl/lib/qpid/messaging/Session.pm @@ -0,0 +1,473 @@ +# +# 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::messaging::Session + +=head1 DESCRIPTION + +A B<qpid::messaging::Session> represents a distinct conversation between end +points. They are created from an active (i.e, not closed) B<Connection>. + +A session is used to acknowledge individual or all messages that have +passed through it, as well as for creating senders and receivers for conversing. +=cut +package qpid::messaging::Session; + +sub new { + my ($class) = @_; + my ($self) = { + _impl => $_[1], + _conn => $_[2], + }; + + die "Must provide an implementation." unless defined($self->{_impl}); + die "Must provide a Connection." unless defined($self->{_conn}); + + bless $self, $class; + return $self; +} + +=pod + +=head1 ACTIONS + +=cut + + +=pod + +=head2 CLOSING THE SESSION + +=over + +=item $session->close + +=back + +=cut +sub close { + my ($self) = @_; + my $impl = $self->{_impl}; + + $impl->close; +} + +=pod + +=head2 TRANSACTIONS + +Transactions can be rolled back or committed. + +=over + +=item $session->commit + +=item $session->rollback + +=back + +=cut +sub commit { + my ($self) = @_; + my $impl = $self->{_impl}; + + $impl->commit; +} + +sub rollback { + my ($self) = @_; + my $impl = $self->{_impl}; + + $impl->rollback; +} + +=pod + +=head2 MESSAGE DISPOSITIONS + +=cut + + +=pod + +=over + +=item $session->acknowledge( msg ) + +Acknowledges that a specific message that has been received. + +=back + +=begin _private + +TODO: How to handle acknowledging a specific message? + +=end _private + +=cut +sub acknowledge { + my ($self) = @_; + my $sync = $_[1] || 0; + + my $impl = $self->{_impl}; + + $impl->acknowledge($sync); +} + +=pod + +=over + +=item $session->reject( msg ) + +Rejects the specified message. A reject message will not be redelivered. + +=back + +=cut +sub reject { + my ($self) = @_; + my $impl = $self->{_impl}; + + $impl->reject($_[1]); +} + +=pod + +=over + +=item $session->release( msg ) + +Releases the specified message, which allows the broker to attempt to +redeliver it. + +=back + +=cut +sub release { + my ($self) = @_; + my $impl = $self->{_impl}; + + $impl->release($_[1]); +} + +=pod + +=over + +=item $session->sync + +=item $session->sync( block ) + +Requests synchronization with the broker. + +=back + +=head3 ARGUMENTS + +=over + +=item * block + +If true, then the call blocks until the process completes. + +=back + +=cut +sub sync { + my ($self) = @_; + my $impl = $self->{_impl}; + + if(defined($_[1])) { + $impl->sync($_[1]); + } else { + $impl->sync; + } +} + +=pod + +=head2 SENDERS AND RECEIVERS + +=cut + + +=pod + +=over + +=item $sender = $session->create_sender( address ) + +Creates a new sender. + +=back + +=head3 ARGUMENTS + +=over + +=item * address + +The sender address. See B<qpid::messaging::Address> for more details + +=back + +=cut +sub create_sender { + my ($self) = @_; + my $impl = $self->{_impl}; + + my $address = $_[1]; + + if (ref($address) eq "qpid::messaging::Address") { + my $temp = $address->get_implementation(); + $address = $temp; + } + my $send_impl = $impl->createSender($address); + + return new qpid::messaging::Sender($send_impl, $self); +} + +=pod + +=over + +=item $sender = $session->get_session( name ) + +=back + +=head3 ARGUMENTS + +=over + +=item * name + +The name of the sender. + +Raises an exception when no sender with that name exists. + +=back + +=cut +sub get_sender { + my ($self) = @_; + my $impl = $self->{_impl}; + + my $send_impl = $impl->getSender($_[1]); + my $sender = undef; + + if (defined($send_impl)) { + $sender = new qpid::messaging::Sender($send_impl, $self); + } + + return $sender; +} + +=pod + +=over + +=item $receiver = $session->create_receiver( address ) + +=back + +=head3 ARGUMENTS + +=over + +=item * address + +The receiver address. see B<qpid::messaging::Address> for more details. + +=back + +=cut +sub create_receiver { + my ($self) = @_; + my $impl = $self->{_impl}; + + my $address = $_[1]; + + if (ref($address) eq "qpid::messaging::Address") { + $address = $address->get_implementation(); + } + my $recv_impl = $impl->createReceiver($address); + + return new qpid::messaging::Receiver($recv_impl, $self); +} + +=pod + +=over + +=item $receiver = $session->get_receiver( name ) + +=back + +=head3 ARGUMENTS + +=over + +=item * name + +The name of the receiver. + +=back + +=cut +sub get_receiver { + my ($self) = @_; + my $impl = $self->{_impl}; + + my $recv_impl = $impl->getReceiver($_[1]); + my $receiver = undef; + + if (defined($recv_impl)) { + $receiver = new qpid::messaging::Receiver($recv_impl, $self); + } + + return $receiver; +} + +=pod + +=head1 ATTRIBUTES + +=cut + + +=pod + +=head2 RECEIVABLE + +The total number of receivable messages, and messages already received, +by receivers associated with this session. + +=over + +=item $session->get_receivable + +=back + +=cut +sub get_receivable { + my ($self) = @_; + my $impl = $self->{_impl}; + + return $impl->getReceivable; +} + +=pod + +=head2 UNSETTLED ACKNOWLEDGEMENTS + +The number of messages that have been acknowledged by this session whose +acknowledgements have not been confirmed as processed by the broker. + +=over + +=item $session->get_unsettled_acks + +=back + +=cut +sub get_unsettled_acks { + my ($self) = @_; + my $impl = $self->{_impl}; + + return $impl->getUnsettledAcks; +} + +=pod + +=head2 NEXT RECEIVER + +The next receiver is the one, created by this session, that has any pending +local messages. + +If no receivers are found within the timeout then a B<MessagingException> is +raised. + +=over + +=item $session->get_next_receiver + +=item $session->get_next_receiver( timeout ) + +=back + +=head3 ARGUMENTS + +=over + +=item * timeout + +The period of time to wait for a receiver to be found. If no period of time is +specified then the default is to wait B<forever>. + +=back + +=cut +sub get_next_receiver { + my ($self) = @_; + my $impl = $self->{_impl}; + + my $timeout = $_[1] || qpid::messaging::Duration::FOREVER; + + return $impl->getNextReceiver($timeout); +} + +=pod + +=head2 CONNECTION + +=over + +=item $conn = $session->get_connection + +Returns the owning connection for the session. + +=back + +=cut +sub get_connection { + my ($self) = @_; + + return $self->{_conn}; +} + +sub has_error { + my ($self) = @_; + my $impl = $self->{_impl}; + + return $impl->hasError; +} + +sub check_for_error { + my ($self) = @_; + my $impl = $self->{_impl}; + + $impl->checkForError; +} + +1; diff --git a/cpp/bindings/qpid/perl/lib/qpid/messaging/codec.pm b/cpp/bindings/qpid/perl/lib/qpid/messaging/codec.pm new file mode 100644 index 0000000000..c9d6845eb9 --- /dev/null +++ b/cpp/bindings/qpid/perl/lib/qpid/messaging/codec.pm @@ -0,0 +1,53 @@ +# +# 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::messaging; + +sub encode { + my $content = $_[0]; + my $message = $_[1]; + my $impl = $message->get_implementation(); + + if(UNIVERSAL::isa($content, "HASH")) { + cqpid_perl::encode($content, $impl, "amqp/map"); + } elsif(UNIVERSAL::isa($content, "ARRAY")) { + cqpid_perl::encode($content, $impl, "amqp/list"); + } else { + $message->get_implementation()->setContent($content); + } +} + +sub decode { + my $message = $_[0]; + my $impl = $message->get_implementation(); + my $content_type = $impl->getContentType(); + + if($content_type eq "amqp/map") { + $result = cqpid_perl::decodeMap($impl); + } elsif($content_type eq "amqp/list") { + $result = cqpid_perl::decodeList($impl); + } else { + $result = $impl->getContent(); + } + + return $result; +} + +1; + diff --git a/cpp/bindings/qpid/perl/lib/qpid_messaging.pm b/cpp/bindings/qpid/perl/lib/qpid_messaging.pm new file mode 100644 index 0000000000..e6a2681c15 --- /dev/null +++ b/cpp/bindings/qpid/perl/lib/qpid_messaging.pm @@ -0,0 +1,95 @@ +# +# 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 cqpid_perl; + +package qpid::messaging; + +use qpid::messaging::codec; +use qpid::messaging::Address; +use qpid::messaging::Duration; +use qpid::messaging::Message; +use qpid::messaging::Receiver; +use qpid::messaging::Sender; +use qpid::messaging::Session; +use qpid::messaging::Connection; + +1; + +__END__ + +=pod + +=head1 NAME + +qpid::messaging + +=head1 DESCRIPTION + +The Qpid Messaging framework is an enterprise messaging framework +based on the open-source AMQP protocol. + +=head1 EXAMPLE + +Here is a simple example application. It creates a link to a broker located +on a system named C<broker.myqpiddomain.com>. It then creates a new messaging +queue named C<qpid-examples> and publishes a message to it. It then consumes +that same message and closes the connection. + + use strict; + use warnings; + + use qpid; + + # create a connection, open it and then create a session named "session1" + my $conn = new qpid::messaging::Connection("broker.myqpiddomain.com"); + $conn->open(); + my $session = $conn->create_session("session1"); + + # create a sender and a receiver + # the sender marks the queue as one that is deleted when the sender disconnects + my $send = $session->create_sender("qpid-examples;{create:always}"); + my $recv = $session->create_receiver("qpid-examples"); + + # create an outgoing message and send it + my $outgoing = new qpid::messaging::Message(); + $outgoing->set_content("The time is " . localtime(time)"); + $send->send($outgoing); + + # set the receiver's capacity to 10 and then check out many messages are pending + $recv->set_capacity(10); + print "There are " . $recv->get_available . " messages waiting.\n"; + + # get the nextwaitingmessage, which should be in the local queue now, + # and output the contents + my $incoming = $recv->fetch(); + print "Received the following message: " . $incoming->get_content() . "\n"; + # the output should be the text that was sent earlier + + # acknowledge the message, letting the sender know the message was received + printf "The sender currently has " . $send->get_unsettled . " message(s) pending.\n"; + # should report 1 unsettled message + $session->acknowledge(); # acknowledges all pending messages + print "Now sender currently has " . $send->get_unsettled . " message(s) pending.\n"; + # should report 0 unsettled messages + + # close the connection + $conn->close diff --git a/cpp/bindings/qpid/perl/perl.i b/cpp/bindings/qpid/perl/perl.i index 38ac91761f..0d118ae0fb 100644 --- a/cpp/bindings/qpid/perl/perl.i +++ b/cpp/bindings/qpid/perl/perl.i @@ -19,7 +19,7 @@ %module cqpid_perl %include "std_string.i" -%include "../../swig_perl_typemaps.i" +%include "qpid/swig_perl_typemaps.i" /* Define the general-purpose exception handling */ %exception { @@ -31,5 +31,5 @@ } } -%include "../qpid.i" +%include "qpid/qpid.i" diff --git a/cpp/bindings/qpid/perl/qpid.pm b/cpp/bindings/qpid/perl/qpid.pm new file mode 100644 index 0000000000..88b98353a8 --- /dev/null +++ b/cpp/bindings/qpid/perl/qpid.pm @@ -0,0 +1,22 @@ +# +# 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 qpid_messaging; + +1; diff --git a/cpp/bindings/qpid/perl/t/Address.t b/cpp/bindings/qpid/perl/t/Address.t new file mode 100644 index 0000000000..4e74f8cad2 --- /dev/null +++ b/cpp/bindings/qpid/perl/t/Address.t @@ -0,0 +1,102 @@ +#!/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'; + +# verify that qpid is available +BEGIN { use_ok( 'qpid' ); } +require_ok ('qpid' ); + +# construction +# address cannot be null +dies_ok (sub {new qpid::messaging::Address(undef);}, + "Address cannot be null"); + +# can use an address +my $address = new qpid::messaging::Address("0.0.0.0"); +ok ($address, "Can be created with an arbitrary address"); + +# name +# name cannot be null +dies_ok (sub {$address->set_name(undef);}, + "Name cannot be null"); + +# name can be an empty string +$address->set_name(""); +ok ($address->get_name() eq "", + "Name can be empty"); + +# name can be an arbitrary string +my $name = random_string(25); +$address->set_name($name); +ok ($address->get_name() eq $name, + "Name can be an arbitrary string"); + +# subject +# cannot be null +dies_ok (sub {$address->set_subject(undef);}, + "Subject cannot be null"); + +# can be an empty string +$address->set_subject(""); +ok ($address->get_subject() eq "", + "Subject can be empty"); + +# can be an arbitrary string +my $subject = random_string(64); +$address->set_subject($subject); +ok ($address->get_subject() eq $subject, + "Subject can be an arbitrary string"); + +# options +# options cannot be null +dies_ok (sub {$address->set_options(undef);}, + "Options cannot be null"); + +# options can be an empty hash +$address->set_options({}); +ok (eq_hash($address->get_options(), {}), + "Options can be an empty hash"); + +# options cannot be arbitrary values +my %options = ("create", "always", "delete", "always"); +$address->set_options(\%options); +ok (eq_hash($address->get_options(), \%options), + "Options can be arbitrary keys"); + +# type +# cannot be null +dies_ok (sub {$address->set_type(undef);}, + "Type cannot be null"); + +# can be an empty string +$address->set_type(""); +ok ($address->get_type() eq "", + "Type can be an empty string"); + +# can be an arbitrary string +my $type = random_string(16); +$address->set_type($type); +ok ($address->get_type() eq $type, + "Type can be an arbitrary type"); + diff --git a/cpp/bindings/qpid/perl/t/Duration.t b/cpp/bindings/qpid/perl/t/Duration.t new file mode 100644 index 0000000000..6975e8006f --- /dev/null +++ b/cpp/bindings/qpid/perl/t/Duration.t @@ -0,0 +1,124 @@ +#!/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'; + +# verify that qpid is available +BEGIN { use_ok( 'qpid' ); } +require_ok ('qpid' ); + +# milliseconds +# duration cannot be null +{ + dies_ok (sub {new qpid::messaging::Duration(undef);}, + "Durations cannot have null time periods"); +} + +# duration cannot be negative +{ + my $period = 0 - (int(rand(65535)) + 1); + dies_ok(sub {new qpid::messaging::Duration($period);}, + "Duration times cannot be negative"); +} + +# duration can be an arbitrary value +{ + my $period = int(rand(65535)); + my $duration = new qpid::messaging::Duration($period); + ok ($duration->get_milliseconds() == $period, + "Milliseconds are properly stored and fetched"); +} + +# multiplier +# cannot multiply by null +dies_ok(sub {qpid::messaging::Duration::FOREVER * undef;}, + "Cannot multiply a duration times a null"); + +# cannot multiply by a negative +dies_ok (sub {qpid::messaging::Duration::MINUTE * -2;}, + "Duration cannot be multiplied by a negative"); + +# multiply by zero returns a zero time period +{ + my $result = qpid::messaging::Duration::MINUTE * 0; + + ok ($result->get_milliseconds() == 0, + "Multiplying duration by 0 returns a 0 duration"); +} + +# multiply by arbitrary values works +{ + my $factor = int(1 + rand(100)); + my $result = qpid::messaging::Duration::MINUTE * $factor; + ok ($result->get_milliseconds() == 60000 * $factor, + "Multiplying by a factor returns a new Duration with that period"); +} + +# equality +# always fails with null +ok (!(qpid::messaging::Duration::MINUTE == undef), + "Duration is never equal to null"); + +# never equal to a non-duration class +ok (!(qpid::messaging::Duration::MINUTE == random_string(12)), + "Duration is never equal to a non-Duration"); + +# works with self +ok (qpid::messaging::Duration::MINUTE == qpid::messaging::Duration::MINUTE, + "Duration is always equal to itself"); + +# fails with non-equal instance +ok (!(qpid::messaging::Duration::MINUTE == qpid::messaging::Duration::SECOND), + "Duration non-equality works"); + +# works with equal instance +{ + my $result = qpid::messaging::Duration::MINUTE * 0; + ok ($result == qpid::messaging::Duration::IMMEDIATE, + "Equality comparison works correctly"); +} + +# non-equality +# always not equal to null +ok (qpid::messaging::Duration::MINUTE != undef, + "Always unequal to null"); + +# always not equal to a non-duration class +ok (qpid::messaging::Duration::MINUTE != random_string(64), + "Always unequal to a non-duration class"); + +# not unequal to itself +ok (!(qpid::messaging::Duration::MINUTE != qpid::messaging::Duration::MINUTE), + "Never unequal to itself"); + +# not unequal to an equal instance +{ + my $duration = qpid::messaging::Duration::MINUTE * 1; + ok (!(qpid::messaging::Duration::MINUTE != $duration), + "Never unequal to an equal instance"); +} + +# works with unequal instances +ok (qpid::messaging::Duration::MINUTE != qpid::messaging::Duration::FOREVER, + "Always unequal to a non-equal instance"); + diff --git a/cpp/bindings/qpid/perl/t/Message.t b/cpp/bindings/qpid/perl/t/Message.t new file mode 100644 index 0000000000..15baafb446 --- /dev/null +++ b/cpp/bindings/qpid/perl/t/Message.t @@ -0,0 +1,286 @@ +#!/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'; + +# verify that qpid is available +BEGIN { use_ok( 'qpid' ); } +require_ok ('qpid' ); + +# Create a new message +my $message = new qpid::messaging::Message(); +isa_ok($message, 'qpid::messaging::Message'); + +# reply to +# rejects an null address +dies_ok (sub {$message->set_reply_to(undef);}, + "Reply to cannot be null."); + +# can handle a string address +$message->set_reply_to("test"); +ok ($message->get_reply_to()->str() eq "test", + "Reply to can be set"); + +# subject +# cannot have an null subject +dies_ok (sub {$message->set_subject(undef);}, + "Subject cannot be null"); + +# can have an empty subject +$message->set_subject(""); +ok ($message->get_subject() eq "", + "Subject can be empty"); + +# can have a subject +my $subject = random_string(16); +$message->set_subject($subject); +ok ($message->get_subject() eq $subject, + "Subject can be set."); + +# content type +# cannot have an null content type +dies_ok (sub {$message->set_content_type(undef);}, + "Content type must be defined."); + +# can an empty content type +$message->set_content_type(""); +ok ($message->get_content_type() eq "", + "Content type can be empty"); + +# can have an arbitrary content type +my $content_type = random_string(10); +$message->set_content_type($content_type); +ok ($message->get_content_type() eq $content_type, + "Content type can be arbitrary"); + +# can be for a map +$content_type = "amqp/map"; +$message->set_content_type($content_type); +ok ($message->get_content_type() eq $content_type, + "Content type can be for a map"); + +# message id +# cannot be null +dies_ok (sub {$message->set_message_id(undef);}, + "Message id cannot be null"); + +# can be an empty string +$message->set_message_id(""); +ok ($message->get_message_id() eq "", + "Message id can be empty"); + +# can be an arbitrary string +my $id = random_string(32); +$message->set_message_id($id); +ok ($message->get_message_id() eq $id, + "Message id can be an arbitrary string"); + +# can be a UUID +$id = generate_uuid(); +$message->set_message_id($id); +ok ($message->get_message_id() eq $id, + "Message id can be a valid UUID"); + +# user id +# cannot be null +dies_ok (sub {$message->set_user_id(undef);}, + "User id cannot be null"); + +# can be an empty string +my $user_id = ""; +$message->set_user_id($user_id); +ok ($message->get_user_id() eq $user_id, + "User id can be empty"); + +# can be an arbitrary string +$id = random_string(65); +$message->set_user_id($user_id); +ok ($message->get_user_id() eq $user_id, + "User id can be an arbitrary string"); + +# correlation id +# cannot be null +dies_ok (sub {$message->set_correlation_id(undef);}, + "Correlation id cannot be null"); + +# can be empty +my $correlation_id = ""; +$message->set_correlation_id($correlation_id); +ok ($message->get_correlation_id() eq $correlation_id, + "Correlation id can be an empty string"); + +# can be an arbitrary string +$correlation_id = random_string(32); +$message->set_correlation_id($correlation_id); +ok ($message->get_correlation_id() eq $correlation_id, + "Correlation id can be an arbitrary string"); + +# priority +# cannot be nul +dies_ok (sub {$message->set_priority(undef);}, + "Priority cannot be null"); + +# cannot be negative +my $priority = 0 - (rand(2**8) + 1); +dies_ok (sub {$message->set_priority($priority);}, + "Priority cannot be negative"); + +# can be 0 +$message->set_priority(0); +ok ($message->get_priority() == 0, + "Priority can be zero"); + +# can be an arbitrary value +$priority = int(rand(2**8) + 1); +$message->set_priority($priority); +ok ($message->get_priority() == $priority, + "Priority can be any positive value"); + +# ttl +# cannot be null +dies_ok (sub {$message->set_ttl(undef);}, + "TTL cannot be null"); + +# can be a duration +$message->set_ttl(qpid::messaging::Duration::FOREVER); +ok ($message->get_ttl()->get_milliseconds() == qpid::messaging::Duration::FOREVER->get_milliseconds(), + "TTL can be a Duration"); + +# if numeric, is converted to a duration +my $duration = rand(65535); +$message->set_ttl($duration); +ok ($message->get_ttl()->get_milliseconds() == int($duration), + "TTL can be any arbitrary duration"); + +# if 0 it's converted to IMMEDIATE +$message->set_ttl(0); +ok ($message->get_ttl()->get_milliseconds() == qpid::messaging::Duration::IMMEDIATE->get_milliseconds(), + "TTL of 0 is converted to IMMEDIATE"); + +# if negative it's converted to FOREVER +$message->set_ttl(0 - (rand(65535) + 1)); +ok ($message->get_ttl()->get_milliseconds() == qpid::messaging::Duration::FOREVER->get_milliseconds(), + "TTL of <0 is converted to FOREVER"); + +# durable +# cannot be null +dies_ok (sub {$message->set_durable(undef);}, + "Durable cannot be null"); + +# can be set to true +$message->set_durable(1); +ok ($message->get_durable(), + "Durable can be true"); + +# can be set to false +$message->set_durable(0); +ok (!$message->get_durable(), + "Durable can be false"); + +# redelivered +# redelivered cannot be null +dies_ok (sub {$message->set_redelivered(undef);}, + "Redelivered cannot be null"); + +# can be set to true +$message->set_redelivered(1); +ok ($message->get_redelivered(), + "Redelivered can be true"); + +# can be set to false +$message->set_redelivered(0); +ok (!$message->get_redelivered(), + "Redelivered can be false"); + +# properties +# can retrieve all properties +my $properties = $message->get_properties(); +ok (UNIVERSAL::isa($properties, 'HASH'), + "Returns the properties as a hash map"); + +# property +# setting a property using a null key fails +dies_ok (sub {$message->set_property(undef, "bar");}, + "Property cannot have a null key"); + +# setting a property with a null value succeeds +my $key = random_string(16); +$message->set_property($key, undef); +ok (!$message->get_properties()->{$key}, + "Properties can have null values"); + +# setting a property succeeds +my $value = random_string(255); +$message->set_property($key, $value); +ok ($message->get_properties()->{$key} eq $value, + "Messages can have arbitrary property values"); + +# content +# cannot be null +dies_ok (sub {$message->set_content(undef);}, + "Content cannot be null"); + +# can be an empty string +$message->set_content(""); +ok ($message->get_content() eq "", + "Content can be an empty string"); + +# can be an arbitrary string +my $content = random_string(255); +$message->set_content($content); +ok ($message->get_content() eq $content, + "Content can be an arbitrary string"); + +# Embedded nulls should be handled properly +$content = { id => 1234, name => "With\x00null" }; +qpid::messaging::encode($content, $message); +my $map = qpid::messaging::decode_map($message); +ok ($map->{name} eq "With\x00null", + "Nulls embedded in map values work."); + +# Unicode strings shouldn't be broken +$content = { id => 1234, name => "Euro=\x{20AC}" }; +qpid::messaging::encode($content, $message); +$map = qpid::messaging::decode_map($message); +ok ($map->{name} eq "Euro=\x{20AC}", + "Unicode strings encoded correctly."); + +# Setting the content as a hash automatically encodes it +($content) = {"id" => "1234", "name" => "qpid"}; +$message->set_content($content); +ok ($message->get_content_type() eq "amqp/map", + "Hashes are automatically encoded correctly"); + +# Setting the content as a list automatically encodes it +my @acontent = (1, 2, 3, 4); +$message->set_content(\@acontent); +ok ($message->get_content_type() eq "amqp/list", + "Lists are automatically encoded correctly"); + +# content size +# content size is correct +my $content_size = int(rand(256)); +$content = random_string($content_size); +$message->set_content($content); +ok ($message->get_content_size() == $content_size, + "Content size is correct"); diff --git a/cpp/bindings/qpid/perl/t/utils.pm b/cpp/bindings/qpid/perl/t/utils.pm new file mode 100644 index 0000000000..db8093d324 --- /dev/null +++ b/cpp/bindings/qpid/perl/t/utils.pm @@ -0,0 +1,38 @@ +# 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 Digest::MD5; + +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 generate_uuid +{ + return Digest::MD5::md5_base64( rand ); +} + +1; |