Glib-Object-Introspection
view release on metacpan or search on metacpan
GObjectIntrospection.xs view on Meta::CPAN
#include "gperl-i11n-gvalue.c"
#include "gperl-i11n-info.c"
#include "gperl-i11n-invoke.c"
#include "gperl-i11n-invoke-c.c"
#include "gperl-i11n-invoke-perl.c"
#include "gperl-i11n-marshal-arg.c"
#include "gperl-i11n-marshal-array.c"
#include "gperl-i11n-marshal-callback.c"
#include "gperl-i11n-marshal-hash.c"
#include "gperl-i11n-marshal-interface.c"
#include "gperl-i11n-marshal-list.c"
#include "gperl-i11n-marshal-raw.c"
#include "gperl-i11n-marshal-struct.c"
#include "gperl-i11n-method.c"
#include "gperl-i11n-size.c"
#include "gperl-i11n-union.c"
#include "gperl-i11n-vfunc-interface.c"
#include "gperl-i11n-vfunc-object.c"
/* ------------------------------------------------------------------------- */
MODULE = Glib::Object::Introspection PACKAGE = Glib::Object::Introspection
gboolean
CHECK_VERSION (class, gint major, gint minor, gint micro)
CODE:
RETVAL = GI_CHECK_VERSION (major, minor, micro);
OUTPUT:
RETVAL
void
_load_library (class, namespace, version, search_path=NULL)
const gchar *namespace
const gchar *version
const gchar_ornull *search_path
PREINIT:
GIRepository *repository;
GError *error = NULL;
CODE:
if (search_path)
g_irepository_prepend_search_path (search_path);
repository = g_irepository_get_default ();
g_irepository_require (repository, namespace, version, 0, &error);
if (error) {
gperl_croak_gerror (NULL, error);
}
void
_register_types (class, namespace, package)
const gchar *namespace
const gchar *package
PREINIT:
GIRepository *repository;
gint number, i;
AV *constants;
AV *global_functions;
HV *namespaced_functions;
HV *fields;
AV *interfaces;
AV *objects_with_vfuncs;
PPCODE:
repository = g_irepository_get_default ();
constants = newAV ();
global_functions = newAV ();
namespaced_functions = newHV ();
fields = newHV ();
interfaces = newAV ();
objects_with_vfuncs = newAV ();
number = g_irepository_get_n_infos (repository, namespace);
for (i = 0; i < number; i++) {
GIBaseInfo *info;
GIInfoType info_type;
const gchar *name;
gchar *full_package;
GType type;
info = g_irepository_get_info (repository, namespace, i);
info_type = g_base_info_get_type (info);
name = g_base_info_get_name (info);
dwarn ("setting up %s.%s\n", namespace, name);
if (info_type == GI_INFO_TYPE_CONSTANT) {
dwarn (" -> constant\n");
av_push (constants, newSVpv (name, 0));
}
if (info_type == GI_INFO_TYPE_FUNCTION) {
dwarn (" -> global function\n");
av_push (global_functions, newSVpv (name, 0));
}
if (info_type == GI_INFO_TYPE_INTERFACE) {
dwarn (" -> interface\n");
av_push (interfaces, newSVpv (name, 0));
}
if (info_type == GI_INFO_TYPE_OBJECT ||
info_type == GI_INFO_TYPE_INTERFACE ||
info_type == GI_INFO_TYPE_BOXED ||
info_type == GI_INFO_TYPE_STRUCT ||
info_type == GI_INFO_TYPE_UNION ||
info_type == GI_INFO_TYPE_ENUM ||
info_type == GI_INFO_TYPE_FLAGS)
{
dwarn (" looking for methods\n");
store_methods (namespaced_functions, info, info_type);
}
if (info_type == GI_INFO_TYPE_BOXED ||
info_type == GI_INFO_TYPE_STRUCT ||
info_type == GI_INFO_TYPE_UNION)
{
dwarn (" looking for fields\n");
store_fields (fields, info, info_type);
}
if (info_type == GI_INFO_TYPE_OBJECT) {
dwarn (" looking for vfuncs\n");
GObjectIntrospection.xs view on Meta::CPAN
const gchar *target_package
PREINIT:
GIRepository *repository;
GIInterfaceInfo *info;
GInterfaceInfo iface_info;
GType gtype;
CODE:
repository = g_irepository_get_default ();
info = g_irepository_find_by_name (repository, basename, interface_name);
if (!GI_IS_INTERFACE_INFO (info))
ccroak ("not an interface");
iface_info.interface_init = generic_interface_init;
iface_info.interface_finalize = generic_interface_finalize,
iface_info.interface_data = info;
gtype = gperl_object_type_from_package (target_package);
if (!gtype)
ccroak ("package '%s' is not registered with Glib-Perl",
target_package);
g_type_add_interface_static (gtype, get_gtype (info), &iface_info);
/* info is unref'd in generic_interface_finalize */
void
_install_overrides (class, basename, object_name, target_package)
const gchar *basename
const gchar *object_name
const gchar *target_package
PREINIT:
GIRepository *repository;
GIObjectInfo *info;
GType gtype;
gpointer klass;
CODE:
dwarn ("%s.%s for %s\n",
basename, object_name, target_package);
repository = g_irepository_get_default ();
info = g_irepository_find_by_name (repository, basename, object_name);
if (!GI_IS_OBJECT_INFO (info))
ccroak ("not an object");
gtype = gperl_object_type_from_package (target_package);
if (!gtype)
ccroak ("package '%s' is not registered with Glib-Perl",
target_package);
klass = g_type_class_peek (gtype);
if (!klass)
ccroak ("internal problem: can't peek at type class for %s (%" G_GSIZE_FORMAT ")",
g_type_name (gtype), gtype);
generic_class_init (info, target_package, klass);
g_base_info_unref (info);
void
_find_non_perl_parents (class, basename, object_name, target_package)
const gchar *basename
const gchar *object_name
const gchar *target_package
PREINIT:
GIRepository *repository;
GIObjectInfo *info;
GType gtype, object_gtype;
/* FIXME: we should export gperl_type_reg_quark from Glib */
GQuark reg_quark = g_quark_from_static_string ("__gperl_type_reg");
PPCODE:
repository = g_irepository_get_default ();
info = g_irepository_find_by_name (repository, basename, object_name);
g_assert (info && GI_IS_OBJECT_INFO (info));
gtype = gperl_object_type_from_package (target_package);
object_gtype = get_gtype (info);
/* find all non-Perl parents up to and including the object type */
while ((gtype = g_type_parent (gtype))) {
if (!g_type_get_qdata (gtype, reg_quark)) {
const gchar *package = gperl_object_package_from_type (gtype);
XPUSHs (sv_2mortal (newSVpv (package, 0)));
}
if (gtype == object_gtype) {
break;
}
}
g_base_info_unref (info);
void
_find_vfuncs_with_implementation (class, object_package, target_package)
const gchar *object_package
const gchar *target_package
PREINIT:
GIRepository *repository;
GType object_gtype, target_gtype;
gpointer object_klass, target_klass;
GIObjectInfo *object_info;
gint n_vfuncs, i;
PPCODE:
repository = g_irepository_get_default ();
target_gtype = gperl_object_type_from_package (target_package);
object_gtype = gperl_object_type_from_package (object_package);
g_assert (target_gtype && object_gtype);
target_klass = g_type_class_peek (target_gtype);
object_klass = g_type_class_peek (object_gtype);
g_assert (target_klass && object_klass);
object_info = g_irepository_find_by_gtype (repository, object_gtype);
g_assert (object_info && GI_IS_OBJECT_INFO (object_info));
n_vfuncs = g_object_info_get_n_vfuncs (object_info);
for (i = 0; i < n_vfuncs; i++) {
GIVFuncInfo *vfunc_info;
const gchar *vfunc_name;
gint field_offset;
vfunc_info = g_object_info_get_vfunc (object_info, i);
vfunc_name = g_base_info_get_name (vfunc_info);
/* FIXME: g_vfunc_info_get_offset does not seem to work here. */
field_offset = get_vfunc_offset (object_info, vfunc_name);
if (G_STRUCT_MEMBER (gpointer, target_klass, field_offset)) {
XPUSHs (sv_2mortal (newSVpv (vfunc_name, 0)));
}
g_base_info_unref (vfunc_info);
}
g_base_info_unref (object_info);
void
_invoke_fallback_vfunc (class, vfunc_package, vfunc_name, target_package, ...)
const gchar *vfunc_package
const gchar *vfunc_name
const gchar *target_package
PREINIT:
UV internal_stack_offset = 4;
GIRepository *repository;
GIObjectInfo *info;
GType gtype;
gpointer klass;
GIVFuncInfo *vfunc_info;
gint field_offset;
gpointer func_pointer;
PPCODE:
dwarn ("%s::%s, target = %s\n",
vfunc_package, vfunc_name, target_package);
gtype = gperl_object_type_from_package (target_package);
klass = g_type_class_peek (gtype);
g_assert (klass);
repository = g_irepository_get_default ();
info = g_irepository_find_by_gtype (
repository, gperl_object_type_from_package (vfunc_package));
g_assert (info && GI_IS_OBJECT_INFO (info));
vfunc_info = g_object_info_find_vfunc (info, vfunc_name);
g_assert (vfunc_info);
/* FIXME: g_vfunc_info_get_offset does not seem to work here. */
field_offset = get_vfunc_offset (info, vfunc_name);
func_pointer = G_STRUCT_MEMBER (gpointer, klass, field_offset);
g_assert (func_pointer);
invoke_c_code (vfunc_info, func_pointer,
sp, ax, mark, items,
internal_stack_offset,
NULL, NULL, NULL);
/* SPAGAIN since invoke_c_code probably modified the stack
* pointer. so we need to make sure that our local variable
* 'sp' is correct before the implicit PUTBACK happens. */
SPAGAIN;
g_base_info_unref (vfunc_info);
g_base_info_unref (info);
void
_use_generic_signal_marshaller_for (class, const gchar *package, const gchar *signal, SV *args_converter=NULL)
CODE:
#if GI_CHECK_VERSION (1, 33, 10)
{
GType gtype;
GIRepository *repository;
GIBaseInfo *container_info;
GPerlI11nPerlSignalInfo *signal_info;
ffi_cif *cif;
ffi_closure *closure;
GIBaseInfo *closure_marshal_info;
gtype = gperl_type_from_package (package);
if (!gtype)
ccroak ("Could not find GType for package %s", package);
repository = g_irepository_get_default ();
container_info = g_irepository_find_by_gtype (repository, gtype);
if (!container_info ||
!(GI_IS_OBJECT_INFO (container_info) ||
GI_IS_INTERFACE_INFO (container_info)))
ccroak ("Could not find object/interface info for package %s",
package);
signal_info = g_new0 (GPerlI11nPerlSignalInfo, 1); // FIXME: ctor?
signal_info->interface = get_signal_info (container_info, signal);
if (args_converter)
signal_info->args_converter = SvREFCNT_inc (args_converter);
if (!signal_info)
ccroak ("Could not find signal %s for package %s",
signal, package);
closure_marshal_info = g_irepository_find_by_name (repository,
GObjectIntrospection.xs view on Meta::CPAN
signal_info);
if (closure != NULL)
closure =
(ffi_closure *) g_callable_info_get_closure_native_address (closure_marshal_info,
closure);
#else
G_GNUC_BEGIN_IGNORE_DEPRECATIONS
closure = g_callable_info_prepare_closure (closure_marshal_info,
cif,
invoke_perl_signal_handler,
signal_info);
G_GNUC_END_IGNORE_DEPRECATIONS
#endif
g_base_info_unref (closure_marshal_info);
dwarn ("package = %s, signal = %s => closure = %p\n",
package, signal, closure);
gperl_signal_set_marshaller_for (gtype, (gchar*) signal, (GClosureMarshal) closure);
/* These should be freed when the signal marshaller is not needed
* anymore. But gperl_signal_set_marshaller_for does not provide a
* hook for resource freeing.
*
* g_callable_info_free_closure (signal_info, closure);
* g_free (cif);
* g_base_info_unref (signal_info->interface);
* if (signal_info->args_converter)
* SvREFCNT_dec (signal_info->args_converter);
* g_free (signal_info);
*/
g_base_info_unref (container_info);
}
#else
{
PERL_UNUSED_VAR (args_converter);
/* g_callable_info_prepare_closure, and thus
* create_perl_callback_closure and invoke_perl_signal_handler, did not
* work correctly for signals prior to commit
* d8970fbc500a8b20853b564536251315587450d9 in
* gobject-introspection. */
warn ("*** Cannot use generic signal marshallers for signal '%s' of %s "
"unless gobject-introspection >= 1.33.10; "
"any handlers connected to the signal "
"might thus be invoked incorrectly\n",
signal, package);
}
#endif
void
invoke (class, basename, namespace, function, ...)
const gchar *basename
const gchar_ornull *namespace
const gchar *function
PREINIT:
UV internal_stack_offset = 4;
GIRepository *repository;
GIFunctionInfo *info;
gpointer func_pointer = NULL;
const gchar *symbol = NULL;
PPCODE:
repository = g_irepository_get_default ();
info = get_function_info (repository, basename, namespace, function);
symbol = g_function_info_get_symbol (info);
if (!g_typelib_symbol (g_base_info_get_typelib((GIBaseInfo *) info),
symbol, &func_pointer))
{
g_base_info_unref ((GIBaseInfo *) info);
ccroak ("Could not locate symbol %s", symbol);
}
invoke_c_code (info, func_pointer,
sp, ax, mark, items,
internal_stack_offset,
get_package_for_basename (basename), namespace, function);
/* SPAGAIN since invoke_c_code probably modified the stack pointer.
* so we need to make sure that our implicit local variable 'sp' is
* correct before the implicit PUTBACK happens. */
SPAGAIN;
g_base_info_unref ((GIBaseInfo *) info);
gint
convert_sv_to_enum (class, const gchar *package, SV *sv)
PREINIT:
GType gtype;
CODE:
gtype = gperl_type_from_package (package);
RETVAL = gperl_convert_enum (gtype, sv);
OUTPUT:
RETVAL
SV *
convert_enum_to_sv (class, const gchar *package, gint n)
PREINIT:
GType gtype;
CODE:
gtype = gperl_type_from_package (package);
RETVAL = gperl_convert_back_enum (gtype, n);
OUTPUT:
RETVAL
gint
convert_sv_to_flags (class, const gchar *package, SV *sv)
PREINIT:
GType gtype;
CODE:
gtype = gperl_type_from_package (package);
RETVAL = gperl_convert_flags (gtype, sv);
OUTPUT:
RETVAL
SV *
convert_flags_to_sv (class, const gchar *package, gint n)
PREINIT:
GType gtype;
CODE:
gtype = gperl_type_from_package (package);
RETVAL = gperl_convert_back_flags (gtype, n);
OUTPUT:
RETVAL
# --------------------------------------------------------------------------- #
MODULE = Glib::Object::Introspection PACKAGE = Glib::Object::Introspection::GValueWrapper
SV *
new (class, const gchar *type_package, SV *perl_value)
PREINIT:
GType type;
GValue *v;
CODE:
type = gperl_type_from_package (type_package);
if (!type)
ccroak ("Could not find GType for '%s'", type_package);
v = g_new0 (GValue, 1);
g_value_init (v, type);
gperl_value_from_sv (v, perl_value);
RETVAL = newSVGValueWrapper (v);
OUTPUT:
RETVAL
SV *
get_value (SV *sv)
PREINIT:
GValue *v;
CODE:
v = SvGValueWrapper (sv);
RETVAL = gperl_sv_from_value (v);
OUTPUT:
RETVAL
void
DESTROY (SV *sv)
PREINIT:
GValue *v;
CODE:
v = SvGValueWrapper (sv);
g_value_unset (v);
g_free (v);
# --------------------------------------------------------------------------- #
MODULE = Glib::Object::Introspection PACKAGE = Glib::Object::Introspection::_FuncWrapper
void
_invoke (SV *code, ...)
PREINIT:
GPerlI11nCCallbackInfo *wrapper;
UV internal_stack_offset = 1;
PPCODE:
wrapper = INT2PTR (GPerlI11nCCallbackInfo*, SvIV (SvRV (code)));
if (!wrapper || !wrapper->func)
ccroak ("invalid reference encountered");
invoke_c_code (wrapper->interface, wrapper->func,
sp, ax, mark, items,
internal_stack_offset,
NULL, NULL, NULL);
/* SPAGAIN since invoke_c_code probably modified the stack
* pointer. so we need to make sure that our local variable
* 'sp' is correct before the implicit PUTBACK happens. */
SPAGAIN;
void
DESTROY (SV *code)
PREINIT:
GPerlI11nCCallbackInfo *info;
CODE:
info = INT2PTR (GPerlI11nCCallbackInfo*, SvIV (SvRV (code)));
if (info)
release_c_callback (info);
( run in 0.720 second using v1.01-cache-2.11-cpan-5511b514fd6 )