File Coverage

blib/lib/App/optex/pingu.pm
Criterion Covered Total %
statement 26 57 45.6
branch 0 8 0.0
condition 0 7 0.0
subroutine 9 14 64.2
pod 0 4 0.0
total 35 90 38.8


[RGBCMYWK])\g{-1}*) }{
line stmt bran cond sub pod time code
1             package App::optex::pingu;
2              
3             my $VERSION = '0.01';
4              
5 1     1   781 use v5.14;
  1         3  
6 1     1   5 use warnings;
  1         2  
  1         32  
7 1     1   569 use utf8;
  1         14  
  1         4  
8 1     1   28 use Carp;
  1         2  
  1         76  
9 1     1   539 use open IO => 'utf8', ':std';
  1         1071  
  1         6  
10 1     1   576 use Data::Dumper;
  1         6316  
  1         119  
11              
12             =encoding utf8
13              
14             =head1 NAME
15              
16             pingu - optex make-everything-pingu filter
17              
18             =head1 SYNOPSIS
19              
20             B -Mpingu --pingu I
21              
22             =head1 DESCRIPTION
23              
24             This B module is greatly inspired by L command and
25             make every command pingu not only L. As for original
26             command, see L section. All honor for this idea should go
27             to the original author.
28              
29             =begin html
30              
31            

32              
33             =end html
34              
35             =begin html
36              
37            

38              
39             =end html
40              
41             This module is a quite good example to demonstrate L command
42             features.
43              
44             =head1 OPTION
45              
46             =over 7
47              
48             =item B<--pingu>
49              
50             Make command pingu.
51              
52             =item B<--pingu-image>=I
53              
54             Set image file. File is searched at current directory and module
55             directory. Standard B image is stored as B. If
56             string C is specified, module search the file in the following
57             order.
58              
59             ./pingu
60             ./pingu.asc
61             module-dir/pingu
62             module-dir/pingu.asc
63              
64             =item B<--pingu-char>
65              
66             Specify replacement character. Default is Unicode C
67             (U+2588: █).
68              
69             =back
70              
71             =head1 IMAGE FILE FORMAT
72              
73             =over 4
74              
75             =item ASCII
76              
77             Each [C] character is converted to specified letter
78             with color which the character itself describe. Upper-case character
79             represent normal ANSI color and lower-case means high-intensity color.
80              
81             R r Red
82             G g Green
83             B b Blue
84             C c Cyan
85             M m Magenta
86             Y y Yellow
87             K k Black
88             W w White
89              
90             Default pingu image:
91              
92             ... . ... .. .. .........
93             ... .... .. .. ... ..... .. ..
94             ... ....... ... ... . ..... kkkkkkk
95             ..... ........ .kkkkkkkkkkkkkkk..... ... kkkkkkkkkk. .
96             .... ........kkkkkkkkkkkkkkkkkkkkk. ... kkkkkkkkkkk
97             ....... kkwwwwkkkkkkkkkkkkkkkk.... kkkkkkkkkkkk
98             . . .... kkwwkkwwkkkkkkkkkkwwwwkk... kkkkkkkkkkk
99             .. ....kkkkwwwwkkrrrrrrkkwwkkwwk.. .kkkkkkkkkkk
100             . kkkkkkkkrrrrrrrrrrkwwwwkk. .kkkkkkkkkk
101             .... .kkkkkkkkrrrrrrrrkkkkkkkk. kkkkkkkk
102             ..... . kkkkkkkkkkkkkkkkkkkk. kkkkkkk.
103             ...... .. . kkkkkkkkkkkkkkkkkk . . .kkkkkkk
104             ...... kkkkkkkkkkkkkkkkkkkkk . .kkkkkkk
105             ...... .kkkkkkkkkkkkkkkkkkyywwkkkkk .. kkkkkkk
106             ... . kkkkkkkkkkkkkkkkywwwwwwwwwkkkkkkkkkkkkkk.
107             kkkkkkkkkkkkkkkkywwwwwwwwwwwwwkkkkkkkkk .
108             kkkkkkkkkkkkkkkywwwwwwwwwwwwwwwwkk .
109             kkkkkkkkkkkkkkkywwwwwwwwwwwwwwwwwww ........
110             .kkkkkkkkkkkkkkkkywwwwwwwwwwwwwwwwwwww .........
111             .kkkkkkkkkkkkkkkkywwwwwwwwwwwwwwwwwwwwww .... . .
112              
113             =back
114              
115             Other file format is not supported yet.
116              
117             Coloring is done by L module. See its document
118             for detail.
119              
120             =head1 INSTALL
121              
122             Use L command:
123              
124             cpanm App::optex::pingu
125              
126             =head1 PINGU ALIAS
127              
128             You can set shell alias B to call L command through
129             B.
130              
131             alias pingu='optex -Mpingu --pingu ping'
132              
133             However, there is more sophisticated way to use B alias
134             function. Next command will make symbolic link C<< pingu->optex >> in
135             F<~/.optex.d/bin> directory:
136              
137             $ optex --ln pingu
138              
139             Executing this symbolic link, optex will call system installed
140             B command. So make an alias in F<~/.optex.d/config.toml> to
141             call L command instead:
142              
143             [alias]
144             pingu = "ping -Mpingu --pingu"
145              
146             =head1 MAKING NEW PING OPTION
147              
148             You can add, say, B<--with-pingu> option to the original L
149             command. Make a symbolic link C<< ping->optex >> in F<~/.optex.d/bin>
150             directory:
151              
152             $ optex --ln ping
153              
154             And create an rc file F<~/.optex.d/ping.rc> for B:
155              
156             option --with-pingu -Mpingu --pingu
157              
158             Then pingu will show up when you use B<--with-pingu> option to execute
159             L command:
160              
161             $ ping --with-pingu localhost -c15
162              
163             If you want to enable this option always (really?), put next line in
164             your F<~/.optex.d/ping.rc>:
165              
166             option default --with-pingu
167              
168             =head1 SEE ALSO
169              
170             L
171              
172             L
173              
174             =head1 AUTHOR
175              
176             Kazumasa Utashiro
177              
178             =head1 LICENSE
179              
180             Copyright 2022 Kazumasa Utashiro.
181              
182             You can redistribute it and/or modify it under the same terms
183             as Perl itself.
184              
185             =cut
186              
187 1     1   436 use File::Share qw(:all);
  1         25905  
  1         185  
188             my $image_dir = $ENV{OPTEX_PINGU_IMAGEDIR} //= dist_dir 'App-optex-pingu';
189              
190 1     1   8 use List::Util qw(first);
  1         2  
  1         80  
191 1     1   653 use Getopt::EX::Colormap qw(colorize);
  1         19112  
  1         641  
192              
193             our %param = (
194             char => '█',
195             repeat => 1,
196             );
197              
198             my %reader = (
199             asc => \&read_asc,
200             );
201              
202             sub get_image {
203 0     0 0   my $name = shift;
204 0           my $file = do {
205 0     0     first { -s }
206             map {
207 0           my $dir = $_;
  0            
208 0           map { "${dir}${name}$_" } '', '.asc';
  0            
209             } '', "$image_dir/";
210             };
211 0 0         die "$name: image file not found.\n" unless $file;
212 0   0       my $type = ($file =~ /\.(\w+$)/)[0] || 'asc';
213 0   0       my $reader = $reader{$type} // $reader{'asc'};
214 0           $reader->($file);
215             }
216              
217             sub read_asc {
218 0     0 0   my $file = shift;
219 0 0         open my $fh, '<', $file or die "$file: $!\n";
220 0           local $_ = do { local $/; <$fh> };
  0            
  0            
221 0           s{ (?(?
222 0           colorize($+{col}, $param{char} x length($+{str}))
223             }xgie;
224 0           /.+/g;
225             }
226              
227             sub pingu {
228 0 0   0 0   @_ = map { utf8::is_utf8($_) ? $_ : decode('utf8', $_) } @_;
  0            
229 0           my %opt = @_;
230 0   0       my $name = $opt{name} || 'pingu';
231 0           my @image = get_image($name);
232 0           my $i = 0;
233 0           while (<>) {
234 0           print $image[$i++ % @image], $_;
235             }
236             }
237              
238             sub set {
239 0     0 0   while (my($k, $v) = splice(@_, 0, 2)) {
240 0 0         exists $param{$k} or next;
241 0           $param{$k} = $v;
242             }
243 0           ();
244             }
245              
246             1;
247              
248             __DATA__