You are viewing a plain text version of this content. The canonical link for it is here.
Posted to commits@qpid.apache.org by mc...@apache.org on 2013/01/16 22:48:15 UTC
svn commit: r1434420 - in /qpid/proton/trunk/proton-c/bindings/perl:
lib/qpid/proton/Message.pm perl.i
Author: mcpierce
Date: Wed Jan 16 21:48:14 2013
New Revision: 1434420
URL: http://svn.apache.org/viewvc?rev=1434420&view=rev
Log:
PROTON-176: Fixes to Perl code due to unit test failures.
Fixes for code that failed the new unit tests.
Modified:
qpid/proton/trunk/proton-c/bindings/perl/lib/qpid/proton/Message.pm
qpid/proton/trunk/proton-c/bindings/perl/perl.i
Modified: qpid/proton/trunk/proton-c/bindings/perl/lib/qpid/proton/Message.pm
URL: http://svn.apache.org/viewvc/qpid/proton/trunk/proton-c/bindings/perl/lib/qpid/proton/Message.pm?rev=1434420&r1=1434419&r2=1434420&view=diff
==============================================================================
--- qpid/proton/trunk/proton-c/bindings/perl/lib/qpid/proton/Message.pm (original)
+++ qpid/proton/trunk/proton-c/bindings/perl/lib/qpid/proton/Message.pm Wed Jan 16 21:48:14 2013
@@ -19,6 +19,11 @@
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) = {};
@@ -32,7 +37,9 @@ sub new {
sub DESTROY {
my ($self) = @_;
- cproton_perl::pn_message_free($self->{_impl});
+ my $impl = $self->{_impl};
+
+ cproton_perl::pn_message_free($impl);
}
sub get_impl {
@@ -62,7 +69,7 @@ sub set_durable {
sub get_durable {
my ($self) = @_;
- return cproton_perl::pn_message_get_durable($self->{_impl});
+ return cproton_perl::pn_message_is_durable($self->{_impl});
}
sub set_priority {
@@ -92,7 +99,7 @@ sub set_first_acquirer {
sub get_first_acquirer {
my ($self) = @_;
- return cproton_perl::pn_message_get_first_acquirer($self->{_impl});
+ return cproton_perl::pn_message_is_first_acquirer($self->{_impl});
}
sub set_delivery_count {
@@ -107,22 +114,34 @@ sub get_delivery_count {
sub set_id {
my ($self) = @_;
- cproton_perl::pn_message_set_id($self->{_impl}, $_[1]);
+ 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) = @_;
- return cproton_perl::pn_message_get_id($self->{_impl});
+ my $id = cproton_perl::pn_message_get_id($self->{_impl});
+
+ return $id;
}
sub set_user_id {
my ($self) = @_;
- cproton_perl::pn_message_set_user_id($self->{_impl}, $_[1]);
+ 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) = @_;
- return cproton_perl::pn_message_get_user_id($self->{_impl}, $_[1]);
+ my $user_id = cproton_perl::pn_message_get_user_id($self->{_impl});
+
+ return $user_id;
}
sub set_address {
@@ -167,7 +186,11 @@ sub get_correlation_id {
sub set_format {
my ($self) = @_;
- cproton_perl::pn_message_set_format($self->{_impl}, $_[1]);
+ my $format = $_[1];
+
+ die "Format must be defined" if !defined($format);
+
+ cproton_perl::pn_message_set_format($self->{_impl}, $format);
}
sub get_format {
@@ -187,12 +210,15 @@ sub get_content_type {
sub set_content {
my ($self) = @_;
- my ($content) = $_[1];
+ my $content = $_[1];
+
cproton_perl::pn_message_load($self->{_impl}, $content);
}
sub get_content {
my ($self) = @_;
+ my $content = cproton_perl::pn_message_save($self->{_impl}, 1024);
+
return cproton_perl::pn_message_save($self->{_impl}, 1024);
}
@@ -206,19 +232,35 @@ sub get_content_encoding {
return cproton_perl::pn_message_get_content_encoding($self->{_impl});
}
-sub set_expires {
+sub set_expiry_time {
my ($self) = @_;
- cproton_perl::pn_message_set_expires($self->{_impl}, $_[1]);
+ 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_expires {
+sub get_expiry_time {
my ($self) = @_;
- return cproton_perl::pn_message_get_expires($self->{_impl});
+ return cproton_perl::pn_message_get_expiry_time($self->{_impl});
}
sub set_creation_time {
my ($self) = @_;
- cproton_perl::pn_message_set_creation_time($self->{_impl}, $_[1]);
+ 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 {
@@ -238,7 +280,11 @@ sub get_group_id {
sub set_group_sequence {
my ($self) = @_;
- cproton_perl::pn_message_set_group_sequence($self->{_impl}, $_[1]);
+ 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 {
Modified: qpid/proton/trunk/proton-c/bindings/perl/perl.i
URL: http://svn.apache.org/viewvc/qpid/proton/trunk/proton-c/bindings/perl/perl.i?rev=1434420&r1=1434419&r2=1434420&view=diff
==============================================================================
--- qpid/proton/trunk/proton-c/bindings/perl/perl.i (original)
+++ qpid/proton/trunk/proton-c/bindings/perl/perl.i Wed Jan 16 21:48:14 2013
@@ -18,6 +18,105 @@ typedef int int32_t;
%include <cstring.i>
+%typemap(in) pn_atom_t
+{
+ if(!$input)
+ {
+ $1.type = PN_NULL;
+ }
+ else
+ {
+ if(SvIOK($input)) // an integer value
+ {
+ $1.type = PN_LONG;
+ $1.u.as_long = SvIV($input);
+ }
+ else if(SvNOK($input)) // a floating point value
+ {
+ $1.type = PN_FLOAT;
+ $1.u.as_float = SvNV($input);
+ }
+ else if(SvPOK($input)) // a string type
+ {
+ STRLEN len;
+ char* ptr;
+
+ ptr = SvPV($input, len);
+ $1.type = PN_STRING;
+ $1.u.as_bytes.start = ptr;
+ $1.u.as_bytes.size = strlen(ptr); // len;
+ }
+ }
+}
+
+%typemap(out) pn_atom_t
+{
+ SV* obj = sv_newmortal();
+
+ switch($1.type)
+ {
+ case PN_NULL:
+ sv_setsv(obj, &PL_sv_undef);
+ break;
+
+ case PN_BYTE:
+ sv_setiv(obj, (IV)$1.u.as_byte);
+ break;
+
+ case PN_INT:
+ sv_setiv(obj, (IV)$1.u.as_int);
+ break;
+
+ case PN_LONG:
+ sv_setiv(obj, (IV)$1.u.as_long);
+ break;
+
+ case PN_STRING:
+ {
+ if($1.u.as_bytes.size > 0)
+ {
+ sv_setpvn(obj, $1.u.as_bytes.start, $1.u.as_bytes.size);
+ }
+ else
+ {
+ sv_setsv(obj, &PL_sv_undef);
+ }
+ }
+ break;
+ }
+
+ $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.size > 0)
+ {
+ sv_setpvn(obj, $1.start, $1.size);
+ }
+ else
+ {
+ sv_setsv(obj, &PL_sv_undef);
+ }
+
+ $result = obj;
+ argvi++;
+}
+
%cstring_output_withsize(char *OUTPUT, size_t *OUTPUT_SIZE)
%cstring_output_allocate_size(char **ALLOC_OUTPUT, size_t *ALLOC_SIZE, free(*$1));
---------------------------------------------------------------------
To unsubscribe, e-mail: commits-unsubscribe@qpid.apache.org
For additional commands, e-mail: commits-help@qpid.apache.org