File Coverage

blib/lib/Text/UnicodeBox/Control.pm
Criterion Covered Total %
statement 1 3 33.3
branch n/a
condition n/a
subroutine 1 1 100.0
pod n/a
total 2 4 50.0


line stmt bran cond sub pod time code
1             package Text::UnicodeBox::Control;
2              
3             =head1 NAME
4              
5             Text::UnicodeBox::Control - Objects to describe and control rendering
6              
7             =head1 DESCRIPTION
8              
9             This module is part of the low level interface to L<Text::UnicodeBox>; you probably don't need to use it directly.
10              
11             =cut
12              
13 6     6   67041 use Moose;
  0            
  0            
14             use Exporter 'import';
15              
16             =head1 METHODS
17              
18             =head2 new (%params)
19              
20             =over 4
21              
22             =item style
23              
24             The style of this line. 'light', 'double' or 'heavy' are the main style names. See the unicode box table for all the names.
25              
26             =item position
27              
28             Takes 'start', 'rule', or 'end'
29              
30             =item top
31              
32             Currently this only makes sense with a position of 'start'. Indicates that the box to follow should have a line drawn above it. The value is the style (light, double, heavy)
33              
34             =item bottom
35              
36             Same as C<top> but for a line below.
37              
38             =back
39              
40             =head1 EXPORTED METHODS
41              
42             The following methods are exportable by name or by the tag ':all'
43              
44             =cut
45              
46             has 'style' => ( is => 'rw' );
47             has 'position' => ( is => 'ro' );
48             has 'top' => ( is => 'ro' );
49             has 'bottom' => ( is => 'ro' );
50              
51             our @EXPORT_OK = qw(BOX_START BOX_RULE BOX_END);
52             our %EXPORT_TAGS = ( all => [@EXPORT_OK] );
53              
54             =head2 BOX_START (%params)
55              
56             Same as C<new> with a position of 'start'
57              
58             =cut
59              
60             sub BOX_START {
61             return __PACKAGE__->new(position => 'start', @_);
62             }
63              
64             =head2 BOX_RULE (%params)
65              
66             Same as C<new> with a position of 'rule'
67              
68             =cut
69              
70             sub BOX_RULE {
71             return __PACKAGE__->new(position => 'rule', @_);
72             }
73              
74             =head2 BOX_END (%params)
75              
76             Same as C<new> with a position of 'end'
77              
78             =cut
79              
80             sub BOX_END {
81             return __PACKAGE__->new(position => 'end', @_);
82             }
83              
84             =head2 to_string (\%context)
85              
86             Return a string representing the rendering of this control part. Pass a hashref to this and all other calls within the same context to allow this to share styles with other objects.
87              
88             =cut
89              
90             sub to_string {
91             my ($self, $context, $box) = @_;
92              
93             my $style = $self->style;
94            
95             if ($self->position eq 'start') {
96             $context->{start} = $self;
97             }
98             elsif ($self->position eq 'rule') {
99             if (my $start = $context->{start}) {
100             $style = $start->style;
101             $self->style($style); # Update my own style to the context style
102             }
103             }
104             elsif ($self->position eq 'end') {
105             $context->{end} = $self;
106             if (my $start = $context->{start}) {
107             $style = $start->style;
108             $self->style($style); # Update my own style to the context style
109             }
110             }
111              
112             # Default style to 'light'
113             $style ||= 'light';
114              
115             return $box->_fetch_box_character( vertical => $style );
116             }
117              
118             =head1 COPYRIGHT
119              
120             Copyright (c) 2012 Eric Waters and Shutterstock Images (http://shutterstock.com). All rights reserved. This program is free software; you can redistribute it and/or modify it under the same terms as Perl itself.
121              
122             The full text of the license can be found in the LICENSE file included with this module.
123              
124             =head1 AUTHOR
125              
126             Eric Waters <ewaters@gmail.com>
127              
128             =cut
129              
130             1;