File Coverage

blib/lib/Gtk2/Ex/FreezeChildNotify.pm
Criterion Covered Total %
statement 12 26 46.1
branch 0 2 0.0
condition n/a
subroutine 4 7 57.1
pod 2 2 100.0
total 18 37 48.6


line stmt bran cond sub pod time code
1             # Copyright 2008, 2009, 2010, 2011, 2012 Kevin Ryde
2              
3             # This file is part of Gtk2-Ex-WidgetBits.
4             #
5             # Gtk2-Ex-WidgetBits 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             # Gtk2-Ex-WidgetBits 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 Gtk2-Ex-WidgetBits. If not, see .
17              
18             package Gtk2::Ex::FreezeChildNotify;
19 1     1   1055 use 5.008;
  1         4  
  1         49  
20 1     1   6 use strict;
  1         3  
  1         43  
21 1     1   6 use warnings;
  1         2  
  1         40  
22 1     1   6 use Scalar::Util;
  1         2  
  1         293  
23              
24             our $VERSION = 48;
25              
26             sub new {
27 0     0 1   my $class = shift;
28 0           my $self = bless [], $class;
29 0           $self->add (@_);
30 0           return $self;
31             }
32              
33             sub add {
34 0     0 1   my $self = shift;
35             ### FreezeChildNotify add(): "@_"
36 0           foreach my $widget (@_) {
37 0           $widget->freeze_child_notify;
38 0           push @$self, $widget;
39 0           Scalar::Util::weaken ($self->[-1]);
40             }
41             }
42              
43             sub DESTROY {
44 0     0     my ($self) = @_;
45             ### FreezeChildNotify DESTROY()
46 0           while (@$self) {
47 0           my $widget = pop @$self;
48 0 0         next if ! defined $widget; # possible undef by weakening
49             ### FreezeChildNotify thaw: "$widget"
50 0           $widget->thaw_child_notify;
51             }
52             }
53              
54             1;
55             __END__