Commit d0c52b8b authored by Torsten Schönfeld's avatar Torsten Schönfeld
Browse files

Add Glib::Variant and Glib::VariantType

Wrapping the majority of the GVariant and GVariantType API.
parent c4015e04
......@@ -369,6 +369,12 @@ BOOT:
gperl_register_error_domain (G_THREAD_ERROR,
GPERL_TYPE_THREAD_ERROR,
"Glib::Thread::Error");
#if GLIB_CHECK_VERSION (2, 24, 0)
/* gvariant.h */
gperl_register_error_domain (G_VARIANT_PARSE_ERROR,
GPERL_TYPE_VARIANT_PARSE_ERROR,
"Glib::Variant::ParseError");
#endif
PERL_UNUSED_VAR (file);
......
This diff is collapsed.
......@@ -470,6 +470,9 @@ BOOT:
#if GLIB_CHECK_VERSION (2, 12, 0)
GPERL_CALL_BOOT (boot_Glib__BookmarkFile);
#endif /* GLIB_CHECK_VERSION (2, 12, 0) */
#if GLIB_CHECK_VERSION (2, 24, 0)
GPERL_CALL_BOOT (boot_Glib__Variant);
#endif /* GLIB_CHECK_VERSION (2, 24, 0) */
/* make sure that we're running/linked against a version at least as
* new as we built against, otherwise bad things will happen. */
if ((((int)glib_major_version) < GLIB_MAJOR_VERSION)
......
......@@ -89,6 +89,10 @@ if (ExtUtils::PkgConfig->atleast_version ('glib-2.0', '2.12.0')) {
push @xs_files, 'GBookmarkFile.xs';
}
if (ExtUtils::PkgConfig->atleast_version ('glib-2.0', '2.24.0')) {
push @xs_files, 'GVariant.xs';
}
my %meta_merge = (
q(meta-spec) => {
version => '2',
......
......@@ -510,3 +510,42 @@ gperl_thread_error_get_type (void)
#define GPERL_TYPE_THREAD_ERROR gperl_thread_error_get_type()
GType gperl_thread_error_get_type (void);
/* -------------------------------------------------------------------------- */
#if GLIB_CHECK_VERSION (2, 24, 0)
GType
gperl_variant_parse_error_get_type (void)
{
static GType type = 0;
if (!type) {
static const GEnumValue values[] = {
{ G_VARIANT_PARSE_ERROR_FAILED, "G_VARIANT_PARSE_ERROR_FAILED", "failed" },
{ G_VARIANT_PARSE_ERROR_BASIC_TYPE_EXPECTED, "G_VARIANT_PARSE_ERROR_BASIC_TYPE_EXPECTED", "basic-type-expected" },
{ G_VARIANT_PARSE_ERROR_CANNOT_INFER_TYPE, "G_VARIANT_PARSE_ERROR_CANNOT_INFER_TYPE", "cannot-infer-type" },
{ G_VARIANT_PARSE_ERROR_DEFINITE_TYPE_EXPECTED, "G_VARIANT_PARSE_ERROR_DEFINITE_TYPE_EXPECTED", "definite-type-expected" },
{ G_VARIANT_PARSE_ERROR_INPUT_NOT_AT_END, "G_VARIANT_PARSE_ERROR_INPUT_NOT_AT_END", "input-not-at-end" },
{ G_VARIANT_PARSE_ERROR_INVALID_CHARACTER, "G_VARIANT_PARSE_ERROR_INVALID_CHARACTER", "invalid-character" },
{ G_VARIANT_PARSE_ERROR_INVALID_FORMAT_STRING, "G_VARIANT_PARSE_ERROR_INVALID_FORMAT_STRING", "invalid-format-string" },
{ G_VARIANT_PARSE_ERROR_INVALID_OBJECT_PATH, "G_VARIANT_PARSE_ERROR_INVALID_OBJECT_PATH", "invalid-object-path" },
{ G_VARIANT_PARSE_ERROR_INVALID_SIGNATURE, "G_VARIANT_PARSE_ERROR_INVALID_SIGNATURE", "invalid-signature" },
{ G_VARIANT_PARSE_ERROR_INVALID_TYPE_STRING, "G_VARIANT_PARSE_ERROR_INVALID_TYPE_STRING", "invalid-type-string" },
{ G_VARIANT_PARSE_ERROR_NO_COMMON_TYPE, "G_VARIANT_PARSE_ERROR_NO_COMMON_TYPE", "no-common-type" },
{ G_VARIANT_PARSE_ERROR_NUMBER_OUT_OF_RANGE, "G_VARIANT_PARSE_ERROR_NUMBER_OUT_OF_RANGE", "number-out-of-range" },
{ G_VARIANT_PARSE_ERROR_NUMBER_TOO_BIG, "G_VARIANT_PARSE_ERROR_NUMBER_TOO_BIG", "number-too-big" },
{ G_VARIANT_PARSE_ERROR_TYPE_ERROR, "G_VARIANT_PARSE_ERROR_TYPE_ERROR", "type-error" },
{ G_VARIANT_PARSE_ERROR_UNEXPECTED_TOKEN, "G_VARIANT_PARSE_ERROR_UNEXPECTED_TOKEN", "unexpected-token" },
{ G_VARIANT_PARSE_ERROR_UNKNOWN_KEYWORD, "G_VARIANT_PARSE_ERROR_UNKNOWN_KEYWORD", "unknown-keyword" },
{ G_VARIANT_PARSE_ERROR_UNTERMINATED_STRING_CONSTANT, "G_VARIANT_PARSE_ERROR_UNTERMINATED_STRING_CONSTANT", "unterminated-string-constant" },
{ G_VARIANT_PARSE_ERROR_VALUE_EXPECTED, "G_VARIANT_PARSE_ERROR_VALUE_EXPECTED", "value-expected" },
{ 0, NULL, NULL }
};
type = g_enum_register_static ("GVariantParseError", values);
}
return type;
}
#endif
......@@ -79,6 +79,11 @@ GType gperl_spawn_error_get_type (void) G_GNUC_CONST;
#define GPERL_TYPE_THREAD_ERROR gperl_thread_error_get_type ()
GType gperl_thread_error_get_type (void) G_GNUC_CONST;
#if GLIB_CHECK_VERSION (2, 24, 0)
#define GPERL_TYPE_VARIANT_PARSE_ERROR gperl_variant_parse_error_get_type ()
GType gperl_variant_parse_error_get_type (void);
#endif
G_END_DECLS
#endif /* __GPERL_GTYPES_H__ */
......@@ -362,8 +362,22 @@ SV * newSVGUserDirectory (GUserDirectory dir);
#endif
/*
* miscellaneous
* -- GVariant ----------------------------------------------------------------
*/
#if GLIB_CHECK_VERSION (2, 24, 0)
typedef GVariant GVariant_noinc;
SV * newSVGVariant (GVariant * variant);
SV * newSVGVariant_noinc (GVariant * variant);
GVariant * SvGVariant (SV * sv);
typedef GVariantType GVariantType_own;
SV * newSVGVariantType (const GVariantType * type);
SV * newSVGVariantType_own (const GVariantType * type);
const GVariantType * SvGVariantType (SV * sv);
#endif /* 2.24.0 */
/*
* --- miscellaneous ----------------------------------------------------------
*/
......
......@@ -216,6 +216,155 @@ sub AUTOLOAD {
return $object_or_type->$method (@_);
}
package Glib::Variant;
my %LEAF_HANDLERS = (
b => ['new_boolean', 'get_boolean'],
y => ['new_byte', 'get_byte'],
n => ['new_int16', 'get_int16'],
q => ['new_uint16', 'get_uint16'],
i => ['new_int32', 'get_int32'],
u => ['new_uint32', 'get_uint32'],
x => ['new_int64', 'get_int64'],
t => ['new_uint64', 'get_uint64'],
h => ['new_handle', 'get_handle'],
d => ['new_double', 'get_double'],
s => ['new_string', 'get_string'],
o => ['new_object_path', 'get_string'],
g => ['new_signature', 'get_string'],
);
# Documented in GVariant.xs.
sub new {
my ($class, $format, @values) = @_;
if (!defined $format || $format eq '') {
return;
}
my ($ts, $format_rest) = Glib::VariantType::string_scan ($format);
my ($value, @values_rest) = @values;
my $t = Glib::VariantType->new ($ts);
my $v;
if ($t->is_basic) {
my $ctor = $LEAF_HANDLERS{$t->get_string}->[0];
$v = Glib::Variant->$ctor ($value);
}
elsif ($t->is_variant) {
$v = Glib::Variant->new_variant ($value);
}
elsif ($t->is_array) {
my $et = $t->element;
my @children;
if (eval { defined $#$value }) {
@children = map { Glib::Variant->new ($et->get_string, $_) } @$value;
} elsif ($et->is_dict_entry && eval { defined scalar %$value }) {
while (my ($ek, $ev) = each %$value) {
push @children, Glib::Variant->new ($et->get_string, [$ek, $ev]);
}
} else {
Carp::croak ('Expected an array ref');
}
$v = Glib::Variant->new_array ($et, \@children);
}
elsif ($t->is_maybe) {
my $et = $t->element;
my $child = defined $value ? Glib::Variant->new ($et->get_string, $value) : undef;
$v = Glib::Variant->new_maybe ($et, $child);
}
elsif ($t->is_tuple) {
my $n = $t->n_items;
if ($n && !eval { $#$value+1 == $n }) {
Carp::croak ("Expected an array ref with $n elements");
}
my @children;
for (my ($i, $et) = (0, $t->first); $et; $i++, $et = $et->next) {
push @children, Glib::Variant->new ($et->get_string, $value->[$i]);
}
$v = Glib::Variant->new_tuple (\@children);
}
elsif ($t->is_dict_entry) {
my $kt = $t->first;
my $vt = $kt->next;
my $kv = Glib::Variant->new ($kt->get_string, $value->[0]);
my $vv = Glib::Variant->new ($vt->get_string, $value->[1]);
$v = Glib::Variant->new_dict_entry ($kv, $vv);
}
else {
Carp::croak ("Cannot handle the part '$ts' in the format string '$format'");
}
return wantarray ? ($v, Glib::Variant->new ($format_rest, @values_rest)) : $v;
}
# Documented in GVariant.xs.
sub get {
my ($v, $format) = @_;
if (!defined $format || $format eq '') {
return;
}
my ($ts, $format_rest) = Glib::VariantType::string_scan ($format);
if (defined $format_rest) {
Carp::carp ("Unhandled rest of format string detected: '$format_rest'");
}
my $t = Glib::VariantType->new ($ts);
my $value;
if ($t->is_basic) {
my $getter = $LEAF_HANDLERS{$t->get_string}->[1];
$value = $v->$getter;
}
elsif ($t->is_variant) {
$value = $v->get_variant;
}
elsif ($t->is_array) {
my $et = $t->element;
my @children;
foreach my $i (1 .. $v->n_children) {
push @children, $v->get_child_value ($i-1)->get ($et->get_string);
}
$value = \@children;
}
elsif ($t->is_maybe) {
my $et = $t->element;
my $wrapper = $v->get_maybe;
$value = defined $wrapper ? $wrapper->get ($et->get_string) : undef;
}
elsif ($t->is_tuple) {
my $n = $t->n_items;
my @children;
for (my ($i, $et) = (0, $t->first); $et; $i++, $et = $et->next) {
push @children, $v->get_child_value ($i)->get ($et->get_string);
}
$value = \@children;
}
elsif ($t->is_dict_entry) {
my $kt = $t->first;
my $vt = $kt->next;
my $kv = $v->get_child_value (0)->get ($kt->get_string);
my $vv = $v->get_child_value (1)->get ($vt->get_string);
$value = [$kv, $vv];
}
else {
Carp::croak ("Cannot handle the part '$ts' in the format string '$format'");
}
return $value;
}
package Glib;
1;
......
#!perl
use strict;
use warnings;
use utf8;
use Glib qw/TRUE FALSE/;
use Test::More;
use constant {
MIN_INT64 => "-9223372036854775807",
MAX_INT64 => "9223372036854775807",
MIN_UINT64 => "0",
MAX_UINT64 => "18446744073709551615"
};
if (Glib->CHECK_VERSION (2, 24, 0)) {
plan tests => 211;
} else {
plan skip_all => 'Need libglib >= 2.24';
}
my @leafs = (
[ 'new_boolean', 'get_boolean', 'b', TRUE ],
[ 'new_byte', 'get_byte', 'y', 2**8-1 ],
[ 'new_int16', 'get_int16', 'n', 2**15-1 ],
[ 'new_uint16', 'get_uint16', 'q', 2**16-1 ],
[ 'new_int32', 'get_int32', 'i', 2**31-1 ],
[ 'new_uint32', 'get_uint32', 'u', 2**32-1 ],
[ 'new_int64', 'get_int64', 'x', MAX_INT64 ],
[ 'new_uint64', 'get_uint64', 't', MAX_UINT64 ],
[ 'new_handle', 'get_handle', 'h', 2**31-1 ],
[ 'new_double', 'get_double', 'd', 0.25 ],
[ 'new_string', 'get_string', 's', 'äöü⁂üöä' ],
[ 'new_object_path', 'get_string', 'o', '/a/b/c' ],
[ 'new_signature', 'get_string', 'g', 'ii' ],
);
{
foreach my $l (@leafs) {
my ($ctor, $getter, $type_string, $value) = @$l;
note ($ctor);
my $v = Glib::Variant->$ctor ($value);
isa_ok ($v, 'Glib::Variant');
isa_ok ($v->get_type, 'Glib::VariantType');
ok ($v->is_of_type ($v->get_type));
is ($v->get_type_string, $type_string);
ok (!$v->is_container);
is ($v->classify, $type_string);
is ($v->$getter, $value);
}
ok (Glib::Variant::is_object_path ('/a/b/c'));
ok (Glib::Variant::is_signature ('ii'));
}
note ('new_variant');
{
{
my $child = Glib::Variant->new_byte (23);
my $wrapper = Glib::Variant->new_variant ($child);
isa_ok ($wrapper, 'Glib::Variant');
is ($wrapper->get_type_string, 'v');
is ($wrapper->classify, 'v');
{
my $wrapped_child = $wrapper->get_variant;
is ($wrapped_child->get_byte, 23);
}
undef $child;
{
my $wrapped_child = $wrapper->get_variant;
is ($wrapped_child->get_byte, 23);
}
}
{
my $child = Glib::Variant->new_byte (23);
my $wrapper = Glib::Variant->new_variant ($child);
undef $wrapper;
is ($child->get_byte, 23);
}
}
note ('new_bytestring');
SKIP: {
skip 'new_bytestring', 6
unless Glib->CHECK_VERSION (2, 26, 0);
{
my $bs = "\x{a3}\x{ff}";
my $v = Glib::Variant->new_bytestring ($bs);
isa_ok ($v, 'Glib::Variant');
is ($v->get_type_string, 'ay');
is ($v->classify, 'a');
is ($v->get_bytestring, $bs);
}
{
my $bs = "\x{a3}\x{ff}";
utf8::upgrade ($bs);
my $v = Glib::Variant->new_bytestring ($bs);
is ($v->get_bytestring, $bs);
}
{
my $bs = "\x{a3}\x{ff}";
utf8::encode ($bs);
my $v = Glib::Variant->new_bytestring ($bs);
is ($v->get_bytestring, $bs);
}
}
note ('new_maybe');
{
my $child_type = 'y';
my $child = Glib::Variant->new_byte (42);
{
my $wrapper = Glib::Variant->new_maybe ($child_type, undef);
isa_ok ($wrapper, 'Glib::Variant');
is ($wrapper->get_type_string, 'my');
is ($wrapper->classify, 'm');
ok (! defined $wrapper->get_maybe);
is ($wrapper->n_children, 0);
}
{
my $wrapper = Glib::Variant->new_maybe (undef, $child);
isa_ok ($wrapper, 'Glib::Variant');
is ($wrapper->get_type_string, 'my');
is ($wrapper->classify, 'm');
is ($wrapper->get_maybe->get_byte, $child->get_byte);
is ($wrapper->n_children, 1);
is ($wrapper->get_child_value (0)->get_byte, 42);
}
{
my $wrapper = Glib::Variant->new_maybe ($child_type, $child);
isa_ok ($wrapper, 'Glib::Variant');
is ($wrapper->get_type_string, 'my');
is ($wrapper->classify, 'm');
is ($wrapper->get_maybe->get_byte, $child->get_byte);
is ($wrapper->n_children, 1);
is ($wrapper->get_child_value (0)->get_byte, $child->get_byte);
}
}
note ('new_array');
{
my $child_type = 'y';
my $children = [map { Glib::Variant->new_byte ($_) } (23, 42, 65)];
{
my $array = Glib::Variant->new_array ($child_type, []);
isa_ok ($array, 'Glib::Variant');
is ($array->get_type_string, 'ay');
is ($array->classify, 'a');
is ($array->n_children, 0);
}
{
my $array = Glib::Variant->new_array (undef, $children);
isa_ok ($array, 'Glib::Variant');
is ($array->get_type_string, 'ay');
is ($array->classify, 'a');
is ($array->n_children, 3);
is ($array->get_child_value (2)->get_byte, $children->[2]->get_byte);
}
{
my $array = Glib::Variant->new_array ($child_type, $children);
isa_ok ($array, 'Glib::Variant');
is ($array->get_type_string, 'ay');
is ($array->classify, 'a');
is ($array->n_children, 3);
is ($array->get_child_value (2)->get_byte, $children->[2]->get_byte);
}
}
note ('new_tuple');
{
my $children = [Glib::Variant->new_byte (23),
Glib::Variant->new_string ('forty-two'),
Glib::Variant->new_double (0.25)];
{
my $tuple = Glib::Variant->new_tuple ([]);
isa_ok ($tuple, 'Glib::Variant');
is ($tuple->get_type_string, '()');
is ($tuple->classify, '(');
is ($tuple->n_children, 0);
}
{
my $tuple = Glib::Variant->new_tuple ($children);
isa_ok ($tuple, 'Glib::Variant');
is ($tuple->get_type_string, '(ysd)');
is ($tuple->classify, '(');
is ($tuple->n_children, 3);
is ($tuple->get_child_value (2)->get_double, $children->[2]->get_double);
}
}
note ('new_dict_entry');
{
my $key = Glib::Variant->new_string ('forty-two');
my $value = Glib::Variant->new_byte (23);
{
my $entry = Glib::Variant->new_dict_entry ($key, $value);
isa_ok ($entry, 'Glib::Variant');
is ($entry->get_type_string, '{sy}');
is ($entry->classify, '{');
is ($entry->get_child_value (1)->get_byte, $value->get_byte);
}
}
note ('lookup_value');
{
my $entries = [map { Glib::Variant->new_dict_entry (Glib::Variant->new_string ($_->[0]),
Glib::Variant->new_byte ($_->[1])) }
(['one' => 1], ['two' => 2], ['four' => 4], ['eight' => 8])];
my $array = Glib::Variant->new_array ('{sy}', $entries);
is ($array->lookup_value ('one', 'y')->get_byte, 1);
is ($array->lookup_value ('two', undef)->get_byte, 2);
ok (! defined $array->lookup_value ('fourr', undef));
}
note ('printing and parsing');
{
{
my $a = Glib::Variant->new_byte (23);
my $text = $a->print (TRUE);
is ($text, 'byte 0x17');
is (Glib::Variant::parse (undef, $text)->get_byte, 23);
is (Glib::Variant::parse ('y', $text)->get_byte, 23);
}
{
my $text = 'byte 0x17';
eval { Glib::Variant::parse ('b', $text)->get_byte };
ok (Glib::Error::matches ($@, 'Glib::Variant::ParseError', 'type-error'));
}
}
note ('misc.');
{
my $a = Glib::Variant->new_byte (23);
my $b = Glib::Variant->new_byte (42);
ok (defined $a->get_size);
ok (defined $a->hash);
ok ($a->equal ($a));
ok (! $a->equal ($b));
is ($a->get_normal_form->get_byte, $a->get_byte);
ok ($a->is_normal_form);
is ($a->byteswap->get_byte, $a->get_byte);
SKIP: {
skip 'compare', 2
unless Glib->CHECK_VERSION (2, 26, 0);
cmp_ok ($a->compare ($b), '<', 0);
cmp_ok ($b->compare ($a), '>', 1);
}
}
note ('convenience constructor and accessor');
{
note (' leafs');
foreach my $l (@leafs) {
my ($ctor, $getter, $type_string, $value) = @$l;
my $v = Glib::Variant->new ($type_string, $value);
is ($v->get_type_string, $type_string);
is ($v->get ($type_string), $value);
}
note (' list context');
{
my ($v) = Glib::Variant->new ('i', 23);
is ($v->get ('i'), 23);
my ($v1, $v2, $v3) = Glib::Variant->new ('ids', 23, 0.25, 'äöü');
is ($v1->get ('i'), 23);
is ($v2->get ('d'), 0.25);
is ($v3->get ('s'), 'äöü');
}
note (' variant');
{
my $child = Glib::Variant->new_byte (23);
my $wrapper = Glib::Variant->new ('v', $child);
is ($wrapper->get_type_string, 'v');
{
my $wrapped_child = $wrapper->get ('v');
is ($wrapped_child->get_byte, 23);
}
}
note (' array');
{
my $v1 = Glib::Variant->new ('as', ['äöü', 'Perl', '💑']);
is_deeply ($v1->get ('as'), ['äöü', 'Perl', '💑']);
my $v2 = Glib::Variant->new ('aai', [[23, 42], [2, 3], [4, 2]]);
is_deeply ($v2->get ('aai'), [[23, 42], [2, 3], [4, 2]]);
is (Glib::Variant->new ('ai', [])->n_children, 0);
is (Glib::Variant->new ('ai', undef)->n_children, 0);
}
note (' maybe');
{
my $v1 = Glib::Variant->new ('mi', undef);
ok (! defined $v1->get ('mi'));
my $v2 = Glib::Variant->new ('mi', 23);
is ($v2->get ('mi'), 23);
my $v3 = Glib::Variant->new ('mai', undef);
ok (! defined $v3->get ('mai'));
my $v4 = Glib::Variant->new ('mai', [23, 42]);
is_deeply ($v4->get ('mai'), [23, 42]);
}
note (' tuple');
{
my $v1 = Glib::Variant->new ('()');
is ($v1->n_children, 0);
my $v2 = Glib::Variant->new ('(si)', ['äöü', 23]);
is_deeply ($v2->get ('(si)'), ['äöü', 23]);
my $v3 = Glib::Variant->new ('a(si)', [['äöü', 23], ['Perl', 42], ['💑', 2342]]);
is_deeply ($v3->get ('a(si)'), [['äöü', 23], ['Perl', 42], ['💑', 2342]]);
}
note (' dict entry');
{
my $v1 = Glib::Variant->new ('{si}', ['äöü', 23]);
is_deeply ($v1->get ('{si}'), ['äöü', 23]);
my $v2 = Glib::Variant->new ('a{si}', [['äöü', 23], ['Perl', 42], ['💑', 2342]]);
is_deeply ($v2->get ('a{si}'), [['äöü', 23], ['Perl', 42], ['💑', 2342]]);