view release on metacpan or  search on metacpan

lib/App/Tel/Color/Cisco.pm  view on Meta::CPAN

package App::Tel::Color::Cisco;
use parent 'App::Tel::Color::Base';
use Term::ANSIColor;
use Scalar::Util qw ( looks_like_number );
use strict;
use warnings;

=head1 NAME

App::Tel::Cisco - Colors for show interface and other commands

=head2 METHODS

=cut

sub _c {
    # if not a number then return the original text
    my $val = shift;
    return $val if (!looks_like_number($val));
    if ($val > 0) {
        return colored($val, 'red');
    }
    return colored($val, 'green');
}


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

    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 = '';
        for (1..$count) { $args .= ",_c(\$$_)" }

        my $eval = 'sprintf("'.$substring.'"'.$args.')';

        # in theory this is safer than the old external eval.  The reason
        # being all the evaluated data is part of the defined strings passed
        # to the _crazy function.  That means no data coming from a router can
        # be evaluated.
        $text =~ s/$s/eval $eval/e;
    }

    return $text;
}

sub _uspwr {
    my $pwr = shift;
    my $color = 'red';
    if    ( $pwr < 30 ) { $color = 'red'; }
    elsif ( $pwr >= 30 && $pwr <= 33 ) { $color = 'yellow'; }
    elsif ( $pwr >= 33 && $pwr <= 45 ) { $color = 'green'; }
    elsif ( $pwr >= 45 && $pwr <= 50 ) { $color = 'yellow'; }
    elsif ( $pwr > 50 ) { $color = 'red'; }
    return colored($pwr, $color);
}

sub _ussnr {
    my $snr = shift;
    my $color = 'red';
    if    ( $snr < 20 ) { $color = 'red'; }
    elsif ( $snr >= 20 && $snr <= 25 ) { $color = 'yellow'; }
    elsif ( $snr > 25 ) { $color = 'green'; }
    return colored($snr, $color);
}

sub _dspwr {
    my $input = shift;
    my $pwr = $input;
    $pwr =~ s/ //g;   # remove all spaces, leaving possible negative sign and value
    my $color = 'red';
    if    ( $pwr < -15 ) { $color = 'red'; }