[libnet-dbus-perl] 237/335: Allow use of 64-bit types by serializing to/from strings as needed

[Intrigeri]

This is an automated email from the git hooks/post-receive script.

intrigeri pushed a commit to branch experimental
in repository libnet-dbus-perl.

commit 9b5656ccccf71ceea64cdf873e9075184787f64c
Author: Daniel P. Berrange <berrange at redhat.com>
Date:   Tue Nov 14 23:32:09 2006 -0500

    Allow use of 64-bit types by serializing to/from strings as needed
---
 CHANGES                          |  3 ++
 DBus.xs                          | 63 ++++++++++++++++++++++++++++++++++++++++
 lib/Net/DBus/Binding/Iterator.pm | 15 ----------
 t/15-message.t                   | 33 +++++++++------------
 typemap                          | 20 +++++++++++--
 5 files changed, 98 insertions(+), 36 deletions(-)

diff --git a/CHANGES b/CHANGES
index 74b0ce5..c4aa989 100644
--- a/CHANGES
+++ b/CHANGES
@@ -4,6 +4,9 @@ Changes since 0.33.4
  - Added support for getting private bus connections for apps which
    don't want to deal with a shared bus
  - Fix test case to use a private connection
+ - On Perl builds where integers are 32-bits, the DBus 64 bit integer
+   types will be serialized to/from the Perl String type instead of
+   calling 'die'.
 
 Changes since 0.33.3
 
diff --git a/DBus.xs b/DBus.xs
index 3fb6459..51a0cde 100644
--- a/DBus.xs
+++ b/DBus.xs
@@ -31,6 +31,69 @@ static int net_dbus_debug = 0;
 #endif
 
 
+/*
+ * On 32-bit OS (and some 64-bit) Perl does not have an
+ * integer type capable of storing 64 bit numbers. So
+ * we serialize to/from strings on these platforms
+ */
+
+dbus_int64_t
+_dbus_parse_int64(SV *sv) {
+#ifdef USE_64_BIT_ALL
+    return SvIV(sv);
+#else
+    //DEBUG_MSG("Parrse %s\n", SvPV_nolen(sv));
+    return strtoll(SvPV_nolen(sv), NULL, 10);
+#endif
+}
+
+dbus_uint64_t
+_dbus_parse_uint64(SV *sv) {
+#ifdef USE_64_BIT_ALL
+    return SvUV(sv);
+#else
+    //DEBUG_MSG("Parrse %s\n", SvPV_nolen(sv));
+    return strtoull(SvPV_nolen(sv), NULL, 10);
+#endif
+}
+
+
+#ifndef PRId64
+#define PRId64 "lld"
+#endif
+
+SV *
+_dbus_format_int64(dbus_int64_t val) {
+#ifdef USE_64_BIT_ALL
+    return newSViv(val);
+#else
+    char buf[100];
+    int len;
+    len = snprintf(buf, 100, "%" PRId64, val);
+    //DEBUG_MSG("Format i64 [%" PRId64 "] to [%s]\n", val, buf);
+    return newSVpv(buf, len);
+#endif
+}
+
+#ifndef PRIu64
+#define PRIu64 "llu"
+#endif
+
+SV *
+_dbus_format_uint64(dbus_uint64_t val) {
+#ifdef USE_64_BIT_ALL
+    return newSVuv(val);
+#else
+    char buf[100];
+    int len;
+    len = snprintf(buf, 100, "%" PRIu64, val);
+    //DEBUG_MSG("Format u64 [%" PRIu64 "] to [%s]\n", val, buf);
+    return newSVpv(buf, len);
+#endif
+}
+
+
+
 /* The -1 is required by the contract for
    dbus_{server,connection}_allocate_slot
    initialization */
diff --git a/lib/Net/DBus/Binding/Iterator.pm b/lib/Net/DBus/Binding/Iterator.pm
index 62036a8..4ff4bae 100644
--- a/lib/Net/DBus/Binding/Iterator.pm
+++ b/lib/Net/DBus/Binding/Iterator.pm
@@ -72,17 +72,6 @@ use warnings;
 
 use Net::DBus;
 
