Glib-Ex-ObjectBits
view release on metacpan or search on metacpan
SIGNATURE
t/EnumBits.t
t/FreezeNotify.t
t/MyTestHelpers.pm
t/ObjectBits.t
t/SignalBits-import.t
t/SignalBits-pod.t
t/SignalBits.t
t/SignalIds.t
t/SourceIds.t
t/TieProperties-test-weaken.t
t/TieProperties.t
xt/0-file-is-part-of.t
xt/0-META-read.t
xt/0-no-debug-left-on.t
xt/0-Test-ConsistentVersion.t
xt/0-Test-DistManifest.t
xt/0-Test-Pod.t
xt/0-Test-Synopsis.t
xt/0-Test-YAML-Meta.t
xtools/my-check-copyright-years.sh
SHA256 1ec13168b72f0345d33b86f78a7fb46b9930d9759bee1d1e113891b1f086b031 lib/Glib/Ex/TieProperties.pm
SHA256 b5e4747553e35eeaef73d243d1c3161e24351406a0c229f06d2f799d68d34e4c t/EnumBits.t
SHA256 75a490a770ae78a20bff272b829bbe763034f40f9b5d748404c7abed4d8a4b6e t/FreezeNotify.t
SHA256 91cd2bba3e246abf05c342ed549ed6d902e8a77a43b6c9c4e092e4c918732ac0 t/MyTestHelpers.pm
SHA256 02af1baa6b1da18906b3829f501c063478816549949bb17c06dc1d2bf94e5501 t/ObjectBits.t
SHA256 9b7f887dcb30f2b3bf63e83c4602e1dc13fd10e54d461b8f098f1a723d57b108 t/SignalBits-import.t
SHA256 a1f1ca72cb06064528df95d33640a8b4011e3807fcd2d2cac165aae0b0cef7ac t/SignalBits-pod.t
SHA256 e841d222239e5fc3dda60867c3a6b02ae9409d2462914d6d3d25162aec9e0a2a t/SignalBits.t
SHA256 345a4b3aeb625b5f9f74b0f58cbba853d52c43b9bc874809ece52ab6b15d947e t/SignalIds.t
SHA256 5908c9c95f6bb2c4411468f594627d57c323f8ccd105b2f5dd1338a06fc8164e t/SourceIds.t
SHA256 35a7809b973da41630313104702d287d63426e1b178703bb7deb217ad37b11a5 t/TieProperties-test-weaken.t
SHA256 a0e886f807d62241d2f8c1818969fa73029fa23838b2a69e29a14a75d1b9a1bf t/TieProperties.t
SHA256 ef75312e02ddcfed7095de7eecebc6b7b863d56acd9b64142737ab7a5edb57e3 xt/0-META-read.t
SHA256 f03d4741c4e6dd385c7bafa06118082bad4809a64e28a094635324ef8ab4f3e5 xt/0-Test-ConsistentVersion.t
SHA256 be42622f3841d04240cb1284e6b30e1af81cb0fcb56d29e853c70af656653488 xt/0-Test-DistManifest.t
SHA256 48b441e0c335e93946d913897e342662387788833229c5ba5fac57f0ff3d567c xt/0-Test-Pod.t
SHA256 2e1e1d896a226aeb190cdcfbe83969f634c1be3e7344302e023915e3f7150732 xt/0-Test-Synopsis.t
SHA256 d33b48c1986680cd934565250bd9e3879674dfe6aad69b1717ed76354a29ff44 xt/0-Test-YAML-Meta.t
SHA256 75a73148514fad2715873d1e02a6fa8e3b9cc43f7aff97aaffac9721c086a319 xt/0-file-is-part-of.t
SHA256 7d9eacc605d8cb575b2869790e4b90d71dea6a97547c725825a49e1db036dee4 xt/0-no-debug-left-on.t
SHA256 479a5a0436204528727a74e5257b1c5c6adbebd65b21b6817a196b4e159e7549 xtools/my-check-copyright-years.sh
devel/SignalHookIds.pm view on Meta::CPAN
sub new {
my ($class, $object, @ids) = @_;
# it's easy to forget the object in the call (and pass only the IDs), so
# validate the first arg now
(Scalar::Util::blessed($object) && $object->isa('Glib::Object'))
or croak 'Glib::Ex::SignalHookIds->new(): first param must be the target object';
my $self = bless [ $object ], $class;
Scalar::Util::weaken ($self->[0]);
$self->add (@ids);
return $self;
}
sub add {
my ($self, @ids) = @_;
push @$self, @ids; # grep {$_} @ids;
}
sub DESTROY {
my ($self) = @_;
devel/SignalHookIds.pm view on Meta::CPAN
$model->signal_connect
(row_inserted => \&my_insert_handler, $self),
$model->signal_connect
(row_deleted => \&my_delete_handler, $self));
}
}
The C<$model &&> part allows C<undef> for no model, in which case the
C<model_ids> becomes undef. Either way any previous SignalHookIds object in
C<model_ids> is discarded and it disconnects the previous model. (Note in
the signal user data you won't want C<$self> but something weakened, to
avoid a circular reference, the same as with all signal connections.)
The key to this kind of usage is that the target object may change and you
want a convenient way to connect to the new and disconnect from the old. If
however a sub-object or sub-widget belongs exclusively to you, never
changes, and is destroyed at the same time as your object, then there's no
need for disconnection and you won't need a SignalHookIds.
=head2 Weakening
SignalHookIds keeps only a weak reference to the target object, letting whoever
or whatever has connected the IDs manage the target lifetime. In particular
this weakening means a SignalHookIds object can be kept in the instance data of
the target object itself without creating a circular reference.
If the target object is destroyed then all its signals are disconnected.
SignalHookIds knows no explicit disconnects are needed in that case. SignalHookIds
also knows some forms of weakening and Perl's "global destruction" stage can
give slightly odd situations where the target object has disconnected its
signals but Perl hasn't yet zapped references to the object. SignalHookIds
therefore checks whether its IDs are still connected before disconnecting,
to avoid warnings from Glib.
=head1 FUNCTIONS
=over 4
=item C<< Glib::Ex::SignalHookIds->new ($object, $id,$id,...) >>
devel/SignalHookIds.pm view on Meta::CPAN
"before", "after", user data, detail, etc, then just pass the resulting ID
to SignalHookIds to look after. Eg.
my $sigids = Glib::Ex::SignalHookIds->new
($obj, $obj->signal_connect (foo => \&do_foo),
$obj->signal_connect_after (bar => \&do_bar));
=item C<< $sigids->object() >>
Return the object held in C<$sigids>, or C<undef> if it's been destroyed
(zapped by weakening).
=item C<< $sigids->disconnect() >>
Disconnect the signal IDs held in C<$sigids>, if not already disconnected.
This is done automatically when C<$sigids> is garbage collected, but you can
do it explicitly sooner if desired.
=back
=head1 SEE ALSO
devel/tie-properties.pl view on Meta::CPAN
# delete $h->{'fjsdk'};
# print $h->{'fjsdk'},"\n";
# $h->{'fjsdk'} = 123;
print exists($h->{'fjsdk'}),"\n";
print exists($h->{'width-request'}),"\n";
print scalar(%$h),"\n";
keys(%$h) = 200;
require Scalar::Util;
Scalar::Util::weaken ($hbox);
(defined $hbox) || die;
}
{
my $hbox = Gtk2::HBox->new;
print "in_object\n";
Glib::Ex::TieProperties->in_object ($hbox);
print $hbox->{'property'}->{'width-request'},"\n";
Scalar::Util::weaken ($hbox);
(defined $hbox)&& die;
}
{
my $hbox = Gtk2::HBox->new;
tie my(%h), 'Glib::Ex::TieProperties', $hbox;
{
local @h{'width-request','height-request'} = (100, 200);
my $req = $hbox->size_request;
lib/Glib/Ex/FreezeNotify.pm view on Meta::CPAN
$self->add (@_);
return $self;
}
sub add {
my $self = shift;
### FreezeNotify add(): "@_"
foreach my $object (@_) {
$object->freeze_notify;
push @$self, $object;
Scalar::Util::weaken ($self->[-1]);
}
}
sub DESTROY {
my ($self) = @_;
### FreezeNotify DESTROY()
while (@$self) {
my $object = pop @$self;
if (defined $object # possible undef by weakening
&& ! in_global_destruction()) {
### FreezeNotify thaw: "$object"
$object->thaw_notify;
}
}
}
1;
__END__
lib/Glib/Ex/SignalIds.pm view on Meta::CPAN
sub new {
my ($class, $object, @ids) = @_;
# it's easy to forget the object in the call (and pass only the IDs), so
# validate the first arg now
(Scalar::Util::blessed($object) && $object->isa('Glib::Object'))
or croak 'Glib::Ex::SignalIds->new(): first param must be the target object';
my $self = bless [ $object ], $class;
Scalar::Util::weaken ($self->[0]);
$self->add (@ids);
return $self;
}
sub add {
my ($self, @ids) = @_;
push @$self, @ids; # grep {$_} @ids;
}
sub DESTROY {
my ($self) = @_;
lib/Glib/Ex/SignalIds.pm view on Meta::CPAN
$model->signal_connect
(row_inserted => \&my_insert_handler, $self),
$model->signal_connect
(row_deleted => \&my_delete_handler, $self));
}
}
The C<$model &&> part allows C<undef> for no model, in which case the
C<model_ids> becomes C<undef>. Any previous SignalIds object in
C<model_ids> is discarded and thus disconnects the previous model. In real
code you won't want C<$self> in the signal user data, but something weakened
to avoid a circular reference, the same as for all signal connections.
The key to this is that the target object might change and you want a
convenient way to connect to the new and disconnect from the old. If
instead a sub-object or sub-widget belongs exclusively to you, never
changes, and is destroyed at the same time as your object, then there's no
need for disconnection and you don't need a SignalIds.
=head2 Weakening
SignalIds only keeps a weak reference to the target object, letting whoever
or whatever has connected the IDs manage the target lifetime. In particular
this weakening means a SignalIds object can be kept in the instance data of
the target object itself without creating a circular reference.
If the target object is destroyed then all its signals are disconnected.
SignalIds knows no explicit disconnects are needed in that case. SignalIds
also knows some forms of weakening can give slightly odd situations where
the target object has disconnected its signals but Perl hasn't yet zapped
references to the object. For that reason SignalIds checks whether IDs are
still connected before disconnecting, to avoid warnings from Glib.
Warnings for "already disconnected" during target object destruction tend to
be a bit subtle. You can end up with the Perl-level object hash still
existing yet all signals on the object already disconnected. SignalIds is a
handy way to avoid trouble.
=head2 Global Destruction
lib/Glib/Ex/SignalIds.pm view on Meta::CPAN
Adding IDs one by one is good if one of the C<signal_connect()> calls might
error out. Previous connections are safely in the C<$sigids> and will be
cleaned up, whereas in a multiple-ID call some could leak on an error. An
error making a connection is unlikely, unless perhaps the signal name comes
in externally, or the target object class hasn't been checked.
=item C<< $object = $sigids->object() >>
Return the object held in C<$sigids>, or C<undef> if it's been destroyed
(zapped by weakening).
=item C<< @ids = $sigids->ids() >>
Return a list of the signal IDs held in C<$sigids> (possibly an empty list
if nothing held).
=item C<< $sigids->disconnect() >>
Disconnect all the signal IDs held in C<$sigids>, if not already
disconnected.
lib/Glib/Ex/TieProperties.pm view on Meta::CPAN
# Think about:
# error_on_fetch
# error_on_store
#
sub TIEHASH {
my ($class, $obj, %option) = @_;
(ref $obj) || croak "$class needs an object to tie";
my $self = bless [ $obj ], $class;
if ($option{'weak'}) {
require Scalar::Util;
Scalar::Util::weaken ($self->[_OBJ]);
}
return $self;
}
sub FETCH {
my ($self, $key) = @_;
if (my $obj = $self->[_OBJ]) { # when not weakened away
if (my $pspec = $obj->find_property ($key)) { # when known property
if ($pspec->{'flags'} >= 'readable') { # when readable
return $obj->get_property($key);
}
}
}
return undef; # otherwise
}
sub STORE {
my ($self, $key, $value) = @_;
my $obj = $self->[_OBJ] || return; # do nothing if weakened away
$obj->set_property ($key, $value);
}
sub EXISTS {
my ($self, $key) = @_;
my $obj = $self->[_OBJ] || return 0; # if weakened away
return defined ($obj->find_property($key));
}
sub DELETE { croak 'Cannot delete object properties' }
BEGIN {
no warnings;
*CLEAR = \&DELETE;
}
sub FIRSTKEY {
my ($self) = @_;
my $obj = $self->[_OBJ] || return undef; # if weakened away
@{$self->[_KEYS]} = map {$_->{'name'}} $obj->list_properties;
goto &NEXTKEY;
}
sub NEXTKEY {
return shift @{$_[0]->[_KEYS]};
}
# Return true if at least one property, this new in 5.8.3.
# Mimic the "8/8" bucket of a real hash because it's easy enough to do.
#
# It's pretty wasteful getting the full list of pspecs then throwing them
# away, but g_object_class_list_properties() is about the only way to check
# if there's any, and $obj->list_properties() is the only interface to that
# function.
#
sub SCALAR {
my ($self) = @_;
if (my $obj = $self->[_OBJ]) { # when not weakened away
my @pspecs = $obj->list_properties;
if (my $len = scalar(@pspecs)) { # buckets only if not empty
return "$len/$len";
}
}
return 0; # false for no properties
}
1;
__END__
t/FreezeNotify.t view on Meta::CPAN
die "an error";
};
ok ($notified, 'notify has gone out after the die');
is ($die_notified, 0,
'SIG{__DIE__} runs inside the eval, so the freezer object is still alive and not yet done its thaw');
}
{
my $obj = Foo->new;
my $freezer = Glib::Ex::FreezeNotify->new ($obj);
Scalar::Util::weaken ($obj);
ok (! defined $obj, "doesn't keep a hard reference to its object");
}
# doesn't keep a hard reference to either of two objects
{
my $obj1 = Foo->new;
my $obj2 = Foo->new;
my $freezer = Glib::Ex::FreezeNotify->new ($obj1, $obj2);
Scalar::Util::weaken ($obj2);
ok (! defined $obj2, "doesn't keep a hard reference to obj1");
Scalar::Util::weaken ($obj1);
ok (! defined $obj1, "doesn't keep a hard reference to obj2");
}
{
my $obj = Foo->new;
my $notified;
$obj->signal_connect (notify => sub { $notified = 1; });
eval { Glib::Ex::FreezeNotify->new ($obj, 'something bad') };
$notified = 0;
$obj->set (myprop_one => 1);
t/MyTestHelpers.pm view on Meta::CPAN
? "$obj->{$_}" : '[undef]')}
keys %$obj));
}
if (eval { require Devel::FindRef }) {
MyTestHelpers::diag (Devel::FindRef::track($obj, 8));
} else {
MyTestHelpers::diag ("Devel::FindRef not available -- ", $@);
}
}
sub test_weaken_show_leaks {
my ($leaks) = @_;
$leaks || return;
my $unfreed = $leaks->unfreed_proberefs;
my $unfreed_count = scalar(@$unfreed);
MyTestHelpers::diag ("Test-Weaken leaks $unfreed_count objects");
MyTestHelpers::dump ($leaks);
my $proberef;
foreach $proberef (@$unfreed) {
t/SignalIds.t view on Meta::CPAN
('myprop',
'myprop',
'Blurb',
0, 100, 50,
Glib::G_PARAM_READWRITE) ];
}
#------------------------------------------------------------------------------
# new and DESTROY
# the SignalIds object gets garbage collected when weakened
{
my $obj = MyClass->new;
my $sigs = Glib::Ex::SignalIds->new
($obj, $obj->signal_connect (notify => sub {}));
require Scalar::Util;
Scalar::Util::weaken ($sigs);
is ($sigs, undef);
}
# the target object gets garbage collected when weakened
{
my $obj = MyClass->new;
my $sigs = Glib::Ex::SignalIds->new
($obj, $obj->signal_connect (notify => sub {}));
require Scalar::Util;
Scalar::Util::weaken ($obj);
is ($obj, undef,
'target object garbage collected when weakened');
}
# the held signal is disconnected when the SignalIds destroyed
{
my $signalled;
my $obj = MyClass->new;
my $sigs = Glib::Ex::SignalIds->new
($obj, $obj->signal_connect (notify => sub { $signalled = 1 }));
$signalled = 0;
t/SourceIds.t view on Meta::CPAN
"VERSION class check " . ($want_version + 1000));
my $ids = Glib::Ex::SourceIds->new;
is ($ids->VERSION, $want_version, 'VERSION object method');
ok (eval { $ids->VERSION($want_version); 1 },
"VERSION object check $want_version");
ok (! eval { $ids->VERSION($want_version + 1000); 1 },
"VERSION object check " . ($want_version + 1000));
}
# the SourceIds object gets garbage collected when weakened
{
my $id = Glib::Idle->add (\&do_idle);
my $ids = Glib::Ex::SourceIds->new ($id);
require Scalar::Util;
Scalar::Util::weaken ($ids);
is ($ids, undef,
'SourceIds destroyed when weakened');
ok (! Glib::Source->remove ($id),
'held source disconnected by destroy');
}
# two held IDs disconnected
{
my $id1 = Glib::Idle->add (\&do_idle);
my $id2 = Glib::Idle->add (\&do_idle);
my $ids = Glib::Ex::SourceIds->new ($id1, $id2);
require Scalar::Util;
Scalar::Util::weaken ($ids);
is ($ids, undef,
'SourceIds destroyed when weakened');
ok (! Glib::Source->remove ($id1),
'id1 disconnected by destroy');
ok (! Glib::Source->remove ($id2),
'id2 disconnected by destroy');
}
# two by add()
{
my $id1 = Glib::Idle->add (\&do_idle);
my $id2 = Glib::Idle->add (\&do_idle);
my $ids = Glib::Ex::SourceIds->new;
$ids->add ($id1, $id2);
require Scalar::Util;
Scalar::Util::weaken ($ids);
is ($ids, undef,
'add()ed SourceIds destroyed when weakened');
ok (! Glib::Source->remove ($id1),
'add()ed id1 disconnected by destroy');
ok (! Glib::Source->remove ($id2),
'add()ed id2 disconnected by destroy');
}
# SourceIds can cope if held ID is disconnected elsewhere
{
my $id = Glib::Idle->add (\&do_idle);
my $ids = Glib::Ex::SourceIds->new ($id);
t/TieProperties.t view on Meta::CPAN
Glib::Ex::TieProperties->in_object($obj);
my $h = $obj->{'property'};
my $tobj = tied %$h;
# tied()
is (tied(%$h)->object, $obj, 'in_object() - tied()->object');
$obj = undef;
is (tied(%$h)->object, $obj, 'in_object() - tied()->object destroyed');
Scalar::Util::weaken ($h);
Scalar::Util::weaken ($tobj);
is ($h, undef, 'in_object() hashref gc');
is ($tobj, undef, 'in_object() tobj gc');
}
#-----------------------------------------------------------------------------
diag "using in_object() with field name";
{
my $obj = MyObject->new;
Glib::Ex::TieProperties->in_object($obj, field=>'xyzzy');
t/TieProperties.t view on Meta::CPAN
is ($obj->{'property'}, undef, 'in_object xyzzy - not in "property" field');
my $h = $obj->{'xyzzy'};
my $tobj = tied %$h;
# tied()
is (tied(%$h)->object, $obj, 'in_object() xyzzy - tied()->object');
$obj = undef;
is (tied(%$h)->object, $obj, 'in_object() xyzzy - tied()->object destroyed');
Scalar::Util::weaken ($h);
Scalar::Util::weaken ($tobj);
is ($h, undef, 'in_object() xyzzy hashref gc');
is ($tobj, undef, 'in_object() xyzzy tobj gc');
}
exit 0;
( run in 0.411 second using v1.01-cache-2.11-cpan-1f129e94a17 )