This is an automated email from the git hooks/post-receive script.
intrigeri pushed a commit to branch experimental
in repository libglib-perl.
commit ea1b6910c739f1f65f16055ba51b78554cd7bb47
Author: Torsten Schönfeld <kaffeeti...@gmx.de>
Date: Mon Sep 7 18:02:51 2015 +0200
Add Glib::Bytes, a wrapper for GBytes
---
GBoxed.xs | 45 +++++++++++++++++++++++++++++++++++++++++++++
MANIFEST | 1 +
gperl.h | 12 +++++++++++-
lib/Glib.pm | 6 ++++++
t/bytes.t | 50 ++++++++++++++++++++++++++++++++++++++++++++++++++
typemap | 3 +++
6 files changed, 116 insertions(+), 1 deletion(-)
diff --git a/GBoxed.xs b/GBoxed.xs
index c363e6d..8c3664b 100644
--- a/GBoxed.xs
+++ b/GBoxed.xs
@@ -811,6 +811,9 @@ BOOT:
#if GLIB_CHECK_VERSION (2, 26, 0)
gperl_register_boxed (G_TYPE_ERROR, "Glib::Error",
&gerror_wrapper_class);
#endif
+#if GLIB_CHECK_VERSION (2, 32, 0)
+ gperl_register_boxed (G_TYPE_BYTES, "Glib::Bytes", NULL);
+#endif
=for object Glib::Boxed Generic wrappers for C structures
@@ -902,3 +905,45 @@ DESTROY (sv)
: NULL;
if (destroy)
(*destroy) (sv);
+
+MODULE = Glib::Boxed PACKAGE = Glib::Bytes PREFIX = g_bytes_
+
+=for DESCRIPTION
+
+=head1 DESCRIPTION
+
+In addition to the low-level API documented below, L<Glib> also provides
+stringification overloading so that you can treat any C<Glib::Bytes> object as
+a normal Perl string.
+
+=cut
+
+GBytes_own *
+g_bytes_new (class, SV *data)
+ PREINIT:
+ const char *real_data;
+ STRLEN len;
+ CODE:
+ real_data = SvPVbyte (data, len);
+ RETVAL = g_bytes_new (real_data, len);
+ OUTPUT:
+ RETVAL
+
+SV *
+g_bytes_get_data (GBytes *bytes)
+ PREINIT:
+ gconstpointer data;
+ gsize size;
+ CODE:
+ data = g_bytes_get_data (bytes, &size);
+ RETVAL = newSVpv (data, size);
+ OUTPUT:
+ RETVAL
+
+gsize g_bytes_get_size (GBytes *bytes);
+
+guint g_bytes_hash (GBytes *bytes);
+
+gboolean g_bytes_equal (GBytes *bytes1, GBytes *bytes2);
+
+gint g_bytes_compare (GBytes *bytes1, GBytes *bytes2);
diff --git a/MANIFEST b/MANIFEST
index 1210a0b..e20a003 100644
--- a/MANIFEST
+++ b/MANIFEST
@@ -54,6 +54,7 @@ t/9.t
t/a.t
t/b.t
t/boxed_errors.t
+t/bytes.t
t/c.t
t/constants.t
t/d.t
diff --git a/gperl.h b/gperl.h
index 7074dcc..1b08d94 100644
--- a/gperl.h
+++ b/gperl.h
@@ -362,7 +362,7 @@ SV * newSVGUserDirectory (GUserDirectory dir);
#endif
/*
- * -- GVariant ----------------------------------------------------------------
+ * --- GVariant ---------------------------------------------------------------
*/
#if GLIB_CHECK_VERSION (2, 24, 0)
@@ -379,6 +379,16 @@ const GVariantType * SvGVariantType (SV * sv);
#endif /* 2.24.0 */
/*
+ * --- GBytes -----------------------------------------------------------------
+ */
+#if GLIB_CHECK_VERSION (2, 32, 0)
+typedef GBytes GBytes_own;
+#define SvGBytes(sv) (gperl_get_boxed_check ((sv), G_TYPE_BYTES))
+#define newSVGBytes(val) (gperl_new_boxed ((gpointer) (val),
G_TYPE_BYTES, FALSE))
+#define newSVGBytes_own(val) (gperl_new_boxed ((gpointer) (val),
G_TYPE_BYTES, TRUE))
+#endif
+
+/*
* --- miscellaneous ----------------------------------------------------------
*/
diff --git a/lib/Glib.pm b/lib/Glib.pm
index cf109f1..37fa19b 100644
--- a/lib/Glib.pm
+++ b/lib/Glib.pm
@@ -100,6 +100,12 @@ sub domain { $_[0]->{domain} }
sub value { $_[0]->{value} }
sub code { $_[0]->{code} }
+package Glib::Bytes;
+
+use overload
+ '""' => sub { $_[0]->get_data },
+ fallback => 1;
+
package Glib::Object::Property;
use Carp;
diff --git a/t/bytes.t b/t/bytes.t
new file mode 100644
index 0000000..7cc8d73
--- /dev/null
+++ b/t/bytes.t
@@ -0,0 +1,50 @@
+#!/usr/bin/perl
+
+#
+# Test the GBytes wrappers.
+#
+
+use strict;
+use warnings;
+use Glib;
+use Test::More;
+
+unless (Glib -> CHECK_VERSION (2, 32, 0)) {
+ plan skip_all => 'GBytes is new in 2.32';
+} else {
+ plan tests => 13;
+}
+
+# Basic API.
+my $data = pack 'C*', 0..255;
+
+my $bytes = Glib::Bytes->new ($data);
+isa_ok ($bytes, 'Glib::Bytes');
+isa_ok ($bytes, 'Glib::Boxed');
+
+is ($bytes->get_size, length $data);
+is ($bytes->get_data, $data);
+
+ok (defined $bytes->hash);
+ok ($bytes->equal ($bytes));
+is ($bytes->compare ($bytes), 0);
+
+# Overloading.
+is ("$bytes", $data, '"" overloading');
+ok ($bytes eq $data, 'eq overloading');
+is (length $bytes, length $data, 'length overloading');
+
+# Wide characters.
+eval {
+ my $wstring = "\x{2665}";
+ my $bytes = Glib::Bytes->new ($wstring);
+};
+like ($@, qr/Wide character/);
+
+eval {
+ my $wstring = "\x{2665}";
+ utf8::encode ($wstring);
+ my $bytes = Glib::Bytes->new ($wstring);
+ is ($bytes->get_data, pack ('C*', 0xE2,0x99,0xA5));
+};
+is ($@, '');
diff --git a/typemap b/typemap
index 5aec2fb..1e86762 100644
--- a/typemap
+++ b/typemap
@@ -108,6 +108,9 @@ GVariantType * T_GPERL_GENERIC_WRAPPER
const GVariantType * T_GPERL_GENERIC_WRAPPER
GVariantType_own * T_GPERL_GENERIC_WRAPPER
+GBytes * T_GPERL_GENERIC_WRAPPER
+GBytes_own * T_GPERL_GENERIC_WRAPPER
+
###############################################################################
INPUT
--
Alioth's /usr/local/bin/git-commit-notice on
/srv/git.debian.org/git/pkg-perl/packages/libglib-perl.git
_______________________________________________
Pkg-perl-cvs-commits mailing list
Pkg-perl-cvs-commits@lists.alioth.debian.org
http://lists.alioth.debian.org/cgi-bin/mailman/listinfo/pkg-perl-cvs-commits
