File Coverage

blib/lib/Glib/Ex/SignalIds.pm
Criterion Covered Total %
statement 13 15 86.6
branch n/a
condition n/a
subroutine 5 5 100.0
pod n/a
total 18 20 90.0


line stmt bran cond sub pod time code
1             # Copyright 2008, 2009, 2010, 2011, 2012, 2014 Kevin Ryde
2              
3             # This file is part of Glib-Ex-ObjectBits.
4             #
5             # Glib-Ex-ObjectBits is free software; you can redistribute it and/or modify
6             # it under the terms of the GNU General Public License as published by the
7             # Free Software Foundation; either version 3, or (at your option) any later
8             # version.
9             #
10             # Glib-Ex-ObjectBits is distributed in the hope that it will be useful, but
11             # WITHOUT ANY WARRANTY; without even the implied warranty of MERCHANTABILITY
12             # or FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License
13             # for more details.
14             #
15             # You should have received a copy of the GNU General Public License along
16             # with Glib-Ex-ObjectBits. If not, see .
17              
18             package Glib::Ex::SignalIds;
19 1     1   630 use 5.008;
  1         3  
  1         28  
20 1     1   4 use strict;
  1         2  
  1         20  
21 1     1   4 use warnings;
  1         1  
  1         17  
22 1     1   4 use Carp;
  1         1  
  1         69  
23 1     1   1371 use Glib;
  0            
  0            
24             use Scalar::Util;
25             use Devel::GlobalDestruction 'in_global_destruction';
26              
27             our $VERSION = 16;
28              
29             sub new {
30             my ($class, $object, @ids) = @_;
31              
32             # it's easy to forget the object in the call (and pass only the IDs), so
33             # validate the first arg now
34             (Scalar::Util::blessed($object) && $object->isa('Glib::Object'))
35             or croak 'Glib::Ex::SignalIds->new(): first param must be the target object';
36              
37             my $self = bless [ $object ], $class;
38             Scalar::Util::weaken ($self->[0]);
39             $self->add (@ids);
40             return $self;
41             }
42             sub add {
43             my ($self, @ids) = @_;
44             push @$self, @ids; # grep {$_} @ids;
45             }
46              
47             sub DESTROY {
48             my ($self) = @_;
49             unless (in_global_destruction()) {
50             $self->disconnect;
51             }
52             }
53              
54             sub object {
55             my ($self) = @_;
56             return $self->[0];
57             }
58             sub ids {
59             my ($self) = @_;
60             return @{$self}[1..$#$self];
61             }
62              
63             sub disconnect {
64             my ($self) = @_;
65              
66             my $object = $self->[0];
67             if (! $object) { return; } # target object already destroyed
68              
69             while (@$self > 1) {
70             my $id = pop @$self;
71              
72             # might have been disconnected by $object in the course of its destruction
73             if ($object->signal_handler_is_connected ($id)) {
74             $object->signal_handler_disconnect ($id);
75             }
76             }
77             }
78              
79             1;
80             __END__