fork download
copy 
  1. #!/usr/bin/env perl
  2. use strict;
  3. use warnings;
  4. use utf8;
  5. use File::Basename;
  6. use feature "state";
  7.  
  8. sub say {print "@_", "\n"};
  9. my %color_map = (
  10.     bold              => 1,
  11.     tint              => 2,
  12.     itaric            => 3,
  13.     underline         => 4,
  14.     blink             => 5,
  15.     blink_quick       => 6,
  16.     back_grey         => 7,
  17.     invisible         => 8,
  18.     center_bar        => 9,
  19.     tall              => 12,
  20.     underline_w       => 21,
  21.     black             => 30,
  22.     red               => 31,
  23.     green             => 32,
  24.     orange            => 33,
  25.     blue              => 34,
  26.     purple            => 35,
  27.     cyan              => 36,
  28.     back_black        => 40,
  29.     back_shade_red    => 41,
  30.     back_shade_green  => 42,
  31.     back_orange       => 43,
  32.     back_tint_blue    => 44,
  33.     back_tint_purple  => 45,
  34.     back_shade_cyan   => 46,
  35.     back_whity        => 47,
  36.     top_bar           => 53,
  37.     left_up           => 73,
  38.     right_down        => 74,
  39.     dark_grey         => 90,
  40.     vivid_red         => 91,
  41.     vivid_green       => 92,
  42.     vivid_yellow      => 93,
  43.     vivid_blue        => 94,
  44.     vivid_magenta     => 95,
  45.     vivid_water       => 96,
  46.     back_dark_grey    => 100,
  47.     back_pink         => 101,
  48.     back_light_green  => 102,
  49.     back_light_yellow => 103,
  50.     back_light_blue   => 104,
  51.     back_light_purple => 105,
  52.     back_light_cyan   => 106,
  53.     back_white        => 107,
  54.     null              => 108,
  55. );
  56.  
  57. sub dye {
  58.     my $color_letter_set = shift;
  59.     my $words = shift;
  60.     "\e[" . $color_letter_set . "m" . $words . "\e[0m";
  61. };
  62.  
  63. my @color_words  = sort keys %color_map;
  64. my @color_digits = @color_map{@color_words};
  65.  
  66. my @supported;
  67. for (@color_digits) {
  68.     state $i = 0;
  69.     push @supported, dye($color_digits[$i], $color_words[$i]);
  70.     $i++;
  71. }
  72.  
  73. my $this_script = basename($0, '');
  74. my $USAGE = << "EOL";
  75. This filter program do highlight words in STDIN
  76. inputs | this_script "words" color
  77. cat flower_names | $this_script "Rose" red
  78. cat flower_names | $this_script "Rose" red back_dark_grey Itaric
  79.  
  80. supported visible colors are
  81. @supported
  82.  
  83. EOL
  84.  
  85.  
  86. die "$USAGE\n [@ARGV] found. More than 2 args needed.\n" if @ARGV < 2;
  87. my $words = shift @ARGV;
  88. my $color_letter_set;
  89. for (1 .. @ARGV) {
  90.     my $color_letter = $color_map{lc shift @ARGV};
  91.     if ($color_letter) {
  92.         $color_letter_set .= $color_letter;
  93.     }
  94.     else {
  95.         die "$USAGE\nThe color may not be supported.\n";
  96.     }
  97.     $color_letter_set .= q(;) if @ARGV;
  98. };
  99.  
  100. while (<>) {
  101.     s/$words/dye($color_letter_set, $&)/eg;
  102.     print;
  103. }
  104.  
Runtime error #stdin #stdout #stderr 0.02s 5680KB
comments (?)
stdin
copy 
Standard input is empty
stdout
copy 
Standard output is empty
stderr
copy 
This filter program do highlight words in STDIN
inputs | this_script "words" color
cat flower_names | prog.pl "Rose" red
cat flower_names | prog.pl "Rose" red back_dark_grey Itaric

supported visible colors are
back_black back_dark_grey back_grey back_light_blue back_light_cyan back_light_green back_light_purple back_light_yellow back_orange back_pink back_shade_cyan back_shade_green back_shade_red back_tint_blue back_tint_purple back_white back_whity black blink blink_quick blue bold center_bar cyan dark_grey green invisible itaric left_up null orange purple red right_down tall tint top_bar underline underline_w vivid_blue vivid_green vivid_magenta vivid_red vivid_water vivid_yellow


 [] found. More than 2 args needed.
https://ideone.com/giUK4s
language:
Perl (perl 5.28.1)
created:
276 days ago
visibility:
secret

Share or Embed source code

Discover > Sphere Engine API

The brand new service which powers Ideone!

Discover > IDE Widget

Widget for compiling and running the source code in a web browser!