src/csox

   1 #!/usr/bin/perl -w
   2
   3 # SoX script: colourise SoX output   (c) 2009 robs@users.sourceforge.net
   4 # Based on colorgcc by Jamie Moyers.
   5 #
   6 # This program is free software; you can redistribute it and/or modify it
   7 # under the terms of the GNU General Public License as published by the
   8 # Free Software Foundation; either version 2 of the License, or (at your
   9 # option) any later version.
  10 #
  11 # This program is distributed in the hope that it will be useful, but
  12 # WITHOUT ANY WARRANTY; without even the implied warranty of
  13 # MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU General
  14 # Public License for more details.
  15 #
  16 # You should have received a copy of the GNU General Public License along
  17 # with this program; if not, write to the Free Software Foundation, Inc.,
  18 # 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301 USA.
  19
  20 use Term::ANSIColor; # From CPAN.
  21 use IPC::Open3;
  22
  23 # Add similar lines for other non ANSI colour ttys:
  24 $no_colour{"dumb"} = "true";
  25
  26 # Change these as per your preference:
  27 $colours{"DBUG"} = color("bold blue");
  28 $colours{"FAIL"} = color("bold red");
  29 $colours{"INFO"} = color("green");
  30 $colours{"WARN"} = color("bold yellow");
  31 $default_colour  = color("white");
  32 $name_colour     = color("bold cyan"); # For words between single quotes
  33
  34 # Derive the name of the wrapped program by removing
  35 # the leading 'c' from the wrapper script name.
  36 $0 =~ m%(.*/)c(.*)$%;
  37 $child = "$1$2";
  38 @child_list = split /\s+/, $child;
  39 $child = $child_list[0];
  40 @child_args = ( @child_list[1 .. $#child_list], @ARGV );
  41
  42 $term = $ENV{"TERM"} || "dumb";
  43 if (! -t STDERR || $no_colour{$term}) {
  44   exec $child, @child_args or die("Couldn't exec");
  45 }
  46
  47 $pid = open3('<&STDIN', '>&STDOUT', \*CHILDERR, $child, @child_args);
  48
  49 $reset = color("reset");
  50 while(<CHILDERR>) {
  51   if (m/^(.*?) (FAIL|WARN|INFO|DBUG) (.*)$/) {
  52     $type = $2;
  53     $tail = $3;
  54     $colour = $colours{$type};
  55     $tail =~ s/\`(.*?)\'/`$name_colour$1$reset$colour'/g;
  56     print(STDERR $colour, "$type ", $reset, $colour, $tail, $reset, "\n");
  57   }
  58   else {
  59     print(STDERR "$default_colour$_$reset");
  60   }
  61 }
  62
  63 waitpid($pid, 0); # Get the return code of the child and exit with that.
  64 exit($? >> 8);