File Coverage

blib/lib/Glib/Ex/FreezeNotify.pm
Criterion Covered Total %
statement 15 29 51.7
branch 0 2 0.0
condition 0 3 0.0
subroutine 5 8 62.5
pod 2 2 100.0
total 22 44 50.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::FreezeNotify;
19 1     1   861 use 5.008;
  1         4  
  1         137  
20 1     1   5 use strict;
  1         1  
  1         26  
21 1     1   5 use warnings;
  1         1  
  1         22  
22 1     1   5 use Scalar::Util;
  1         2  
  1         71  
23 1     1   757 use Devel::GlobalDestruction 'in_global_destruction';
  1         2578  
  1         6  
24              
25             our $VERSION = 16;
26              
27             sub new {
28 0     0 1   my $class = shift;
29 0           my $self = bless [], $class;
30 0           $self->add (@_);
31 0           return $self;
32             }
33              
34             sub add {
35 0     0 1   my $self = shift;
36             ### FreezeNotify add(): "@_"
37 0           foreach my $object (@_) {
38 0           $object->freeze_notify;
39 0           push @$self, $object;
40 0           Scalar::Util::weaken ($self->[-1]);
41             }
42             }
43              
44             sub DESTROY {
45 0     0     my ($self) = @_;
46             ### FreezeNotify DESTROY()
47 0           while (@$self) {
48 0           my $object = pop @$self;
49 0 0 0       if (defined $object # possible undef by weakening
50             && ! in_global_destruction()) {
51             ### FreezeNotify thaw: "$object"
52 0           $object->thaw_notify;
53             }
54             }
55             }
56              
57             1;
58             __END__