Here is another try .... i havent tried on deeper trees, but it should work....
enjoy
============OUTPUT=================================================================[root@qos
tcng]# tc class show dev eth1 | ./tctree.pl -f idparent
+-class htb 2:1 root rate 125000bps ceil 125000bps burst 2849b cburst 2849b
+-htb 2:2 parent 2:1
| +-htb 2:3 parent 2:2
| | +-htb 2:4 parent 2:3
| | +-htb 2:4 parent 2:3
| +-htb 2:3 parent 2:2
+-htb 2:2 parent 2:1
+-htb 2:3 parent 2:2
+-htb 2:3 parent 2:2
[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:4
| +-htb 2:3
+-htb 2:2
+-htb 2:3
+-htb 2:3
============================SCRIPT=====================================================#!/usr/bin/perl
use strict;
use vars qw(%o);
use Getopt::Std;
use Data::Dumper;
getopts(''f:'',\%o);
my %pos;#for storing class positions
#used to cut unnececary vertical bars
#too much effort for being beautiful :")
my %child;
open FILE, ''-'' or die ''hmmm... : $!'';
my @in = <FILE>;
close FILE;
#formats - pure, bitps, rate, idparent
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'';
$line =~ s/class (.+parent \d+:\d+).+$/$1/ if $f eq
''idparent'';
};
return $line
}
#which is the nearest parent in this column in the rows before me
sub nearestInCol {
my ($row, $col) = shift;
#if u think u can make it harder do it :")
my ($v) = sort { $pos{$_}{$b} <=> $pos{$_}{$b} }
grep { $pos{$_}{row} < $row && $pos{$_}{col} == $col } keys %pos;
return $v
}
#ascii-art
sub art {
my ($cls,$row) = @_;
my $tab;
for my $c (0 .. $pos{$cls}{col}) {
my $nearest = &nearestInCol($row,$c);
SWITCH: {
if ($c > ($pos{$cls}{col})-1) { $tab .= ''+-''; last
SWITCH};
#dont even ask me what this is doing ... !!!
if (#ok if nearest parent on this column doesnt have more childs below us
cut it
$c == $pos{$nearest}{col} || $row > $child{$nearest} ) { $tab .= ''
''; last SWITCH};
$tab .= ''| ''
}
}
return $tab
}
#build class position table
my ($prevParent, $prevClassID);
my $c = 0;#column
for my $r ( 1 .. $#in ) {
my ($classID, $parent) = $in[$r] =~
/class\D+(\d+:\d+)\D+parent\D+(\d+:\d+)/;
unless ($parent eq $prevParent) {
unless ($parent ne $prevClassID) { $c++ }
else {$c = $pos{$parent}{col}+1}
};
$pos{$classID}{col} = $c;
$pos{$classID}{row} = $r;
$prevParent = $parent;
$prevClassID = $classID;
$child{$parent} = $r;
};
#print the tree
my $row = 0;
for my $cls (sort {$pos{$a}{row} <=> $pos{$b}{row}} keys %pos) {
my $tab = art($cls,$row);
print $tab.(cformat($in[$pos{$cls}{col}],$o{f}));
$row++
};
_______________________________________________
LARTC mailing list / LARTC@mailman.ds9a.nl
http://mailman.ds9a.nl/mailman/listinfo/lartc HOWTO: http://lartc.org/