Glib
view release on metacpan or search on metacpan
ChangeLog.pre-git view on Meta::CPAN
fundamental types that are to be used by gperl_value_from_sv() and
gperl_sv_from_value(). gperl_register_fundamental_full() is the
new function that takes a GPerlValueWrapperClass struct which
contains a GPerlValueWrapFunc and a GPerlValueUnwrapFunc.
gperl_fundamental_wrapper_class_from_type() can be used to
retrieve the GPerlValueWrapperClass that corresponds to a given
GType.
* GBoxed.xs, GType.xs: Document that gperl_register_boxed() and
gperl_register_fundamental_full() assume that the wrapper class is
statically allocated and that it will always be alive.
2005/03/07 kaffeetisch
* Glib.pm, Makefile.PL, META.yml, NEWS, README: Stable release
1.080.
2005/03/06 kaffeetisch
* GBoxed.xs: Fix a typo.
ChangeLog.pre-git view on Meta::CPAN
* README.api-changes: clearinghouse for API gripes, please amend
* GParamSpec.xs, Glib.xs, typemap, gperl.h, Makefile.PL: support
for pspecs, so we can add properties to gobjects.
* Subclass.pm, t/[345].t: extra module to ease implementation of
subclasses, and some tests for it
* Glib.pm: pod updates
* GObject.xs: big change in how perl wrappers are implemented.
the new implementation will only ever create one perl wrapper (a
real hash, with magic containing the gobject's address) for any
gobject. The combined perl+gobject will stay alive as long as one
of the partners is alive. The only real changes are in
gperl_new_object and in the DESTROY method.
* GType.xs: rename INSTANCE_INIT to INIT_INSTANCE and make it a
function call as opposed to a method call. Also call FINALIZE_INSTANCE
on object finalization time. implemented creation of properties
for an object in Glib::Type::register, and implemented calling
of SET_PROPERTY and GET_PROPERTY on the resultant object.
other changes during the merge:
* Makefile.PL: install MAN3PODS with the correct names.
* PkgConfig.pm: add some documentation
GClosure.xs view on Meta::CPAN
int i;
GValue v = {0, };
/* Crib note: must g_value_unset() even when asking for
* G_VALUE_NOCOPY_CONTENTS. A GObject is always
* g_object_ref()ed for storage in a GValue, even under
* G_VALUE_NOCOPY_CONTENTS (see code in
* g_value_object_collect_value()). Always reffing in
* G_VALUE_COLLECT is in fact the recommended behaviour for
* all ref-counted types (see the GTypeValueTable docs,
* apparently to ensure objects remain alive for the
* duration of a g_signal_emit_valist()).
*/
for (i = 0 ; i < callback->n_params ; i++) {
gchar * error = NULL;
SV * sv;
g_value_init (&v, callback->param_types[i]);
G_VALUE_COLLECT (&v, var_args, G_VALUE_NOCOPY_CONTENTS,
&error);
if (error) {
SV * errstr;
semantics of Perl objects versus GObjects, the bindings create a combined
PerlObject+GObject, with the GObject's pointer in magic attached to the Perl
object, and the Perl object's pointer in the GObject's user data. Thus it's
not really a "wrapper", but we refer to it as one, because "combined Perl
object + GObject" is a cumbersome and confusing mouthful.
GObjects are represented as blessed hash references. The GObject user data
mechanism is not typesafe, and thus is used only for unsigned integer values;
the Perl-level hash is available for any type of user data. The combined
nature of the wrapper means that data stored in the hash will stick around as
long as the object is alive.
Since the C pointer is stored in attached magic, the C pointer is not available
to the Perl developer via the hash object, so there's no need to worry about
breaking it from perl.
Propers go to Marc Lehmann for dreaming most of this up.
=over
=cut
(GDestroyNotify)gobject_destroy_wrapper);
}
=item SV * gperl_new_object (GObject * object, gboolean own)
Use this function to get the perl part of a GObject. If I<object>
has never been seen by perl before, a new, empty perl object will
be created and added to a private key under I<object>'s qdata. If
I<object> already has a perl part, a new reference to it will be
created. The gobject + perl object together form a combined object that
is properly refcounted, i.e. both parts will stay alive as long as at
least one of them is alive, and only when both perl object and gobject are
no longer referenced will both be freed.
The perl object will be blessed into the package corresponding to the GType
returned by calling G_OBJECT_TYPE() on I<object>; if that class has not
been registered via gperl_register_object(), this function will emit a
warning to that effect (with warn()), and attempt to bless it into the
first known class in the object's ancestry. Since Glib::Object is
already registered, you'll get a Glib::Object if you are lazy, and thus
this function can fail only if I<object> isn't descended from GObject,
in which case it croaks. (In reality, if you pass a non-GObject to this
SV *
_gperl_fetch_wrapper_key (GObject * object,
const char * name,
gboolean create)
{
SV ** svp;
SV * svname;
HV * wrapper_hash;
wrapper_hash = g_object_get_qdata (object, wrapper_quark);
/* we don't care whether the wrapper is alive or undead. forcibly
* remove the undead bit, or the pointer will be unusable. */
wrapper_hash = REVIVE_UNDEAD (wrapper_hash);
svname = newSVpv (name, strlen (name));
svp = hv_fetch (wrapper_hash, SvPV_nolen (svname), SvCUR (svname),
FALSE); /* never create on the first try; prefer
* prefer to create the second version. */
if (!svp) {
/* the key doesn't exist with that name. do s/-/_/g and
* try again. */
name);
#endif
}
else if (ix == 0 && items != 2)
croak ("Usage: Glib::Object::find_property (class, name)");
else if (ix == 1 && items != 1)
croak ("Usage: Glib::Object::list_properties (class)");
if (G_TYPE_IS_OBJECT (type))
{
/* classes registered by perl are kept alive by the bindings.
* those coming straight from C are not. if we had an actual
* object, the class will be alive, but if we just had a
* package, the class may not exist yet. thus, we'll have to
* do an honest ref here, rather than a peek.
*/
GObjectClass *object_class = g_type_class_ref (type);
if (ix == 0) {
GParamSpec *pspec;
pspec = g_object_class_find_property (object_class, name);
if (pspec)
croak ("Usage: Glib::Type->register_enums (new_package, LIST)\n"
" no values supplied");
/*
* we create a value table on the fly, and we can't free it without
* causing problems. the value table is stored in the type
* registration information, which conceivably may be called more
* than once per program (which is why we don't use a class_finalize
* to destroy it). unfortunately, there doesn't appear to be a
* g_enum_register_dynamic().
* this means we will also leak the nickname strings, which must
* be duplicated to keep them alive (perl will reuse those strings).
*
* note also that we don't clean up very well when things go wrong.
* we build up the structure as we go, and an exception in the middle
* will leak everything done up to that point. we could clean it up,
* but it will make things uglier than they already are, and if
* your script can't register the enums properly, it probably won't
* live much longer.
*/
values = g_new0 (GEnumValue, items-1); /* leak (see above) */
for (i = 0; i < items-2; i++)
values[i].value = SvIV (*av2sv);
}
else if (gperl_sv_is_defined (sv))
{
/* name syntax */
values[i].value_name = SvPV_nolen (sv);
}
else
croak ("invalid type flag name");
/* make sure that the nickname stays alive as long as the
* type is registered. */
values[i].value_name = g_strdup (values[i].value_name);
/* let the nick and name match. there are few uses for the
* name, anyway. */
values[i].value_nick = values[i].value_name;
}
ctype_name = sanitize_package_name (name);
type = g_enum_register_static (ctype_name, values);
gperl_register_fundamental (type, name);
values[i].value = SvIV (*av2sv);
}
else if (gperl_sv_is_defined (sv))
{
/* name syntax */
values[i].value_name = SvPV_nolen (sv);
}
else
croak ("invalid type flag name");
/* make sure that the nickname stays alive as long as the
* type is registered. */
values[i].value_name = g_strdup (values[i].value_name);
/* let the nick and name match. there are few uses for the
* name, anyway. */
values[i].value_nick = values[i].value_name;
}
ctype_name = sanitize_package_name (name);
type = g_flags_register_static (ctype_name, values);
gperl_register_fundamental (type, name);
SV * gperl_new_object (GObject * object, gboolean own);
The wrapper SV will be blessed into the package corresponding to the gtype
returned by G_OBJECT_TYPE (object), that is, the bottommost type in the
inheritance chain. If that bottommost type is not known, the function walks
back up the tree until it finds one that's known, blesses the reference into
that package, and spits out a warning on stderr. To hush the warning, you need
merely call
In general, this process will claim a reference on the GObject (with
g_object_ref()), so that the C object stays alive so long as there is a perl
wrapper for it. If <i>own</i> is set to TRUE, the perl wrapper will claim
ownership of the C object by removing that reference; in theory, for a new
GObject, fresh from a constructor, this leaves the object with a single
reference owned by the perl object. The next question out of your mouth should
be, "But what about GObject derivatives that require sinking or other strange
methods to claim ownership?" For the answer, see the GtkObject section's
description of sink functions.
void gperl_register_object (GType gtype, const char * package);
gperl_marshal.h view on Meta::CPAN
# $@ still has value from eval above
works as expected.
See C<call_sv> in L<perlcall> for more information.
=cut
*/
#define GPERL_CLOSURE_MARSHAL_CALL(flags) \
{ \
/* copy is needed to keep the old value alive. */ \
/* mortal so it will die if not stolen by SvSetSV. */ \
SV * save_errsv = sv_2mortal (newSVsv (ERRSV)); \
count = call_sv (pc->callback, (flags) | G_EVAL); \
SPAGAIN; \
if (SvTRUE (ERRSV)) { \
gperl_run_exception_handlers (); \
SvSetSV (ERRSV, save_errsv); \
FREETMPS; \
LEAVE; \
return; \
0 # returning FALSE uninstalls
}, [qw/foo bar/, 0]);
ok($tag, 15, "installed exception handler");
# the exception in the signal handler should not affect the value of
# $@ at this code layer.
$@ = 'neener neener neener';
print "# before invocation: \$@ $@\n";
$my->test_marshaler (qw/foo bar/, 4154, $my);
print "# after invocation: \$@ $@\n";
pass(17, "still alive after an exception in a callback");
ok($@ eq 'neener neener neener', 18, "$@ is preserved across signals") ||
diag "# expected 'neener neener neener'\n",
" # got '$@'";
$tag = 0;
# that was a single-shot -- the exception handler shouldn't run again.
{
local $SIG{__WARN__} = sub {
if ($_[0] =~ m/unhandled/m) {
pass(20, "unhandled exception just warns");
# class closure should before the "connect_after" ones,
# and this one will stop everything by returning the magic value.
$my->signal_connect_after (list_returner => sub { pass(33, "stopper"); 42 });
# if this one is called, the accumulator isn't working right
$my->signal_connect_after (list_returner => sub { fail("shouldn't get here"); 0 });
pass(27);
print Dumper( $my->list_returner );
# Check that a signal_connect() of a non-existant signal name doesn't
# leak the subr passed to it, ie. doesn't keep it alive forever.
#
# Note $subr has to use $x or similar in its containing environment to be
# a closure. If not then it's treated as part of the mainline code and
# won't be gc'ed immediately -- or something like that.
{
my $x = 123;
my $subr = sub { return $x };
# handler to suppress the warning message from nosuchsignal
my $logid = Glib::Log->set_handler ('GLib-GObject', ['warning'], sub { });
require POSIX;
POSIX::_exit(42); # no END etc cleanups
}
# parent
my $loop = Glib::MainLoop->new;
my $userdata = [ 'hello' ];
my $id = Glib::Child->watch_add ($pid, sub { die; }, $userdata);
require Scalar::Util;
Scalar::Util::weaken ($userdata);
print '', (defined $userdata ? 'ok' : 'not ok'),
" 26 - child userdata kept alive\n";
print '', (Glib::Source->remove($id) ? 'ok' : 'not ok'),
" 27 - child source removal\n";
print '', (! defined $userdata ? 'ok' : 'not ok'),
" 28 - child userdata now gone\n";
# No test of $status here, yet, since it may be a raw number on ms-dos,
# instead of a waitpid() style "code*256". Believe there's no
# POSIX::WIFEXITED() etc on dos either to help examining the value.
my $timer_id;
Glib::Child->watch_add ($pid,
( run in 1.811 second using v1.01-cache-2.11-cpan-39bf76dae61 )