File Coverage

blib/lib/Tickit/SingleChildWidget.pm
Criterion Covered Total %
statement 9 9 100.0
branch n/a
condition n/a
subroutine 3 3 100.0
pod n/a
total 12 12 100.0


line stmt bran cond sub pod time code
1             # You may distribute under the terms of either the GNU General Public License
2             # or the Artistic License (the same terms as Perl itself)
3             #
4             # (C) Paul Evans, 2011-2013 -- leonerd@leonerd.org.uk
5              
6             package Tickit::SingleChildWidget;
7              
8 1     1   4 use strict;
  1         1  
  1         22  
9 1     1   3 use warnings;
  1         1  
  1         20  
10 1     1   3 use base qw( Tickit::ContainerWidget );
  1         1  
  1         407  
11              
12             our $VERSION = '0.51';
13              
14             use Carp;
15              
16             =head1 NAME
17              
18             C - abstract base class for widgets that contain a
19             single other widget
20              
21             =head1 SYNOPSIS
22              
23             TODO
24              
25             =head1 DESCRIPTION
26              
27             This subclass of L acts as an abstract base class for
28             widgets that contain exactly one other widget. It enforces that only one child
29             widget may be contained at any one time, and provides a convenient accessor to
30             obtain it.
31              
32             =cut
33              
34             =head1 CONSTRUCTOR
35              
36             =cut
37              
38             =head2 $widget = Tickit::SingleChildWidget->new( %args )
39              
40             Constructs a new C object. If passed an argument
41             called C this will be added as the contained child widget.
42              
43             =cut
44              
45             sub new
46             {
47             my $class = shift;
48             my %args = @_;
49              
50             my $self = $class->SUPER::new( %args );
51              
52             $self->set_child( $args{child} ) if exists $args{child};
53              
54             return $self;
55             }
56              
57             =head1 METHODS
58              
59             =cut
60              
61             =head2 $child = $widget->child
62              
63             Returns the contained child widget.
64              
65             =cut
66              
67             sub child
68             {
69             my $self = shift;
70             return $self->{child};
71             }
72              
73             sub children
74             {
75             my $self = shift;
76             my $child = $self->child;
77             return $child ? ( $child ) : () if wantarray;
78             return $child ? 1 : 0;
79             }
80              
81             =head2 $widget->set_child( $child )
82              
83             Sets the child widget, or C to remove.
84              
85             =cut
86              
87             sub set_child
88             {
89             my $self = shift;
90             my ( $child ) = @_;
91              
92             if( my $old_child = $self->child ) {
93             undef $self->{child};
94             $self->SUPER::remove( $old_child );
95             }
96              
97             $self->{child} = $child;
98              
99             if( $child ) {
100             $self->SUPER::add( $child );
101             }
102             }
103              
104             sub add
105             {
106             my $self = shift;
107             croak "Already have a child; cannot add another" if $self->child;
108             $self->set_child( $_[0] );
109             }
110              
111             =head1 AUTHOR
112              
113             Paul Evans
114              
115             =cut
116              
117             0x55AA;