-our $have_quads = 0;
-
-BEGIN {
-  eval "pack 'Q', 1243456";
-  if ($@) {
-    $have_quads = 0;
-  } else {
-    $have_quads = 1;
-  }
-}
-
 =item $res = $iter->has_next()
 
 Determines if there are any more fields in the message
@@ -185,25 +174,21 @@ from/to the message iterator
 
 sub get_int64 {
     my $self = shift;
-    die "Quads not supported on this platform\n" unless $have_quads;
     return $self->_get_int64;
 }
 
 sub get_uint64 {
     my $self = shift;
-    die "Quads not supported on this platform\n" unless $have_quads;
     return $self->_get_uint64;
 }
 
 sub append_int64 {
     my $self = shift;
-    die "Quads not supported on this platform\n" unless $have_quads;
     $self->_append_int64(shift);
 }
 
 sub append_uint64 {
     my $self = shift;
-    die "Quads not supported on this platform\n" unless $have_quads;
     $self->_append_uint64(shift);
 }
 
diff --git a/t/15-message.t b/t/15-message.t
index 0ccbeb7..d8c5b7b 100644
--- a/t/15-message.t
+++ b/t/15-message.t
@@ -1,5 +1,5 @@
 # -*- perl -*-
-use Test::More tests => 25;
+use Test::More tests => 29;
 
 use strict;
 use warnings;
@@ -24,13 +24,10 @@ $iter->append_int16(123);
 $iter->append_uint16(456);
 $iter->append_int32(123);
 $iter->append_uint32(456);
-if ($Net::DBus::Binding::Iterator::have_quads) {
-  $iter->append_int64(12345645645);
-  $iter->append_uint64(12312312312);
-} else {
-  $iter->append_boolean(1);
-  $iter->append_boolean(1);
-}
+$iter->append_int64("12345645645");
+$iter->append_uint64("12312312312");
+$iter->append_int64("12345645645123456");
+$iter->append_uint64("12312312312123456");
 $iter->append_string("Hello world");
 $iter->append_double(1.424141);
 
@@ -50,17 +47,15 @@ ok($iter->next(), "next");
 ok($iter->get_uint32() == 456, "uint32");
 ok($iter->next(), "next");
 
-if (!$Net::DBus::Binding::Iterator::have_quads) {
-  ok(1, "int64 skipped");
-  ok($iter->next(), "next");
-  ok(1, "uint64 skipped");
-  ok($iter->next(), "next");
-} else {
-  ok($iter->get_int64() == 12345645645, "int64");
-  ok($iter->next(), "next");
-  ok($iter->get_uint64() == 12312312312, "uint64");
-  ok($iter->next(), "next");
-}
+ok($iter->get_int64() == "12345645645", "int64");
+ok($iter->next(), "next");
+ok($iter->get_uint64() == "12312312312", "uint64");
+ok($iter->next(), "next");
+
+ok($iter->get_int64() == "12345645645123456", "int64");
+ok($iter->next(), "next");
+ok($iter->get_uint64() == "12312312312123456", "uint64");
+ok($iter->next(), "next");
 
 ok($iter->get_string() eq "Hello world", "string");
 ok($iter->next(), "next");
diff --git a/typemap b/typemap
index 36c887f..b43477f 100644
--- a/typemap
+++ b/typemap
@@ -13,8 +13,24 @@ dbus_int16_t T_IV
 dbus_uint16_t T_UV
 dbus_int32_t T_IV
 dbus_uint32_t T_UV
-dbus_int64_t T_IV
-dbus_uint64_t T_UV
+dbus_int64_t T_DBUS_INT64
+dbus_uint64_t T_DBUS_UINT64
+
+INPUT
+T_DBUS_INT64
+    $var = _dbus_parse_int64($arg);
+
+OUTPUT
+T_DBUS_INT64
+    $arg = _dbus_format_int64($var);
+
+INPUT
+T_DBUS_UINT64
+    $var = _dbus_parse_uint64($arg);
+
+OUTPUT
+T_DBUS_UINT64
+    $arg = _dbus_format_uint64($var);
 
 INPUT
 O_OBJECT_connection

-- 
Alioth's /usr/local/bin/git-commit-notice on /srv/git.debian.org/git/pkg-perl/packages/libnet-dbus-perl.git