a bit of color for Gbe data and busy times in network map

diff --git a/web/htdocs/layout/styles.css b/web/htdocs/layout/styles.css
index 667e8f677e07fc40adedd876d1c5b6ccd202d977..94fde7ccf552504bb25bc80735a2dbe6ab220110 100644 (file)
--- a/web/htdocs/layout/styles.css
+++ b/web/htdocs/layout/styles.css
@@ -329,3 +329,7 @@ table#server-details pre {
 .triggermap tr {
   height:30px;
 }
+
+#content .busy > td:first-child {
+  border-left-color:#522;
+}

diff --git a/web/htdocs/network/map.pl b/web/htdocs/network/map.pl
index 4daa3451ed44ee7e5d4933d48e931b50b8628e88..53949085ccbc5569bbba529911daf5e5fe78c0fa 100755 (executable)
--- a/web/htdocs/network/map.pl
+++ b/web/htdocs/network/map.pl
@@ -20,56 +20,67 @@ use lib qw|../commands htdocs/commands|;
 use xmlpage;
 use Data::Dumper;
 use Date::Format qw(time2str);
+use Time::HiRes qw(usleep);
+use List::Util qw(min);
 use v5.10;
 
+my $detailed = 1;
+
 ###############################################################################  
 ##  Network Map
 ###############################################################################  
 if($ENV{'QUERY_STRING'} =~ /getmap/) {
 #   print "Getting map";
     
-    trb_init_ports() or
-      die("can not connect to trbnet-daemon on the $ENV{'DAQOPSERVER'}");
-    
-    my $boards   = trb_read_uid(0xffff);
-    my $temp     = trb_register_read(0xffff,0);
-    my $ctime    = trb_register_read(0xffff,0x40);
-    my $inclLow  = trb_register_read(0xffff,0x41);
-    my $hardware = trb_register_read(0xffff,0x42);
-    my $inclHigh = trb_register_read(0xffff,0x43);
+  trb_init_ports() or
+    die("can not connect to trbnet-daemon on the $ENV{'DAQOPSERVER'}");
   
-    my @store;
-    my $tree;
-    my $uids;
-    my $endpid;
-    my $lastlayer = 1;
+  my $boards   = trb_read_uid(0xffff);
+  my $temp     = trb_register_read(0xffff,0);
+  my $ctime    = trb_register_read(0xffff,0x40);
+  my $inclLow  = trb_register_read(0xffff,0x41);
+  my $hardware = trb_register_read(0xffff,0x42);
+  my $inclHigh = trb_register_read(0xffff,0x43);
+  my $hubbusy  = trb_register_read(0xfffe,0x80);
 
-    foreach my $id (keys %{$boards}) {
-      foreach my $f (keys %{$boards->{$id}}) {
-        my $addr = $boards->{$id}->{$f};
-        next if $addr == 0xfc00;
-        $uids->{$addr} = $id;
-        $endpid->{$addr} = $f;
-        my @path = trb_nettrace($addr);
-        my $parent, my $port;
-        if(scalar @path == 0) {
-          $parent = 0;
-          $port   = 0;
-        }
-        else {
-          $parent = $path[-1][-1]->{address};
-          $port   = $path[-1][-1]->{port};
-        }
-        $tree->{$parent}->[$port]->{addr}   = $addr;
+  my $hubbusy1  = trb_register_read_mem(0xfffe,0x4030,0,16);
+  my $gbebusy1  = trb_register_read(0xff7f,0x83e2); 
+  usleep(100000);
+  my $hubbusy2  = trb_register_read_mem(0xfffe,0x4030,0,16);
+  my $gbebusy2  = trb_register_read(0xff7f,0x83e2); 
+
+  my @store;
+  my $tree;
+  my $uids;
+  my $endpid;
+  my $lastlayer = 1;
+
+  foreach my $id (keys %{$boards}) {
+    foreach my $f (keys %{$boards->{$id}}) {
+      my $addr = $boards->{$id}->{$f};
+      next if $addr == 0xfc00;
+      $uids->{$addr} = $id;
+      $endpid->{$addr} = $f;
+      my @path = trb_nettrace($addr);
+      my $parent, my $port;
+      if(scalar @path == 0) {
+        $parent = 0;
+        $port   = 0;
+      }
+      else {
+        $parent = $path[-1][-1]->{address};
+        $port   = $path[-1][-1]->{port};
       }
+      $tree->{$parent}->[$port]->{addr}   = $addr;
     }
-    
+  }
+  
 
-    print "<table id=\"content\" class=\"content map\"><tr class=\"head map\"><th>Board<th>Hardware<th>Design<th>Compile Time<th>Temperature<th>UID - Endp<th>MAC<th>serial\n";
-    printlist(0,1);
-    print "</table>";
-    
-    sub printlist {
+  print "<table id=\"content\" class=\"content map\"><tr class=\"head map\"><th>Board<th>Hardware<th>Design<th>Compile Time<th>Temperature<th>UID - Endp<th title=\"overlay: GbE data %\">MAC<th title=\"overlay: deadtime %\">serial\n";
+  printlist(0,1);
+  print "</table>";
+  
+  sub printlist {
     my ($parent,$layer) = @_;
     if($layer > 16) {die "More than 16 layers of network devices found. Aborting."}
     my @o;
@@ -220,12 +231,28 @@ if($ENV{'QUERY_STRING'} =~ /getmap/) {
             if ($value==5) {$feat .="\nClock: external 120 MHz";}
       }
 
+      my $busy = $hubbusy->{$parent} & (1<<$p);
       my $serial = GetSerial($uids->{$addr},$hardware->{$addr}>>24&0xff);
+     
+      my $hubval = $hubbusy2->{$parent}[$p] - $hubbusy1->{$parent}[$p];
+         $hubval += 2**32 if $hubval < 0;
+         $hubval /= 10E6; 
+         $hubval = ceil(min($hubval*100,100));
+      my $hublevel =  'style="background:linear-gradient(to right,rgba(0,0,255,0.3) '.($hubval-1).'%,transparent '.$hubval.'%);"' ;
       my $mac = '';
-         $mac = GetMac($uids->{$addr},$btype) if $feat =~ /GbE/;
-      printf("<tr class=\"level level%i%s\"><td><div>%i</div>0x%04x<td title=\"0x%08x\">%s<td title=\"0x%08x%08x\n%s\">%s<td title=\"0x%08x\">%s<td>%.1f°C<td>%016x&nbsp;-&nbsp;%i<td>%s<td>%s\n",
+      my $gbelevel = '';
+      if ($feat =~ /GbE/) {
+        $mac = GetMac($uids->{$addr},$btype);
+        my $gbeval = $gbebusy2->{$addr}-$gbebusy1->{$addr};
+        $gbeval /= 9E4;
+        $gbeval = ceil(min($gbeval,100));
+        $gbelevel = 'style="background:linear-gradient(to right,rgba(0,0,255,0.3) '.($gbeval-1).'%,transparent '.$gbeval.'%);"' ;
+        }
+        
+      printf("<tr class=\"level level%i%s%s\"><td><div>%i</div>0x%04x<td title=\"0x%08x\">%s<td title=\"0x%08x%08x\n%s\">%s<td title=\"0x%08x\">%s<td>%.1f°C<td>%016x&nbsp;-&nbsp;%i<td %s>%s<td %s>%s\n",
              $layer,
              ($layer!=$lastlayer?' newlevel':' oldlevel'),
+             ($busy?' busy':''),
              $p,
              $addr,
              $hardware->{$addr},
@@ -239,8 +266,11 @@ if($ENV{'QUERY_STRING'} =~ /getmap/) {
              ($temp->{$addr}>>20)/16,
              $uids->{$addr},
              $endpid->{$addr},
+             $gbelevel,
              $mac,
-             $serial);
+             $hublevel,
+             $serial,
+             );
       
       $lastlayer = $layer;
       printlist($tree->{$parent}->[$p]->{addr},$layer+1);