| 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{ (?(?[RGBCMYWK])\g{-1}*) }{ | 
| 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__ |