File: Output.pm

package info (click to toggle)
libcommandable-perl 0.14-1
  • links: PTS, VCS
  • area: main
  • in suites: forky, sid, trixie
  • size: 228 kB
  • sloc: perl: 1,530; makefile: 2
file content (209 lines) | stat: -rw-r--r-- 5,353 bytes parent folder | download
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
129
130
131
132
133
134
135
136
137
138
139
140
141
142
143
144
145
146
147
148
149
150
151
152
153
154
155
156
157
158
159
160
161
162
163
164
165
166
167
168
169
170
171
172
173
174
175
176
177
178
179
180
181
182
183
184
185
186
187
188
189
190
191
192
193
194
195
196
197
198
199
200
201
202
203
204
205
206
207
208
209
#  You may distribute under the terms of either the GNU General Public License
#  or the Artistic License (the same terms as Perl itself)
#
#  (C) Paul Evans, 2022-2024 -- leonerd@leonerd.org.uk

package Commandable::Output 0.14;

use v5.26;
use warnings;
use experimental qw( signatures );

use constant HAVE_STRING_TAGGED => defined eval {
   require String::Tagged;
   require Convert::Color;
};

use constant HAVE_STRING_TAGGED_TERMINAL => defined eval {
   require String::Tagged::Terminal;
};

=head1 NAME

C<Commandable::Output> - abstractions for printing output from commands

=head1 DESCRIPTION

This package contains default implementations of methods for providing printed
output from commands implemented using L<Commandable>. These methods are
provided for the convenience of user code, and are also used by built-in
commands provided by the C<Commandable> system itself.

Implementations are permitted (encouraged, even) to replace any of these
methods in order to customise their behaviour. 

=head2 WITH C<String::Tagged>

If L<String::Tagged> and L<Convert::Color> are available, this module applies
formatting to strings by using the L<String::Tagged::Formatting> conventions.
The C<format_heading> and C<format_note> methods will return results as
instances of C<String::Tagged>, suitable to pass into the main C<printf>
method.

=cut

=head1 METHODS

=cut

sub _format_string ( $self, $text, $tagmethod )
{
   return $text unless HAVE_STRING_TAGGED;

   my %tags;
   %tags = $self->$tagmethod if $self->can( $tagmethod );

   if( $tags{fg} and !ref $tags{fg} ) {
      $tags{fg} = Convert::Color->new( $tags{fg} );
   }

   return String::Tagged->new_tagged( $text, %tags );
}

=head2 printf

   Commandable::Output->printf( $format, @args );

The main output method, used to send messages for display to the user. The
arguments are formatted into a single string by Perl's C<printf> function.
This method does not append a linefeed. To output a complete line of text,
remember to include the C<"\n"> at the end of the format string.

The default implementation writes output on the terminal via STDOUT.

In cases where the output should be sent to some other place (perhaps a GUI
display widget of some kind), the application should replace this method with
something that writes the display to somewhere more appropriate. Don't forget
to use C<sprintf> to format the arguments into a string.

   no warnings 'redefine';
   sub Commandable::Output::printf
   {
      shift; # the package name
      my ( $format, @args ) = @_;

      my $str = sprintf $format, @args;

      $gui_display_widget->append_text( $str );
   }

If L<String::Tagged::Terminal> is available, the output will be printed using
this module, by first converting the format string and arguments using
L<String::Tagged/from_sprintf> and then constructing a terminal string using
L<String::Tagged::Terminal/new_from_formatting>. This means the default
implementation will be able to output formatted strings using the
L<String::Tagged::Formatting> conventions.

=cut

sub printf ( $self, $format, @args )
{
   if( HAVE_STRING_TAGGED_TERMINAL ) {
      String::Tagged::Terminal->new_from_formatting(
         String::Tagged->from_sprintf( $format, @args )
      )->print_to_terminal;
      return;
   }

   printf $format, @args;
}

=head2 print_heading

   Commandable::Output->print_heading( $text, $level );

Used to send output that should be considered like a section heading.
I<$level> may be an integer used to express sub-levels; increasing values from
1 upwards indicate increasing sub-levels.

The default implementation formats the text string using L</format_heading>
then prints it using L</printf> with a trailing linefeed.

=cut

sub print_heading ( $self, $text, $level = 1 )
{
   $self->printf( "%s\n", $self->format_heading( $text, $level ) );
}

=head2 format_heading

   $str = Commandable::Output->format_heading( $text, $level );

Returns a value for printing, to represent a section heading for the given
text and level.

The default implementation applies the following formatting if
C<String::Tagged> is available:

=over 4

=item Level 1

Underlined

=item Level 2

Underlined, cyan colour

=item Level 3

Bold

=back

=cut

use constant TAGS_FOR_HEADING_1 => ( under => 1 );
use constant TAGS_FOR_HEADING_2 => ( under => 1, fg => "vga:cyan", );
use constant TAGS_FOR_HEADING_3 => ( bold => 1 );

sub format_heading ( $self, $text, $level = 1 )
{
   return $self->_format_string( $text, "TAGS_FOR_HEADING_$level" );
}

=head2 format_note

   $str = Commandable::Output->format_note( $text, $level );

Returns a value for printing, to somehow highlight the given text (which
should be a short word or string) at the given level.

The default implementation applies the following formatting if
C<String::Tagged> is available:

=over 4

=item Level 0

Bold, yellow colour

=item Level 1

Bold, cyan colour

=item Level 2

Bold, magenta colour

=back

=cut

use constant TAGS_FOR_NOTE_0 => ( bold => 1, fg => "vga:yellow" );
use constant TAGS_FOR_NOTE_1 => ( bold => 1, fg => "vga:cyan" );
use constant TAGS_FOR_NOTE_2 => ( bold => 1, fg => "vga:magenta" );

sub format_note ( $self, $text, $level = 0 )
{
   return $self->_format_string( $text, "TAGS_FOR_NOTE_$level" );
}

=head1 AUTHOR

Paul Evans <leonerd@leonerd.org.uk>

=cut

0x55AA;