[LARTC] tctree

[raptor <raptor@tvskat.net>]

Hi,

below u will find a simple perl script to draw a TC CLASS tree.
At the moment only 3 formatings are available, but u can easly add more(look cformat)
The formating option can be chained with '-'. 
Example usage :
tc class show dev eth1 | ./tctree.pl              
tc class show dev eth1 | ./tctree.pl -f pure
tc class show dev eth1 | ./tctree.pl -f bitps
tc class show dev eth1 | ./tctree.pl -f rate
tc class show dev eth1 | ./tctree.pl -f rate-bitps

Good for diplayng ppl scenarios.

=============OUTPUT==========================
[root@qos tcng]# tc class show dev eth1 | ./tctree.pl              
class htb 2:1 root rate 125000bps ceil 125000bps burst 2849b cburst 2849b 
|_class htb 2:2 parent 2:1 rate 12500bps ceil 12500bps burst 1724b cburst 1724b 
  |_class htb 2:3 parent 2:2 rate 8750bps ceil 12500bps burst 1686b cburst 1724b 
    |_class htb 2:4 parent 2:3 prio 0 rate 125bps ceil 9625bps burst 1600b cburst 1695b 
    |_class htb 2:5 parent 2:3 prio 0 rate 2400bps ceil 2400bps burst 1623b cburst 1623b 
      |_class htb 2:6 parent 2:2 prio 0 rate 3750bps ceil 12500bps burst 1636b cburst 1724b 
        |_class htb 2:7 parent 2:1 rate 6250bps ceil 6250bps burst 1661b cburst 1661b 
          |_class htb 2:8 parent 2:7 prio 0 rate 125bps ceil 9625bps burst 1600b cburst 1695b 
          |_class htb 2:9 parent 2:7 prio 0 rate 2400bps ceil 2400bps burst 1623b cburst 1623b 
[root@qos tcng]# tc class show dev eth1 | ./tctree.pl -f rate-bitps
rate 1000000bs
|_rate 100000bs
  |_rate 70000bs
    |_rate 1000bs
    |_rate 19200bs
      |_rate 30000bs
        |_rate 50000bs
          |_rate 1000bs
          |_rate 19200bs
[root@qos tcng]# tc class show dev eth1 | ./tctree.pl -f pure
htb 2:1
|_htb 2:2
  |_htb 2:3
    |_htb 2:4
    |_htb 2:5
      |_htb 2:6
        |_htb 2:7
          |_htb 2:8
          |_htb 2:9
[root@qos tcng]# 

===================SCRIPT================================
#!/usr/bin/perl
use strict;
use vars qw(%o);
use Getopt::Std;
getopts('f:',\%o);

open FILE, '-' or die 'hmmm... : $!';
my @in = <FILE>;
close FILE;

#formats - pure
sub cformat {
    my ($line, $formats) = @_;
    my $res;
    for my $f (split /-/, $formats) { 
        $line =~ s/class (\w+? \d+:\d+).+$/$1/ if $f eq 'pure';
	$line =~ s/^.+(rate \d+\w+).+$/$1/ if $f eq 'rate';    
        $line =~ s!(\d+)bps!($1*8).'bs'!eg if $f eq 'bitps';
    };
    return $line
}


my $tab = '|_';
my $prev = shift @in;
my ($prevParent) = $prev =~ /(\d+:\d+)/;
for my $i ( 0 .. $#in ) {
    my ($classID, $parent) = $in[$i] =~ /class\D+(\d+:\d+)\D+parent\D+(\d+:\d+)/;
    $tab =~ s/^(.+)$/(' ' x length($1)).'|_'/e unless $parent eq $prevParent;
    $in[$i] = "$tab" . cformat($in[$i], $o{f});
    $prevParent = $parent;
};

print cformat($prev,$o{f}),@in;


_______________________________________________
LARTC mailing list / LARTC@mailman.ds9a.nl
http://mailman.ds9a.nl/mailman/listinfo/lartc HOWTO: http://lartc.org/