Author: gotar Date: Mon May 19 07:51:01 2008 GMT
Module: SOURCES Tag: HEAD
---- Log message:
- restored (maybe this time?)
---- Files affected:
SOURCES:
tccg (1.3 -> 1.4) (NEW)
---- Diffs:
================================================================
Index: SOURCES/tccg
diff -u /dev/null SOURCES/tccg:1.4
--- /dev/null Mon May 19 09:51:01 2008
+++ SOURCES/tccg Mon May 19 09:50:56 2008
@@ -0,0 +1,99 @@
+#!/usr/bin/perl -w
+
+# copyright gotar <[EMAIL PROTECTED]>, 2005
+# license: GPL
+
+#use strict;
+use Getopt::Long;
+use Sys::Hostname;
+
+#tc -s class show dev eth1 | perl -e 'undef $/; while(<>) { while (/class htb
(.*?) .*?\n\s*Sent (\d+) .*?\n\s*rate (\d+)/sg) { print "Klasa: $1 Wyslano: $2
($3bps)\n" }; };'
+
+my $class;
+my $classid;
+my $parent;
+my $rate;
+my $ceil;
+my $crate;
+my $sent;
+my $range;
+my %tree;
+my $recurse=10;
+my $supressrate=0;
+my $squeeze=0;
+my $interface='root';
+my %translate;
+
+eval `cat tccs.rc`;
+
+GetOptions('recurse=s'=>\$recurse,
+ 'ceil'=>\$supressrate,
+ 'squeeze'=>\$squeeze,
+ 'interface=s'=>\$interface);
+
+while(<STDIN>) {
+ if(/^ lended: /) {
+ if($rate ne $ceil) {
+ $range="$rate-$ceil";
+ } else {
+ $range=$rate;
+ }
+ $range="$ceil" if $supressrate;
+ $range=~s/bit//g;
+# print "$parent: $class $classid $range $crate kb/s\n";
+ @{$tree{$parent}}[0]='' unless @{$tree{$parent}}[0];
+ push @{$tree{$parent}}, $classid;
+ @{$tree{$classid}}[0]="($class) $range";
+ next;
+ }
+ if(/^class (\S+) (\S+:\S+) (root|parent (\S+:\S+)) .*rate (\S+) ceil
(\S+)/) {
+ $class=$1;
+ $classid=$2;
+ $rate=$5;
+ $ceil=$6;
+ ($parent=$3)=~s/parent //;
+ next;
+ }
+}
+
+my $level='';
+
+sub my_sort {
+ return 0 unless $_[0];
+ return $_[0] cmp $_[1];
+}
+
+sub list {
+ return if length($level)/2==$recurse;
+ my $parent=$_[1];
+ my $class; my $last; my $diff='';
+ $diff=$_[0] unless $squeeze;
+ if($_[0]) {
+ if(exists $translate{$_[0]}) {
+ $class=sprintf "%-4s",$translate{$_[0]};
+ } else {
+ $class=sprintf "%-4s",$_[0];
+ }
+ } else { return; }
+ $level.=' ';
+ foreach my $id (sort {my_sort($a,$b)} (@{$tree{$_[0]}})) {
+ if($id=~/^\(/) {
+ #print " $parent \"$id $class\" [label=\"$class\"];\n";
+ print " $parent \"$id $diff\" [label=\"$class\"];\n";
+ #$last="$id $class";
+ $last="$id $diff";
+ next;
+ } else {
+ list($id,"\"$last\" ->");
+ }
+ }
+ $level=substr($level,2);
+}
+
[EMAIL PROTECTED]'root'}}[0]="\n";
+#list('root');
+print "digraph ".hostname." {\ncenter=1;\nnode [color=green];\nedge
[color=blue, fontcolor=red];\n$interface [shape=polygon, sides=5,
peripheries=3, color=magenta];\n";
+foreach (sort {my_sort($a,$b)} (@{$tree{'root'}})) {
+ list($_,"\"$interface\" ->");
+}
+print "}\n";
================================================================
_______________________________________________
pld-cvs-commit mailing list
[email protected]
http://lists.pld-linux.org/mailman/listinfo/pld-cvs-commit
