Author: gotar Date: Mon May 19 07:51:21 2008 GMT
Module: SOURCES Tag: HEAD
---- Log message:
- restored
---- Files affected:
SOURCES:
tccs (1.4 -> 1.5) (NEW)
---- Diffs:
================================================================
Index: SOURCES/tccs
diff -u /dev/null SOURCES/tccs:1.5
--- /dev/null Mon May 19 09:51:21 2008
+++ SOURCES/tccs Mon May 19 09:51:16 2008
@@ -0,0 +1,108 @@
+#!/usr/bin/perl -w
+
+# copyright gotar <[EMAIL PROTECTED]>, 2005
+# license: GPL
+
+#use strict;
+use Getopt::Long;
+
+#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 $speedlevel=0;
+my %translate;
+
+eval `cat tccs.rc`;
+
+GetOptions('recurse=s'=>\$recurse,
+ 'fastest=s'=>\$speedlevel);
+
+while(<STDIN>) {
+ if(/^ lended: / and $crate) {
+ if($rate ne $ceil) {
+ $range="$rate-$ceil";
+ } else {
+ $range=$rate;
+ }
+# print "$parent: $class $classid $range $crate kb/s\n";
+ @{$tree{$parent}}[0]='' unless @{$tree{$parent}}[0];
+ push @{$tree{$parent}}, $classid;
+ $crate=sprintf "%8.1lf",$crate;
+ $sent=sprintf "%10.0lf",$sent/1024;
+ @{$tree{$classid}}[0]="($class) $range $crate kb/s ($sent
KB)";
+ $crate=0;
+ next;
+ }
+ if(/^ Sent (\d+) bytes /) {
+ $sent=$1;
+ next;
+ }
+ if(/^ rate (\S+)(bit|bps) /) {
+ # print "BPS rate!\n" if $2 eq "bps";
+ ($crate=$1)=~s/K/*1024/;
+ $crate=~s/M/*1024*1024/;
+ $crate=eval $crate;
+ $crate*=8/1000;
+ 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] unless $speedlevel;
+ return -1 if($a=~/^\(/);
+ $tree{$_[0]}[0]=~m|\(\S+\)\ \S+ \s*([\d\.]+) kb/s \(|;
+ my $a=$1;
+ $tree{$_[1]}[0]=~m|\(\S+\)\ \S+ \s*([\d\.]+) kb/s \(|;
+ my $b=$1;
+ return $b <=> $a;
+}
+
+sub list {
+ return if length($level)/2==$recurse;
+ if($_[0]) {
+ if(exists $translate{$_[0]}) {
+ printf "$level%-4s",$translate{$_[0]};
+ } else {
+ printf "$level%-4s",$_[0];
+ }
+ } else { return; }
+ $level.=' ';
+ my $rank=0;
+ foreach my $id (sort {my_sort($a,$b)} (@{$tree{$_[0]}})) {
+ if($id=~/^\(/) {
+ print " $id\n";
+ next;
+ } else {
+ $rank++;
+ next if $rank>$speedlevel and $speedlevel;
+ list($id);
+ }
+ }
+ $level=substr($level,2);
+}
+
[EMAIL PROTECTED]'root'}}[0]="\n";
+#list('root');
+foreach (sort {my_sort($a,$b)} (@{$tree{'root'}})) {
+ list($_);
+}
================================================================
_______________________________________________
pld-cvs-commit mailing list
[email protected]
http://lists.pld-linux.org/mailman/listinfo/pld-cvs-commit
