File Coverage

blib/lib/Commandable/Output.pm
Criterion Covered Total %
statement 41 55 74.5
branch 0 4 0.0
condition 1 7 14.2
subroutine 13 15 86.6
pod 4 4 100.0
total 59 85 69.4


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, 2022 -- leonerd@leonerd.org.uk
5              
6             package Commandable::Output 0.10;
7              
8 9     9   107 use v5.14;
  9         38  
9 9     9   47 use warnings;
  9         18  
  9         547  
10              
11 9         24 use constant HAVE_STRING_TAGGED => defined eval {
12 9         2076 require String::Tagged;
13 0         0 require Convert::Color;
14 9     9   70 };
  9         28  
15              
16 9         19 use constant HAVE_STRING_TAGGED_TERMINAL => defined eval {
17 9         3983 require String::Tagged::Terminal;
18 9     9   56 };
  9         25  
19              
20             =head1 NAME
21              
22             C - abstractions for printing output from commands
23              
24             =head1 DESCRIPTION
25              
26             This package contains default implementations of methods for providing printed
27             output from commands implemented using L. These methods are
28             provided for the convenience of user code, and are also used by built-in
29             commands provided by the C system itself.
30              
31             Implementations are permitted (encouraged, even) to replace any of these
32             methods in order to customise their behaviour.
33              
34             =head2 WITH C
35              
36             If L and L are available, this module applies
37             formatting to strings by using the L conventions.
38             The C and C methods will return results as
39             instances of C, suitable to pass into the main C
40             method.
41              
42             =cut
43              
44             =head1 METHODS
45              
46             =cut
47              
48             sub _format_string
49             {
50 3     3   4 my $self = shift;
51 3         6 my ( $text, $tagmethod ) = @_;
52              
53 3         9 return $text unless HAVE_STRING_TAGGED;
54              
55 0         0 my %tags;
56 0 0       0 %tags = $self->$tagmethod if $self->can( $tagmethod );
57              
58 0 0 0     0 if( $tags{fg} and !ref $tags{fg} ) {
59 0         0 $tags{fg} = Convert::Color->new( $tags{fg} );
60             }
61              
62 0         0 return String::Tagged->new_tagged( $text, %tags );
63             }
64              
65             =head2 printf
66              
67             Commandable::Output->printf( $format, @args )
68              
69             The main output method, used to send messages for display to the user. The
70             arguments are formatted into a single string by Perl's C function.
71             This method does not append a linefeed. To output a complete line of text,
72             remember to include the C<"\n"> at the end of the format string.
73              
74             The default implementation writes output on the terminal via STDOUT.
75              
76             In cases where the output should be sent to some other place (perhaps a GUI
77             display widget of some kind), the application should replace this method with
78             something that writes the display to somewhere more appropriate. Don't forget
79             to use C to format the arguments into a string.
80              
81             no warnings 'redefine';
82             sub Commandable::Output::printf
83             {
84             shift; # the package name
85             my ( $format, @args ) = @_;
86              
87             my $str = sprintf $format, @args;
88              
89             $gui_display_widget->append_text( $str );
90             }
91              
92             If L is available, the output will be printed using
93             this module, by first converting the format string and arguments using
94             L and then constructing a terminal string using
95             L. This means the default
96             implementation will be able to output formatted strings using the
97             L conventions.
98              
99             =cut
100              
101             sub printf
102             {
103 0     0 1 0 shift;
104 0         0 my ( $format, @args ) = @_;
105              
106 0         0 if( HAVE_STRING_TAGGED_TERMINAL ) {
107             String::Tagged::Terminal->new_from_formatting(
108             String::Tagged->from_sprintf( $format, @args )
109             )->print_to_terminal;
110             return;
111             }
112              
113 0         0 printf $format, @args;
114             }
115              
116             =head2 print_heading
117              
118             Commandable::Output->print_heading( $text, $level )
119              
120             Used to send output that should be considered like a section heading.
121             I<$level> may be an integer used to express sub-levels; increasing values from
122             1 upwards indicate increasing sub-levels.
123              
124             The default implementation formats the text string using L
125             then prints it using L with a trailing linefeed.
126              
127             =cut
128              
129             sub print_heading
130             {
131 3     3 1 4 my $self = shift;
132 3         7 my ( $text, $level ) = @_;
133              
134 3         9 $self->printf( "%s\n", $self->format_heading( $text, $level ) );
135             }
136              
137             =head2 format_heading
138              
139             $str = Commandable::Output->format_heading( $text, $level )
140              
141             Returns a value for printing, to represent a section heading for the given
142             text and level.
143              
144             The default implementation applies the following formatting if
145             C is available:
146              
147             =over 4
148              
149             =item Level 1
150              
151             Underlined
152              
153             =item Level 2
154              
155             Underlined, cyan colour
156              
157             =item Level 3
158              
159             Bold
160              
161             =back
162              
163             =cut
164              
165 9     9   58 use constant TAGS_FOR_HEADING_1 => ( under => 1 );
  9         18  
  9         645  
166 9     9   57 use constant TAGS_FOR_HEADING_2 => ( under => 1, fg => "vga:cyan", );
  9         17  
  9         675  
167 9     9   61 use constant TAGS_FOR_HEADING_3 => ( bold => 1 );
  9         34  
  9         1132  
168              
169             sub format_heading
170             {
171 0     0 1 0 my $self = shift;
172 0         0 my ( $text, $level ) = @_;
173              
174 0   0     0 $level //= 1;
175              
176 0         0 return $self->_format_string( $text, "TAGS_FOR_HEADING_$level" );
177             }
178              
179             =head2 format_note
180              
181             $str = Commandable::Output->format_note( $text, $level )
182              
183             Returns a value for printing, to somehow highlight the given text (which
184             should be a short word or string) at the given level.
185              
186             The default implementation applies the following formatting if
187             C is available:
188              
189             =over 4
190              
191             =item Level 0
192              
193             Bold, yellow colour
194              
195             =item Level 1
196              
197             Bold, cyan colour
198              
199             =item Level 2
200              
201             Bold, magenta colour
202              
203             =back
204              
205             =cut
206              
207 9     9   62 use constant TAGS_FOR_NOTE_0 => ( bold => 1, fg => "vga:yellow" );
  9         21  
  9         585  
208 9     9   59 use constant TAGS_FOR_NOTE_1 => ( bold => 1, fg => "vga:cyan" );
  9         18  
  9         561  
209 9     9   62 use constant TAGS_FOR_NOTE_2 => ( bold => 1, fg => "vga:magenta" );
  9         30  
  9         1095  
210              
211             sub format_note
212             {
213 3     3 1 5 my $self = shift;
214 3         7 my ( $text, $level ) = @_;
215              
216 3   50     14 $level //= 0;
217              
218 3         9 return $self->_format_string( $text, "TAGS_FOR_NOTE_$level" );
219             }
220              
221             =head1 AUTHOR
222              
223             Paul Evans
224              
225             =cut
226              
227             0x55AA;