[tctree] now seems to work ok :")

[raptor <raptor@xxxxxxxxxx>]

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/