OK, now it should support the output of the tcng too....
And one new option if u have a comments before the class declaration u can print
them like this :
[root@qos tcng]# cat xxx.tc | ./tctree.pl -f comment
+- total
+- internet channel
| +- guaranteed 70%
| | +- g19.2
| | +- g19.2
| +- unguaranteed
+- BG channel
+- u77kbps
+- u19.2kbps
[root@qos tcng]# cat xxx.tc | ./tctree.pl -f idparent
+-parent 2:0 classid 2:1
+-parent 2:1 classid 2:2
| +-parent 2:2 classid 2:3
| | +-parent 2:3 classid 2:4
| | +-parent 2:3 classid 2:4
| +-parent 2:2 classid 2:3
+-parent 2:1 classid 2:2
+-parent 2:2 classid 2:3
+-parent 2:2 classid 2:3
=========================xxx.tc=================which is generated using
prevoisly sent on the list com.pl script from Warner .... i.e. "com.pl
xxx.tcng > xxx.tc"
# ================================ Device eth1 ===============================
tc qdisc add dev eth1 handle 1:0 root dsmark indices 4 default_index 0
# root
tc qdisc add dev eth1 handle 2:0 parent 1:0 htb default 5
# total
tc class add dev eth1 parent 2:0 classid 2:1 htb rate 125000bps
# internet channel
tc class add dev eth1 parent 2:1 classid 2:2 htb rate 12500bps
# guaranteed 70%
tc class add dev eth1 parent 2:2 classid 2:3 htb rate 8750bps ceil 12500bps
# g19.2
tc class add dev eth1 parent 2:3 classid 2:4 htb rate 125bps ceil 9625bps
tc class add dev eth1 parent 2:3 classid 2:5 htb rate 2400bps ceil 2400bps
# unguaranteed
tc class add dev eth1 parent 2:2 classid 2:6 htb rate 3750bps ceil 12500bps
# BG channel
tc class add dev eth1 parent 2:1 classid 2:7 htb rate 6250bps
# u77kbps
tc class add dev eth1 parent 2:7 classid 2:8 htb rate 125bps ceil 9625bps
# u19.2kbps
tc class add dev eth1 parent 2:7 classid 2:9 htb rate 2400bps ceil 2400bps
tc filter add dev eth1 parent 2:0 protocol all prio 1 tcindex mask 0x3 shift 0
tc filter add dev eth1 parent 2:0 protocol all prio 1 handle 2 tcindex classid
2:5
tc filter add dev eth1 parent 2:0 protocol all prio 1 handle 1 tcindex classid
2:4
tc filter add dev eth1 parent 1:0 protocol all prio 1 handle 1:0:0 u32 divisor 1
tc filter add dev eth1 parent 1:0 protocol all prio 1 u32 match u32 0xc0a80001
0xffffffff at 12 classid 1:1
tc filter add dev eth1 parent 1:0 protocol all prio 1 u32 match u32 0xc0a80002
0xffffffff at 12 classid 1:2
tc filter add dev eth1 parent 1:0 protocol all prio 1 u32 match u32 0 0 at 0
classid 1:0 police index 1 rate 1bps burst 1 action drop/drop
=====================THE SCRIPT==================
#!/usr/bin/perl
use strict;
use vars qw(%o @in);
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;
#formats - pure, bitps, rate, idparent ...etc
sub cformat {
my ($line, $formats, $cls) = @_;
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'';
if ($f eq ''idparent'') {
if ($line =~ /classid/) { $line =~ s/^.+(parent.+classid \d+:\d+).+$/$1/}
else { $line =~ s/class (.+parent \d+:\d+).+$/$1/ }
};
$line = $pos{$cls}{comment}."\n" if $f eq
''comment'';
};
return $line
}
#which is the nearest parent in this column in 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
}
#=======================MAIN====================#leave only classes and comments
and place comments in %pos
open FILE, ''-'' or die ''hmmm... : $!'';
my $comment;
while (<FILE>) {
if ($_ =~ /^\s*#/) {#this is comment just before class declaration
($comment) = $_ =~ /^\s*#(.+)$/;
};
next unless $_ =~ /^(tc )?class/;
$_ =~ s/^.*?(class.+)$/$1/;
push @in, $_;
if ($comment) {
my ($classID) = $_ =~ /class(?:id)?\D+(\d+:\d+)/;
$pos{$classID}{comment} = $comment
}
}
close FILE;
#build class position table
my ($prevParent, $prevClassID, $myComment);
my $c = 0;#column
for my $r ( 1 .. $#in ) {
my ($classID) = $in[$r] =~ /class(?:id)?\D+(\d+:\d+)/;
my ($parent) = $in[$r] =~ /parent\D+(\d+:\d+)/;
# print "$classID -- $parent\n";
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},$cls));
$row++
};
_______________________________________________
LARTC mailing list / LARTC@mailman.ds9a.nl
http://mailman.ds9a.nl/mailman/listinfo/lartc HOWTO: http://lartc.org/