SOURCES: tccg (NEW) - restored (maybe this time?)

[gotar]

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 <gotar at pld-linux.org>, 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);
+}
+
+#@{$tree{'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";
================================================================