rtrcolor - cisco "sh interface" colorizer

rtrcolor.pl

#!/usr/bin/perl -w

# Copyright (C) 2007 Robert Drake
# This module is free software; you can redistribute it and/or
# modify it under the terms of the GNU Library General Public
# License as published by the Free Software Foundation; either
#  version 2 of the License, or (at your option) any later version.
#
# This module is distributed in the hope that it will be useful,
# but WITHOUT ANY WARRANTY; without even the implied warranty of
# MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU
# Library General Public License for more details.
#
# You should have received a copy of the GNU Library General Public
# License along with this library; if not, write to the
# Free Software Foundation, Inc., 59 Temple Place - Suite 330,
# Boston, MA 02111-1307, USA.


# Notes:
# this code is very hard for me to read but it takes the output from "sh interface"
# and colors the numbers according to if they are zero or not.  Usually my
# perl isn't write-once-read-never, but I didn't come up with a good way of
# doing this and just made something work.
#
# This may be older than 2007.  I'm going by what git blame tells me. :)


use Term::ANSIColor;
use strict;

my $host_color = "magenta";
my $warn_color = "red";
my $good_color = "green";
my $cmd_color = "yellow";

# add "sh cable modem phy"

$Term::ANSIColor::AUTORESET++;         # reset color after each print
$SIG{INT} = sub { print "\n"; exit; }; # reset color after Ctrl-C

sub c {
   my $value = shift;
   return $value if ($value =~ /\D/);
   if ($value > 0) {
      return colored($value, $warn_color);
   } else {
      return colored($value, $good_color);
   }
}

# not kidding, this will be crazy.
# it simulates s/blah (\d+) blah/sprintf("blah %s blah", c($1))/e;
sub crazy {
   my @strings = @_;
   my $evils;

   foreach my $s (@strings) {

      my $substring = $s;
      # (?<!\\)(?!\\) are funny things that mean look behind and look ahead
      # for \\ (the escape \ before a parenthesis)
      my $count = $substring =~ s/(?<!\\)(?!\\)\(.*?\)/%s/g;

      my $args;
      map { $args .= ",c(\$$_)"; } 1..$count;
      $evils .= "s/$s/sprintf(\"$substring\"$args)/e;";
   }

   return $evils;
}

my $regexp = crazy('(\d+) runts, (\d+) giants, (\d+) throttles',
		'(\d+) input errors, (\d+) CRC, (\d+) frame, (\d+) overrun, (\d+) ignored',
		'(\d+) input packets with dribble condition detected',
		'Total output drops: (\d+)',
		'(\d+) output errors, (\d+) collisions, (\d+) interface resets',
		'(\d+) output buffer failures, (\d+) output buffers swapped out',
		'(\d+) carrier transitions',
		'Output queue (\S+), (\d+) drops; input queue (\S+), (\d+) drops',
		'(\d+)\/(\d+) \(size\/max\/drops\/flushes\)\;',
                '(\d+) (pause input|watchdog|underruns|no buffer|pause output|abort)',
                '(\d+) output errors, (\d+) collisions, (\d+) interface resets',
                '(\d+) babbles, (\d+) late collision, (\d+) deferred',
                '(\d+) lost carrier, (\d+) no carrier',
    );

while (<>) {

    s/^(\S+) is (.*), line protocol is (.*)/
       sprintf("%s is %s, line protocol is %s", colored($1, $host_color),
             colored($2, $2 ne "up" ? $warn_color : $good_color),
             colored($3, $2 ne "up" ? $warn_color : $good_color))/e;
    s/^(\S+#)(.*)/sprintf("%s%s",$1, colored($2, $cmd_color))/e;

    eval $regexp;
    print $_;
}