package GUI::Test;
#<copyright>
# ----------------------------------------------------------
# Sun Proprietary/Confidential Code
# Copyright 2001, Sun Microsystems, Inc. All rights reserved.
# ----------------------------------------------------------
#</copyright>


use Util;
use AutoForm;
use strict;
use TO;
use TO::Applet;
use GUI;
use Tasks;
use Tests;
use Cache;
use Html::List;
use Html;
use GUI::Graph;
use GUI::ProcMgr;
use Html::Tabs;
use System;
use Scheduler;
use Data::Dumper;

sub list_frame {
  my($q) = @_;
  my($renv) = System->get_renv();
  my $ruser = System->get_ruser();
  my $window = $ruser->{window} || $renv->{window};
  if ($window ne "B") {
     GUI::Test::from_list($q);
  } else {
     print <<EOF;
<frameset cols=*,37% border=0>
    <frame src=$Http::WEBPROC?GO=GUI::Test::from_list name=main scrolling=auto marginwidth=1 marginheight=1>
    <frame src=empty.html name=details scrolling=auto  xmarginheight=1>
</frameset>

EOF
  }
}

sub frame {
  my($q) = @_;
  my($renv) = System->get_renv();
  my $ruser = System->get_ruser();
  my $window = $ruser->{window} || $renv->{window};

  if ($window ne "B") {
     $q->{LINKH} = 1;
     GUI::Graph::run3($q);
  } else {
     print <<EOF;
<frameset cols=*,37% border=0>
    <frame src=$Http::WEBPROC?GO=GUI::Graph::run3&LINKH=1 name=main scrolling=no marginwidth=1 marginheight=1>
    <frame src=/graph_help.html name=details scrolling=auto  xmarginheight=1>
</frameset>
EOF
  }
}


sub NUtopo {
  my($q) = @_;
  $q->{LINKH} = 1;
  GUI::Graph::run3($q);
  return;
# foreach my $x (keys %$q) {print "$x=$q->{$x}<br>"}

  print "\n<body  bgcolor=white link=blue alink=blue vlink=blue marginheight=0>
    <script>
    function win2(t) {
      var b = '$Http::WEBPROC?GO=GUI::Graph::search&target=diag&topo=' + t;
      var O = window.open(b,'hist','menubar=no,resizable=yes,scrollbars=yes,width=300,height=600');
      O.focus();
    }
    </script>
";
  my($renv) = System->get_renv();

  my($select_host, $filter) = GUI->topoPage($q);
# my($selected, $head) = GUI->test_head($q);

  my $links =  "<a href=javascript:win2('$q->{topo}')>Search</a> | <a href=$Http::WEBPROC?GO=GUI::Graph::run3>Topo</a>&nbsp;";
  my $header = "<table border=0 cellspacing=0 cellpadding=0 bgcolor=#F0F0F0 width=100%>
   <tr><td nowrap width=40%>
       <form><input type=hidden name=GO value=GUI::Test::topo>
       <b>&nbsp;&nbsp;Host:$select_host Filter:$filter
      </td><td><small><b>
          <input type=submit name=ACTION value=GO>
   <td align=right>$links</td>
   <tr><td></td>
   </table>";
  
  my($o1, $meta);

  my($out2, $running) = TO::Applet->genAppletData($q, 1); # returns <parms ...
  if ($running) {
     my $ref = $renv->{'test.refresh_rate'} || 60;
     #$meta = "<meta http-equiv=Refresh content=\"$ref;URL=$Http::WEBPROC?GO=GUI::Test::topo\">";
  }

  my $current = $q->{topo};
  my($applet, $parm1, $parm2);
  my $zoom = $q->{zoom}  + 0;

  $applet = System->appletHeader("code=VertexApplet.class codebase=Topo archive=topo21.jar", 6,40);

  $parm1 =<<EOF;
  <param name=url value="GETX=GUI::Graph::topos&topo=$current&FILTER=$q->{FILTER}">
  <param name=urlRefresh value="GET=GUI::Graph::topos&topo=$current">
  <param name=timeRefresh value="10000">
  <param name=circle value="$q->{key}">
  <param name=showLinkHandle value=1>
  <param name=drop1 value="Test |details|g|GO=GUI::Test::get_test&TAB=1&topo=$current">
  <param name=drop2 value="Current Tests|details|gh|GET=GUI::Test::show_tests&topo=$current">
  <param name=drop3 value="List Members|details|has|GET=GUI::Graph::report&topo=$current">
  <param name=drop4 value="DrillDown on|main|hsa|GO=GUI::Test::topo&topo=$current&FILTER=$q->{FILTER}">
  <param name=drop5 value="Report on|details|hg|GET=GUI::Graph::report&topo=$current">
  <param name=drop6 value="Discman on|details||GET=GUI::Graph::details&topo=$current">
  <param name=drop7 value="Alerts|details|hg|GET=GUI::Graph::report&Roption=2&topo=$current">

  <param name=ldrop1 value="Link Test|details||GET=GUI::Test::testlink&topo=$current">
  <param name=ldrop2 value="Display Error|details|h|GET=GUI::Graph::fibrelog&topo=$current">
  <Xparam name=ldrop3 value="Clear Error|t|r,h|GET=GUI::Graph::clearlog&topo=$current">
  <param name=browser value="sun">
EOF

   print $meta .  $header .  $applet .  $parm1 .  $out2 . " </applet> </form>";
  
}
# Exclude following tests from linktest if one node is of the following:
my $LT_EXCLUDE = ",hub,d2,group,";

# Create a list of nodes to exclude from linktest if both nodes
# are the same type.
my $LT_EXCLUDE_END_NODE = ",mcdata,";

sub get_testlink {
  my($q) = @_;
  my (@T, @K, @P);
  my(@node, @PORT, $x);
  my $Config = PDM::ConfigFile->read();
  my $L = Labels->read('GUI::Test')->section('get_test_link');

  if ( my $deny = Roles->verifyRole($q, "test")) {
     print Html->body();
     print $deny;
     return;
  }

  if ($q->{ACTION} !~ /Start/ && $q->{startend}) {
     ($q->{start}, $q->{end}) = split(/\|/, $q->{startend});
  }
  ($T[1], $K[1], $P[1]) = split(/:/, $q->{start});
  ($T[2], $K[2], $P[2]) = split(/:/, $q->{end});

  print Html->body();
  print Html->header2('diagnose.test.link_test');

  if ( index($LT_EXCLUDE, ",$T[1],") >= 0 ||
       index($LT_EXCLUDE, ",$T[2],") >= 0 ) {
       print Html->error($L->{test_not_avail});
       return;
  }

  if ( index($LT_EXCLUDE_END_NODE, ",$T[1],") >= 0 &&
       index($LT_EXCLUDE_END_NODE, ",$T[2],") >= 0 ) {
       print Html->error($L->{test_not_avail_on_nodes});
       return;
  }


  my $to = TO->readTopo($q->{topo});
  ($node[1], $PORT[1]) = $to->nodeByName($q->{start});
  ($node[2], $PORT[2]) = $to->nodeByName($q->{end});
  my $node1Name = $node[1]->name();
  my $node2Name = $node[2]->name();
  my $node1Port = $node[1]->portLabel($PORT[1]);
  my $node2Port = $node[2]->portLabel($PORT[2]);

  my $mto = TO->readTopo("MERGE-MASTER");
  if ($mto) {
    my ($m_n1, $m_port1) = $mto->nodeByName($q->{end});
    if ($m_n1) {
      my $m_ports = $m_n1->port();
      my $m_target = $m_ports->[$m_port1];
      if (substr($m_target,0,6) eq "switch" && $m_target ne $q->{start}) {
         print "<table border=1 cellspacing=0 cellpadding=4 width=95% bgcolor=white>
           <tr><td>
              <b><font color=red>" .
               $L->expand('cannot_run', $m_target) . 
              "</table>";
         return;
      }
    }
  }
  my $list = Scheduler->processList("ST", "*", 'O');
  if ($#$list >= 0) {
        print Html->info($L->{err_interactive}); 
        return;
  }

  if (!$node[1] || !$node[2]) {
     print "<font color=red>" . $L->expand('err_no_id', $q->{start}, $q->{end});
     return;
  }
  my $n_ports = $node[1]->port();
  my $link_select = "<select name=startend>";
  my $dev = $Config->deviceByKey($node[1]->name());
  my $name;
  if ($dev) {
    $name = $dev->{name};
  } else {
    $name = $node[1]->name();
  }
  for ($x=0; $x <= $#$n_ports; $x++) {
      my $p = $n_ports->[$x];
      next if (!$p);
      my $s1 = $node[1]->name() . ":$x|$p";
      my $sel = ($p eq $q->{end})? "selected":"";
      $link_select .= "<option $sel value=\"$s1\">$name:$x</option>\n";
  }
  $link_select .= "</select>";
  my $n1 =  $node[1]->id();
  my $n2 =  $node[2]->id();
  my $xx = index($n1, " "); $n1 = substr($n1,$xx) if ($xx > 0);
  $xx = index($n2, " "); $n2 = substr($n2,$xx) if ($xx > 0);

  my $cache = Cache->read('tests','tests');
  my $email_address = $cache->{DEFAULTS}{'#EMAIL'};
  my $option_email;
  $option_email = "value=" . $email_address if ( $email_address );
  my $verbose = $cache->{DEFAULTS}{'v'};
  my $option_verbose = "checked" if ( $verbose );
  print "<table border=1 cellspacing=0 width=95% bgcolor=white>
           <tr>
           <td colspan=2 bgcolor=#666699>
            <form><input type=hidden name=GO value=GUI::Test::get_testlink>
            <font color=white><b>$L->{l_link}
           <tr><td align=right bgcolor=#CCCCFF>$L->{l_start}: </td><td>$node1Name $node1Port<br>$n1" .
           "<tr><td align=right bgcolor=#CCCCFF>$L->{l_end}: </td><td>$node2Name $node2Port<br>$n2" .
           "<tr><td align=right bgcolor=#CCCCFF>$L->{l_type}: </td>
               <td><select name=PTYPE><option value=user >user</option><option value=critical selected>critical</option><option value=all >all</option></select>
           <tr><td align=right bgcolor=#CCCCFF>$L->{l_user}: </td>
               <td><input type=text size=10 value=0x7e7e7e7e name=PATTERN></td>

           <tr><td colspan=2<b>&nbsp;$L->{l_gen}: </td>
           <tr><td align=right bgcolor=#CCCCFF>$L->{l_verb}: </td>
               <td><input type=checkbox name=VERBOSE $option_verbose></td>
           <tr><td align=right bgcolor=#CCCCFF>$L->{l_email}: </td>
               <td><input type=text name=EMAIL $option_email size=20></td>
           </table>";

  my $renv = $Config->renv();
 
  my (@PARM, $dev1, $dev2, $ip, $fc, $ix);
  my ($warns, $errs);

  my $isl = 0;
  if ($T[1] eq "switch" && $T[2] eq "switch") {
     my $ports = $node[1]->port();
     my $l = "$T[2]:$K[2]";
     foreach my $p (@$ports) {
           if (substr($p, 0 , length($l)) eq $l) {
              $isl++;
           }
     }
  }
  for ($ix = 1; $ix <= 2; $ix++) {
    my $n      = $node[$ix];
    my $class0 = $n->class0();
    if ($T[$ix] eq "host") {
       my $ip     = $n->info("ipno") || substr($n->info("name"),5);
       my $pi     = $n->portInfo();
       my $driver = $pi->[$PORT[$ix]]{DriverName};
       my $path   = $pi->[$PORT[$ix]]{path};
       my $bitMode = $n->info("bitMode");
       $path = substr($path,1) if (substr($path,0,1) eq " ");
       $PARM[$ix] = "driver=$driver|type=hba|ip=$ip|path=$path|monHost=$ip|bitMode=$bitMode|key=$n->{info}{name}";

    } elsif ($class0 eq "switch") {
       $dev1 = $Config->deviceByKey($K[$ix]);
       if (!$dev1) {
         $warns .= "switch:$K[$ix] not in ConfigFile, may not be monitored, ";
       }
       my $ni = $n->{info};
       my $monH = $dev1->{hostIpno} || $n->info("host");
       if ($ni->{sw_remote_fcaddr} && $ni->{sw_remote_fcaddr} ne "0x0" &&
           $dev1->{primary} ) {
          $ip = $ni->{sw_ipAddr_remote}; $fc = $ni->{sw_remote_fcaddr};
       } else {
          $ip = $ni->{sw_ipAddr}; $fc = "";
       }
       my $tt = $n->type();
       $PARM[$ix] = "type=$tt|ip=$ip|monHost=$monH|port=$PORT[$ix]|fcaddr=$fc|WWN=$K[$ix]|name=$dev1->{name}|key=$dev1->{key}";


    } else {
       my $logical;
       my $pi = $node[$ix]->portInfo();
       my $di = $node[$ix]->diskInfo();
       $dev1 = $Config->deviceByKey($K[$ix]);
       if (!$dev1) {
         $warns .= "$T[$ix]:$K[$ix] not in ConfigFile, may not be monitored, ";
       }

       my $po = $PORT[$ix];
       my $po2 = ($po == 0)? 1:0;
       my $monH = $pi->[$po]{dataHost};
       if (!$monH) {
          if ($n->info("host_type") eq "ib") {
             $monH = $n->info("host");
          } elsif ($n->info("host2_type") eq "ib") {
             $monH = $n->info("host2");
          } else {
             $errs .= "<tr><td nowrap><small>-Cannot find InBand host to test " . $n->name() . "</td>";
          }
       }
       my $name = $dev1->{name};
       if ($T[$ix] eq "a5k") {
         for ($x=0; $x <= 10; $x++ ) {
           $logical = $di->{"f$x"}{LogicalPath} ;
           last if ($logical);
           $logical = $di->{"r$x"}{LogicalPath} ;
           last if ($logical);
         }
       } else {
         $logical = $pi->[$po]{LogicalPath} || $pi->[$po2]{LogicalPath};
         if ($logical ne $pi->[$po]{LogicalPath}) {
            $warns .= "No LogicalPath available on " . $n->name() . " port:" . ($po+1) ;
         }
       }
       if (!$logical) {
         $errs .= "<tr><td nowrap><small>-No LogicalPath for Port:$PORT[$ix] of ". $n->name(). "</td>";
       }
       my $ctrl = "|ctrl_model=$dev1->{ctrl_model}" if ($dev1->{ctrl_model});
       $PARM[$ix] = "type=$T[$ix]|port=$po|logical=$logical|ip=$dev1->{ipno}$ctrl|monHost=$monH|portWWN=1|name=$name|key=$dev1->{key}";
        
    }
  }
  my ($com1, $opts);
  if (0) { # $errs
    print "<table border=1 cellspacing=0 cellpadding=0><tr><td><table border=0 cellspacing=0 cellpadding=1 bgcolor=white width=100%>".
          "<tr><td><b>Warning(s):</b>$errs</table></table>";
  }
  if (!$PARM[1] || !$PARM[2]) {
    print "<table border=1 cellspacing=0 bgcolor=white width=95%>".
          "<tr><td><font color=red><b>Warnings:<br>Incomplete link</table>";
  } else {
    my $test_command = "linktest -a $PARM[1] -b $PARM[2]";
    $opts = ($q->{VERBOSE})? "-v ": "";
    $opts .= ($q->{STRESS})? "-s " : "";
    $opts .= ($q->{PTYPE})  ? "-T \"$q->{PTYPE}\" " : "";
    $opts .= ($q->{PATTERN})? "-p \"$q->{PATTERN}\" " : "";
    $opts .= ($isl)? "-I $isl " : "";

    rename "/tmp/last_linktest_command.1" , "/tmp/last_linktest_command.2";
    rename "/tmp/last_linktest_command" , "/tmp/last_linktest_command.1";
    open(O, ">/tmp/last_linktest_command");
    print O "linktest $opts -a \"$PARM[1]\" -b \"$PARM[2]\" \n";
    close(O);

    if ($q->{ACTION} =~ /Start/) {
      my($err,$pid) = Scheduler->run('ST', $renv->{hostname}, "linktest",
                       "$opts -a \"$PARM[1]\" -b \"$PARM[2]\"", "",0, 1, $q->{EMAIL}, 1, 
                { 
                  ports    => "",
                  target   => $q->{start},
                  target2  => $q->{end},
                  dev_type => $T[1],
                  node     => $q->{start},
                  key      => $q->{start},
                  comp     => "",
                }, 10);
      if ($err) {
        print "<font color=red><b>Error on linktest: $err</b></font>";
      } else {
        print "&nbsp;<br><b>linktest (pid=$pid) started on " . 
                Util->shortHostname($renv->{hostname}) . "</b></small>";
        print &pop_list($pid);
      }
      return;

    } else {
      $com1 = $test_command; $com1 =~ s/\|/| /g;
      $com1 =~ s/\-([ab])/<br>-<b>$1<\/b>/g;
      print "<input type=hidden name=start value=\"$q->{start}\">
             <input type=hidden name=end value=\"$q->{end}\">
             <input type=hidden name=topo value=\"$q->{topo}\">
             <b><input type=submit name=ACTION value=\"Start LinkTest\">&nbsp;</b><p>";
    }
  }
  print "<table border=1 cellspacing=0 width=95% bgcolor=white>
           <tr><td colspan=2 bgcolor=#CCCCFF><b>Test other Links from " . 
                $node[1]->name() . ":</td>
           <tr><td nowrap> $link_select &nbsp;<b><input type=submit name=ACTION value=GO>
         </table></form>";

  print "&nbsp;<br>&nbsp;<br><hr></center><font color=red>Warning: $warns</font>" if ($warns);
  #print "</center><br>Debug: last command(s) in /tmp/last_linktest_command";
}


sub from_list {
  my($q) = @_;

  my $h = Html->header2("diagnose.test.list_test", "96%");
  my $renv = System->get_renv();
  my $ruser = System->get_ruser();
  my $window = $ruser->{window} || $renv->{window};
  my $L = Labels->read('GUI::Test')->section('from_list');

  print "\n
<head>
<script>
  function openwindow(a) {
      var b = '$Http::WEBPROC?GO=GUI::Test::details&' + a;
      var O = window.open(b,'hist','menubar=no,resizable=yes,scrollbars=yes,width=400,height=500');
      O.focus();
  }
</script>
</head>
<body bgcolor=#E0E0E0>
<center>$h";

  my($selected0,$head)= GUI->test_head($q);
  my($select_host, $filter, $selected) = GUI->topoPage($q);

  my $filter1 = "<select name=filter1><option value=\"\">All";
  foreach my $f ('host','a5k','t3','switch') {
     my $sel = ($f eq $q->{filter1}) ? "selected":"";
     $filter1 .= "<option $sel>$f";
  }
  $filter1 .= "</select>";

  print "
     <table border=0><tr><td></table>
     <table border=0 cellspacing=0 cellpadding=0 width=96% bgcolor=white>
       <tr><td nowrap bgcolor=#666699><form><font color=white>
       <input type=hidden name=GO value=GUI::Test::from_list>
        <b>&nbsp;$L->{host}: $select_host &nbsp;
        $L->{filter}: $filter1 &nbsp; 
        <input type=submit name=ACTION value=GO>&nbsp;</td>
     </table>
     <table border=0><tr><td></table>";
  
  my $to = TO->readTopo($selected);
  if (!$to) {
     print "<b><center>" . $L->expand('err_no_topo', $selected);
     return;
  }

  my $hosts = $to->hostList();
  my $switches = $to->switchList();
  my $storages = $to->storageList();
  my($err,$af) = AutoForm->new("System/Tests", {noInfo => 1});

  my(@L, $x);
  my $State = State->read();
  my $links = $State->links();
  my $comps = $State->components();
  my $filter2 = $q->{filter2};

  if (!$q->{SORT}) {
     $q->{SORT} = 1;
     $q->{SIGN} = 1;
  }
  my $target= "target=details";
  my $from;
  if ($window ne "B") {
    $target =  "";
    $from = "&FROM_LIST=1";
  }

  foreach my $host (@$hosts) {
     last if ($q->{filter1} && $q->{filter1} ne "host");
     my $hbas = $host->{portInfo};
     my $hn = $host->boxName();
     next if ($filter2 && substr($hn,0,length($filter2)) ne $filter2);

     if (exists($host->{diskInfo})) {
         my $hname = Util->shortHostname($hn);
         my $url = "<a href=$Http::WEBPROC?GO=GUI::Test::get_test$from&option=1&TAB=1&topo=$selected&enc=".
                     $host->name() . ":e $target>FC-Disk</a> ";  # h$x
         push(@L, ["host:$hname", "Internal Disk Test" , "", $url]);
     }
     for ($x=0; $x <= $#$hbas; $x++) {
         my $hba = $hbas->[$x];
	 #fix for bug 4620277
	 #we want to test even if no storage attached
         #next if ($hba->{al_pa} == -1);
         my($t, $hname) = split(/\:/, $host->{name});

         my $tests = Tasks->ST_getTestList($af, "host", $host, "p$x");
         my $htest = $tests->[0];
         next if (!$htest);
         $htest = $htest->name();
         my $url = "<a href=$Http::WEBPROC?GO=GUI::Test::get_test$from&TAB=1&testName=$htest&topo=$selected&enc=".
                     $host->name() . ":h$x $target>$htest</a> ";  # h$x
         
         $hname = Util->shortHostname($hn);
         my $status = &getLinkStatus($target, $links, $host->name() . ":$x") || [undef,'&nbsp;'];
         my $enc = "<a href=$Http::WEBPROC?GO=GUI::Graph::get_report&enc=$host->{info}{name}:e&topo=$selected $target>host:$hname</a>";

         push(@L, [$enc, "hba$x / $hba->{RegisterName}" , $status->[1], $url]);
     }
  }

  foreach my $sw (@$switches) {
     my $ports = $sw->{portInfo};
     last if ($q->{filter1} && $q->{filter1} ne "switch");
     my $sname = $sw->boxName();
     next if ($filter2 && substr($sname,0,length($filter2)) ne $filter2);

     my(@L2, $error, $goodport, $goodurl, $goodn);
     my $sw_name = $sw->type() . ":" . ($sw->{info}{BoxName} || $sw->ipAddr());
     my $enc = "<a href=$Http::WEBPROC?GO=GUI::Graph::get_report&enc=$sw->{info}{name}:e&topo=$selected $target>$sw_name</a>";

     for ($x=0; $x <= $#$ports; $x++) {
         my $port = $ports->[$x];
         next if (!$port);
         my $tests = Tasks->ST_getTestList($af, $sw->type(), $sw, "p$x");
         my $htest = $tests->[0];
         my $url;
         if ($htest) {
           $htest = $htest->name();
           $url = "<a href=$Http::WEBPROC?GO=GUI::Test::get_test$from&TAB=1&testName=$htest&topo=$selected&enc=".
                     $sw->name() . ":p$x $target>$htest</a>";
         }
         if (!$goodport) {
           $goodport = $x;
           $goodurl = "<a href=$Http::WEBPROC?GO=GUI::Test::get_test$from&TAB=1&topo=$selected".
                    "&enc=".  $sw->name() . ":e $target>".
                    ucfirst($sw->type()) . "-Test(s)</a>";
         }

         my $status = &getCompStatus($target, $comps, $sw->name(), $sw->getPortId($x)) ||
                        &getLinkStatus($target, $links, $sw->name() . ":$x") || [undef, '&nbsp;'];
         if ($status->[1] && $status->[1] ne "&nbsp;") {
           $error++;
           push(@L, [$enc, "port$x", $status->[1], $url]);
         }
     }
     if (!$error && $goodport) {
           push(@L, [$enc, "All Ports", "", $goodurl]);
     }
  }

  foreach my $st (@$storages) {
     my $ports = $st->{portInfo};
     next if ($q->{filter1} && $q->{filter1} ne $st->type());
     my $sname = $st->boxName();
     my $enc = "<a href=$Http::WEBPROC?GO=GUI::Graph::get_report&enc=$st->{info}{name}:e&topo=$selected $target>". $st->type() . ":$sname</a>";
     
     next if ($filter2 && substr($sname,0,length($filter2)) ne $filter2);

# PORTS, one port per line

     for ($x=0; $x <= $#$ports; $x++) {
         next if ($st->type() =~ /T3/i); #no port Tests for T3's
         my $port = $ports->[$x];
         next if (!$port);
         my $short = "s" . ($x+1);
         my $tests = Tasks->ST_getTestList($af, $st->type(), $st, $short);
         my $htest = $tests->[0];
         next if (!$htest);
         my $cname = "port.$x";
         $htest = $htest->name();
         my $url = "<a href=$Http::WEBPROC?GO=GUI::Test::get_test$from&TAB=1&testName=$htest&topo=$selected&enc=".
                     $st->name() . ":$short $target>$htest</a>";
         #my $url2 = "<a href=$Http::WEBPROC?GO=GUI::Test::get_expert&testName=stexpert&topo=$selected&enc=".
         #            $st->name() . ":d $target>StExpert</a>";

         my $status = &getCompStatus($target, $comps, $st->name(), $st->getPortId($x) ) ||
                      &getLinkStatus($target,$links, $st->name() . ":" . ($x+1)) || [undef, '&nbsp;'];

         push(@L, [$enc, "port$x", $status->[1], "$url&nbsp;"]);
                    # $status->[1], "$url&nbsp;|&nbsp;$url2"]);
     }

# VOLUMES , one volume per line

     my $vols = $st->volInfo();
     my $v_cnt = 1;
     foreach my $v (sort keys %$vols) {
         my $port = $vols->{$v};

         my $short = "v$v_cnt"; 
         my $tests = Tasks->ST_getTestList($af, $st->type(), $st, $short);
         my $htest = $tests->[0];
         next if (!$htest);
         my $cname = "port.$x";
         $htest = $htest->name();
         my $url = "<a href=$Http::WEBPROC?GO=GUI::Test::get_test$from&TAB=1&testName=$htest&topo=$selected&enc=".
                     $st->name() . ":$short $target>$htest</a>";

         my $status = [undef, "&nbsp"];
         if ($v_cnt < 5) {
            my $u1 = ($v_cnt > 2) ? 2:1;
            my $v1 = ($v_cnt % 2) + 1;
            $status = &getCompStatus($target, $comps, $st->name(), "volume\..*", 1) || [undef, '&nbsp;'];
         }
         my $v0 = $v; $v0 =~ s/\/dev\/rdsk\///;
         my $ll = length($v0)/2;
         $v0 = substr($v0,0,$ll) . " &nbsp;" . substr($v0,$ll+1) if ($ll > 10);
         push(@L, [$enc, "lpath <small>$v0", $status->[1], "$url&nbsp;"]);
                    # $status->[1], "$url&nbsp;|&nbsp;$url2"]);
         $v_cnt++;
     }

#  DISKS/OOB , all in one line

     foreach my $el ('d=All Disks','oob=OutOfBand') {
        my($el1,$el_name) = split(/\=/, $el);
        my $tests = Tasks->ST_getTestList($af, $st->type(), $st, $el1);
        if ($#$tests >= 0) {
          my($x, $url, $list);
          for ($x=0; $x <= $#$tests; $x++) {
            my $htest = $tests->[$x];
            if ($htest) {
               $list .= ", " if ($list);
               my $n1 = $htest->name();
               $list .= " <a href=$Http::WEBPROC?GO=GUI::Test::get_test$from&TAB=1&testName=$n1&topo=$selected&enc="
                    . $st->name() . ":$el1 $target>$n1</a>";
            }
          }
          if ($list) {
             my $status =  &getDiskStatus($target, $comps, $st) if ($el1 eq 'd');
             push(@L, [$enc, $el_name, $status->[1], $list]);
          }
        }
     }
  }
 
  my($pageInfo, $list) = Html::List->makeList($q,
                        \@L,
                    [$L->{system}, $L->{comp},$L->{status},$L->{run}],
                    [  'l',       'l',     'l',    'l'   ],
                    [  '+sn',   undef,    '-'    ],
                       {pageSize => 20});
   my $out .= "
  <table border=1 cellspacing=0 cellpadding=0 width=96% bgcolor=white>
    $list
  </table>
  <table border=0><tr><td></table>
  <table border=0 width=95%>
    <tr><td>$pageInfo</td>
        <td align=right>
  </table>
  ";
  print $out;


}

sub details {
  my($q) = @_;
  my $State = State->read();
  print Html->body();
  print Html->header2('diagnose.test.list_test', undef, 'Error', undef, {noTabs => 1, noCrumb => 1});
  print "<table border=0><tr><td></table>";
  my ($f1, $f2);
  if ($q->{link}) {
    my $links = $State->links();
    return if (!$links);
    my $link = $links->{$q->{link}};
    $f1 = "&nbsp;<img src=/gif/state_2.gif> LinkError&nbsp;";
    $f2 = $link->[1];

  } elsif ($q->{comp}) {
    my $comps = $State->components();
    return if (!$comps);
    my $comp = $comps->{$q->{comp}};
    my($gif,$t);
    if ($comp->[0] == 2) {
       $gif = "state_2.gif";
       $t = "ComponentError:";
    } else {
       $gif = "state_1.gif";
       $t = "ComponentWarning:";
    }
    $f1 = "&nbsp;<img src=/gif/$gif>&nbsp;$t ";
    $f2 = $comp->[1];
  }
  print "<table border=1 cellpadding=2 cellspacing=0 width=90% bgcolor=white>
   <tr><td bgcolor=navy><font color=white><b>Alert Status</td>
   <tr><td>$f1</td><tr><td>$f2</table>";

}

sub getLinkStatus {
  my($target, $links, $port) = @_;
  $target = "";
  foreach my $l (keys %$links) {
     my($l1, $l2) = split(/\|/, $l);
     if ($l1 eq $port || $l2 eq $port) {
        my $c = $links->{$l};
        if ($c->[0]) { # severity != 0
           return [$c->[1],"<a href=\"javascript:openwindow('link=$l')\" $target><img src=/gif/state_2.gif alt=\"SAN Link, click for details\" border=0>&nbsp;link</a>"];
        }
     }
  }
  return undef;
}

sub getDiskStatus {
  my($target, $comps, $st) = @_;
  $target = "";

  my $l = $st->getDiskList();
  my $name = $st->name();

  foreach my $d (@$l) {
     my $c = $comps->{"$name:$d"};
     if ($c->[0]) {
        my $gif = ($c->[0] == 2) ? "state_2.gif": "state_1.gif";
        return [$c->[1],
          "<a href=\"javascript:openwindow('comp=$name:$d')\" $target><img src=/gif/$gif alt=\"Disk Error/Warn, click for details\" border=0>&nbsp;comp"];
     } 
  } 
  return undef;
}


sub getCompStatus {
  my($target, $comps, $name, $port, $re) = @_;
  $target = "";
  if ($re) {
     foreach my $c (keys %$comps) {
         my $val = $comps->{$c};
         next if ($val->[0] <= 0);
         my($type, $n1, $n2) = split(/\:/, $c, 3);
         if ("$type:$n1" eq $name && $n2 =~ /^$port/) {
            $port = $n2;
            last;
         }
     }
  }

  my $c = $comps->{"$name:$port"};
  return undef if (!$c);
  if ($c->[0]) {
     my $gif = ($c->[0] == 2) ? "state_2.gif": "state_1.gif";
     return [$c->[1],
      "<a href=\"javascript:openwindow('comp=$name:$port')\" $target><img src=/gif/$gif alt=\"Component Error/Warn, click for details.\" border=0>&nbsp;comp"];
  } 
  $c = $comps->{"$name:e"};
  return undef if (!$c);
  if ($c->[0]) {
     my $gif = ($c->[0] == 2) ? "state_2.gif": "state_1.gif";
     return [$c->[1],
    "<a href=\"javascript:openwindow('comp=$name:e')\" $target><img src=/gif/$gif alt=\"Component Error/Warn, click for details.\" border=0>&nbsp;enc"];
  } 
  
  return undef;
}


# display recent tests tests
#
sub get_show_tests {
  my($q) = @_;
  my($type, $name, $comp)  = split(/\:/, $q->{enc});
  print "\n<body bgcolor=#E0E0E0><center>";
  my $h = Html->header("Test List","97%","","test_defaults");
  print $h;

  my $Tests = Scheduler->processMap('ST');

  my $tests = $Tests->{"$type:$name"};
  if (!$tests) {
     print "<center>&nbsp;<br><b><font color=blue>No test found for $type:$name ";
     return;
  } 
  print "<table border=1 cellspacing=0 cellpadding=1 width=100% bgcolor=white>
  <tr><td colspan=4 bgcolor=#666699><b><font color=white>$type:$name</td>
  <tr bgcolor=#CCCCFF><td><b>Host<td><b>Process<td><b>Status
      <td><b>Start / End</td>";
  my $tc;
  foreach my $t (reverse @$tests) {
     last if ($tc++ > 20);
     my $host = Util->shortHostname($t->{host});
     print "<tr bgcolor=#F0F0D0>
     <td>&nbsp;$host</td>
     <td>&nbsp;$t->{pid} $t->{command}</td>
     <td>&nbsp;" . $t->statusText() . "</td>
     <td><small>&nbsp;$t->{start_date}<br>&nbsp;$t->{end_date}";

     my ($info, $pro, $out, $err) = Scheduler->read('ST', $t->{host}, $t->{pid});
     my $cnt = 0;
     print "<tr><td colspan=4><small>" . GUI::ProcMgr::_display1($out, \$cnt) . "</td>";
  }
  print "</table>";
    

}

#pid | command | arg | host | start | end | err


#  returns (error, data);

sub validation {
  my($command, $selected_test, $to, $dev, $q, $type, $header, $quiet) = @_;
  my($pre_err, $pre_data);
  my $module  = $command->info("validation_module");
  my $found = 0;
  if ($module) {
    $module = "Tests::$module";
    my $err = Modules->loadOne($module);
    if ($err) {
     print "<font color=red>Error loading $selected_test: $err";
     return ($err, undef);
    }
    foreach my $c ("${selected_test}_$type", $type) {
      if ( $module->can($c)) {
        ($pre_err, $pre_data) = $module->$c($command, $to, $dev, $q); 
        if ($pre_err && !$quiet) {
          print "<table border=0><tr><td></table>
            <table border=0 cellspacing=1 cellpadding=1 width=95% bgcolor=white>
            <tr><td bgcolor=#FFC0C0><b>$header
            <tr><td>$pre_err</b></table>";
        } 
        return ($pre_err, $pre_data);
      }
    } 
  }
  $module = "Tests::General";
  my $err = Modules->loadOne($module);
  if (!$err) {
     my $c = $type;
     if ( $module->can($c)) {
       ($pre_err, $pre_data) = $module->$c($command, $to, $dev); 
       if ($pre_err && !$quiet) {
          print "<table border=0><tr><td></table>
           <table border=0 cellspacing=1 cellpadding=1 width=95% bgcolor=white>
           <tr><td bgcolor=#FFC0C0><b>$header
           <tr><td>$pre_err</b></table>";
       }
       return ($pre_err, $pre_data);
     }
  }

  return (undef,undef);
}

sub pop_list {
  my($pid) = @_;
  return "<script>
   function win1(a) {
     var b = '$Http::WEBPROC?GO=GUI::ProcMgr::list&MODE=O&PLIST=$pid&WIN=1';
     var O = window.open(b, 'test_mon',
            'menubar=no,resizable=yes,scrollbars=yes,width=500,height=650');
     O.focus();
   } 
   win1(); 
  </script> ";
}

sub getVolInfo {
  my($Hdev) = @_;
  my ($reg_select, $all);
  my $vols = $Hdev->volInfo();
  my $cn = 0;
  my $pcnt= 1;
  foreach my $logical (sort keys %$vols) {
    my $pi = $vols->{$logical};
    my $v = "port$pcnt:$logical";
    my $log = $logical;
    $log =~ s/\/dev\/rdsk\///;
    my $v2 = $log . ":" . $pi->{PortMode};
    $reg_select .= "<option value=\"$v\">$v2</option>\n";
    $cn++; $pcnt++;
    $all .= "$v\t";
  }
  return ($all, $reg_select, $cn);
}

sub select_devs {
  my($Hdev) = @_;
  my ($reg_select, $all, $cn);
  my $disks = $Hdev->diskInfo();
  my($d,@D);
  foreach $d (sort keys %$disks) {
     push(@D, "$disks->{$d}{devID}=$d");
  }
  foreach $d (sort @D) {
     my($a1,$a2) = split(/\=/, $d);
     my $reg = $disks->{$a2}{RegisterName};
     my $logical_group = $disks->{$a2}{LGroup};
     my @L2 = split(/\|/, $disks->{$a2}{LogicalPath});
     foreach my $log (@L2) {
       my $v = "$a1:$log";
       my $ix = rindex($log, "/");
       my $v1 ;
       if ( $logical_group =~ /Internal/ ) {
           $v1 = substr($log, $ix+1);
       } else {
           $v1 = "$a2 " . substr($log, $ix+1);
       }
       $reg_select .= "<option value=\"$v\">$v1</option>\n"; $cn++;
       $all .= "$v\t";
     }
  }
  return ($reg_select, $all, $cn);
}

sub get_test {
  my($q) = @_;
  my $h0 = "<a href=$Http::WEBPROC?GO=GUI::Test::from_list>Test from List</a>&nbsp;&nbsp;> " if ($q->{FROM_LIST});
  print "\n<body bgcolor=#E0E0E0><center>";
  print Html->header2("diagnose.test.start_test", "95%");
  &get_test0($q);
}

# $q->{topo} = diag176.central.sun.com,
# $q->{enc}  = switch:100000c0dd008467:e
# display form to start test.

sub get_test0 {
  my($q, $post) = @_;

  my($s, $a, $af, $err, $upd, $updG);
#  foreach $a (keys %$q) { $s .= "$a=$q->{$a}, "}
#  print $s;
   my $LB = Labels->read("GUI::Test")->section("get_test");

  my $D = System->get_home() . "/lib/Test";
  my $deny = Roles->verifyRole($q, "test");

  my($type, $key, $comp) = split(/\:/, $q->{enc});
  my ($have_options);
  my $to = TO->readTopo($q->{topo});
  my($p);
  my $dev = $to->nodeByName("$type:$key");
  my $mgmtLevel = $dev->info("mgmtLevel");
  if (!$dev) {
    print "<font color=red>Error :Cannot find device $type:$key</font>";
    return;
  }
  my $class0 = $dev->class0();

  my $id = $dev->id();
  my $info = $dev->info();
  my $ports = $dev->portInfo();
  my $hp;
  if ($type eq "host") {
     $hp = $ports->[substr($comp,1)];
  }

  ($err,$af) = AutoForm->new("System/Tests", {noInfo => 1});

  my(@L, @T, $selected_test);

  if ($q->{EXPERT}) {
    $selected_test = 'stexpert';
  } else {
    my $cnt = 1;
    my $tests = Tasks->ST_getTestList($af, $type, $dev,$comp);
    if ($#$tests == -1) {
      $comp = 'e';
      $tests = Tasks->ST_getTestList($af, $type, $dev, $comp);
    }
    if ($#$tests < 0) {
        print "<br>";
        if ($type eq "se" && $mgmtLevel eq "D") {
          my $pdesc = Util->abb($dev->type() . ".medium");
          print Html->warning($LB->expand('no_test_avail',$id) . 
             "<br><a href=http://" . $dev->info("ipAddr") . ":7654 target=win2>" . 
             "Click here to access this $pdesc  directly!</a>", 0, {width => "95%"} );
        } else {
          print Html->warning($LB->expand('no_test_avail',$id)); 
        }
        return;
    }
    my ($ss, @DESC);
    foreach my $t (@$tests) {
         my $tn = $t->name();
         $DESC[$cnt] = $t->{info}{title};
         $q->{option} = $cnt if ($tn eq $q->{testName} && !$q->{option});
         push(@L, "$cnt=$tn");
         $ss .= "$cnt=$tn|";
         $T[$cnt] = $t->sectionName();
         $cnt++;
    }
    $q->{option} = 1 if (!$q->{option});
    my $tab1;
    if ($q->{TAB}) {
      $tab1 = Html->makeSelect("option", $ss, $q->{option}, {head => 'onchange=form.submit()'});
      my $tab = Html::Tabs->create(list  =>  \@L,
                         url  => "$Http::WEBPROC?GO=GUI::Test::get_test&FROM_LIST=$q->{FROM_LIST}&TAB=1&enc=$q->{enc}&topo=$q->{topo}",
                       width  => "95%",
               selectedColor  => "white",
           selectedTextColor  => "blue",
             backgroundColor  => $main::LIGHT,
          backgroundTextColor => 'black',
                    selection => $q->{option}
                 );
      print "<table border=0><tr><td></table>" . $tab;
    } else {
      $tab1 =  $T[$q->{option}];
    }
    #print "<table border=1 cellspacing=0 cellpadding=0 width=95% bgcolor=white>
    # <tr><form><td  width=40% bgcolor=#CCCCFF colspan=3><center>
    #     <input type=hidden name=GO value=GUI::Test::get_test>
    #     <input type=hidden name=FROM_LIST value=\"$q->{FROM_LIST}\">
    #     <input type=hidden name=TAB  value=$q->{TAB}>
    #     <input type=hidden name=enc  value=\"$q->{enc}\">
    #     <input type=hidden name=topo value=\"$q->{topo}\">
    #    <b>" . Util->abb("$type.medium")  ."Test(s) :<br><b>$tab1 
    #     </td></form></table>
    #";
    $selected_test = $T[$q->{option}];
  }

  my $cache = Cache->read('tests', 'tests');
  $cache = {} if (!defined($cache));
  my($pre_err, $pre_data);

#########
  my $c2 = $af->commandByName($selected_test);
  my $c2_info = $c2->info();
  my ($s1, $s2, $first_host);

  my $Hdev = $dev;
  if ($q->{host}) {
    if ($q->{host} ne $q->{topo}) {
       my $to2 = TO->readExistingTopo($q->{host});
       $Hdev = $to2->nodeByName("$type:$key") if ($to2);
    }
  } else {
    ($s1, $s2, $first_host) = &find_host($info, $c2_info);
    if ($first_host && $first_host ne $q->{topo}) {
      my $to2 = TO->readExistingTopo($first_host);
      $Hdev = $to2->nodeByName("$type:$key") if ($to2);
    }
  }
#########


  if ($q->{ACTION} eq "Start Test" || $q->{ACTION} =~ /Display Command/) {
   $have_options = 1;
   while (1) {
     my $af_test = $af->commandByName($selected_test);
     if (!$q->{register} && $af_test->info('node') ne "oob" ) {
        print "<font color=red><b>No Device Selected, try again!</b></font>";
        last;
     }
     my $host = $q->{host} || $first_host;
     my $enc  = $q->{enc};
     my $email = $af->getOption("#EMAIL", $q);
     my $concurrent = $af_test->info("concurrent") if ($af_test);

     my $tmp;
     ($pre_err, $tmp) = &validation($af_test, $selected_test, $to, $dev, $q, "postForm", "Test cannot start");
     $tmp=undef;
     # call the pre_form to get the appropriate pre_data
     #fix for bug 4532928
     ($tmp, $pre_data) = &validation($af_test, $selected_test,  
                          $to, $dev, $q, "preForm", "Warning", $pre_err);

     last if ($pre_err);

     my($err, $test_command, $opts, $opts_o) = $af->makeCommand($selected_test, $q, 1);
     if ($q->{register} =~ /\[ALL\]/) {
        $q->{register} = "";
        foreach my $x (sort keys %$q) {
          if (substr($x,0,13) eq "all_registers") {
             $q->{register} .= $q->{$x};
          }
        }
     }

     my $passes = $af->getOption("#PASSES", $q);
     if($passes eq undef){
       $passes = 1;
     }
        

     my @L = split(/\t/, $q->{register});
     my($ports, $registers);

     foreach my $l (@L) {
        my($port, $reg) = split(/\:/, $l,2);
        $ports     .= "$port\t";
        $registers .= "$reg\t";
     }
     chop($registers) if ($registers);
     chop($ports)     if ($ports);
     if ($q->{ACTION} =~ /Command/) {
         my $o = $opts_o;
         $o =~ s/passwd=[^\s\=\|]+//;
         $o =~ s/\|/| /g;
         $o = "-o dev=" . $registers . "|" . substr($o,2);
         print "&nbsp;<p>$host: $test_command $opts $o<br>";
         return;
     }
     my($err, $pid);
     ($err,$pid) = Scheduler->run('ST', $host, $test_command, "$opts $opts_o", 
                 $registers, $concurrent, 0, $email, $passes, 
                { 
                  ports    => $ports,
                  target    => $dev->boxName(),
                  dev_type => $type,
                  node     => $q->{node},
                  key      => $key,
                  comp     => $comp,
                }, 10);

     if ($err) {
       print "<font color=red><b>Error on $test_command: $err</b></font>";
     } else {
       print "<small>$test_command $opts<br><b>Test# $pid started on " . 
               Util->shortHostname($host) . "</b></small>";
       print &pop_list($pid);
     }
     last;
   }
  }

  my $command = $af->commandByName($selected_test);
  my $warning = $command->info("warning");

  if (!$q->{ACTION}) {
     ($pre_err, $pre_data) = &validation($command, $selected_test,  $to, $dev, $q, "preForm", "Warning");
  } else {
     $pre_data = $q;
  }

  ($err, $upd) = $af->updateForm($selected_test, {xheader => "", debug => 0}, $cache, $pre_data);
  print $err if ($err);

  my $product = $info->{VendorID} ." ". $info->{ProductID};
  my $sw_wwn = $info->{sw_WWN};
                   #<option value=\"\">[Select Device]</option>";
  my $reg_select;

#           ($info->{fruType} eq 
#             substr($hp->{RegisterName},0,length($info->{fruType})) )) {


  my $fru_type = $c2_info->{fruType};
  my $cn = 0;
  my($node);
  my($all, $first);
  my $multiple = "multiple";
  if ($type eq "host") {
     if ($c2_info->{node} eq 'd') {  # device-disk
        $node = "disk";
        ($reg_select, $all, $cn) = &select_devs($Hdev);
     } else {
       $node = "hba";
       for ($p=0; $p <= $#$ports; $p++) {
          my $pi = $ports->[$p];
          next if ($fru_type ne substr($pi->{RegisterName},0,length($fru_type))) ;
          if ($comp eq "e" || substr($comp,0,1) eq "h" ) {
             my $r = $pi->{RegisterName};
             my $path = Util->ltrim($pi->{path});
             my($board, $slot, $port) = split(/\:/, $pi->{BoardSlotPort});
             my $extra = "Board$board, Slot$slot, Port$port" if ($board);
             my $v = "$extra $r ($p)";
             my $o = "$p:$path";
             if (substr($comp, 1) eq $p) {
                $first = "<option selected value=\"$o\">$v</option>\n";
             } else {
                $reg_select .= "<option value=\"$o\">$v</option>\n"; 
             }
             $cn++;
             $all .= "$o\t";
          }
       }
       $reg_select = $first . $reg_select;
     }

   } elsif ($c2_info->{node} eq "oob") {       # oob test, use IP
     $reg_select = " ";
     $cn = -1;

   } elsif ($class0 eq "switch") {  # switch or vicom
     $node = "port";
     if ($c2_info->{node} eq 'v') {       # volumes
         $node = "port";
         ($all, $reg_select, $cn) = &getVolInfo($Hdev);
     } else {
       for ($p=0; $p <= $#$ports; $p++) {
          my $pi = $ports->[$p];
          next if (!$pi->{sw_PortType});
          if ($comp eq "e" || substr($comp,0,1) eq "p") {
            my $v = "port$p / $pi->{sw_PortType}";
            my $fc = $pi->{sw_remote_fcaddr} || $dev->info("sw_remote_fcaddr");
            my $ip = $pi->{sw_ipAddr_remote} || $dev->info("sw_ipAddr_remote");
            my $o = "port$p:$p:$ip:$fc";
            if (substr($comp, 1) eq $p) {
              $first = "<option selected value=\"$o\">$v</option>\n";
            } else {
              $reg_select .= "<option value=\"$o\">$v</option>\n"; 
            }
            $cn++;
            $all .= "$o\t";
          }
       }
       $reg_select = $first . $reg_select;
     }
     
   } else { # storage
      if ($c2_info->{node} eq 'v') {       # volumes
         $node = "port";
         ($all, $reg_select, $cn) = &getVolInfo($Hdev);

      } elsif ($c2_info->{node} eq 's') {       # device-port
        $node = "port";
        my $ports = $Hdev->portInfo();
        for ($p=0; $p <= $#$ports; $p++) {
          my $pi = $ports->[$p];
          my $p0 = $p+1;
          if ($comp eq "e" || substr($comp,0,1) eq "s") { #  eq "s$p0") {
            next if (!$pi->{LogicalPath});
            my @L2 = split(/\|/, $pi->{LogicalPath});
            foreach my $log (@L2) {
              my $v = "port$p:$log";
              my $ix = rindex($log, "/");
              my $v2 = $Hdev->portLabel($p) . " (p$p) " . substr($log, $ix+1);
              if (substr($comp, 1) eq $p+1) {
                $first .= "<option selected value=\"$v\">$v2</option>\n";
              } else {
                $reg_select .= "<option value=\"$v\">$v2</option>\n";
              }
              $cn++;
              $all .= "$v\t";
            }
          }
        }
        $reg_select = $first . $reg_select;

     } elsif ($c2_info->{node} eq 'd') {  # device-disk
        $node = "disk";
        ($reg_select, $all, $cn) = &select_devs($Hdev);
     }
  }
  chop($all) if (substr($all,-1) eq "\t");
  my $len = length($all);
  my $all_reg = "";
  my $all_cnt=1;
  my $MAX = 300;
  while (($all_cnt-1) * $MAX < $len) {
    my $sub = substr($all, ($all_cnt-1) * $MAX, $MAX);
    $all_reg .= "<input type=hidden name=all_registers" . sprintf("%3.3d",$all_cnt) . " value=\"$sub\">\n";
    $all_cnt++;
  }
#print "$all_cnt, $all_reg<br>"; 
  my $submit = 1;
  if ($reg_select) {
    my($size) = $cn;
    $size = 3 if ($size > 3);
    if ($size == 1) {
      $reg_select = "<td align=right bgcolor=#CCCCFF>Select :<td>&nbsp;<select name=register>$reg_select</select>";
    } elsif ($q->{EXPERT}) {
       $reg_select = "<td colspan=2><b>Select :&nbsp;</b><select name=register size=$size>$reg_select</select>";
    } elsif ($size >= 0) {
       $reg_select = "<td align=right bgcolor=#CCCCFF>Select :<td>&nbsp;<select name=register $multiple size=$size>$reg_select<option value=\"[ALL]\">[All Devices]</select>";
    }
  } else {
    $reg_select = "<td colspan=2><center><table border=0 cellpadding=4><tr><td>
    <font color=red><b>No Port/Path available!</table>";
    $submit = 0;
  }
  my ($header);
  if ($class0 eq "switch") {
    my ($sel_host, $sel_cnt) = &find_host($info, $c2_info);
    my $selected_host = &host_list($q, $sel_host, $sel_cnt, $c2_info);
    return if (!$selected_host);

    $header ="
    <table border=0 width=100% bgcolor=#F0F0F0>
      <tr><td align=right>Host:</td><td> $selected_host</td>
      <tr><td align=right>Product:</td><td> $product</td>
      <tr><td align=right>WWN:</td><td> $sw_wwn</td>
    </table>";

  } elsif ($type eq "host") {
    my ($t, $h) = split(/:/, $info->{name});
    $header ="
    <table border=0 width=100% bgcolor=#F0F0F0>
      <tr><td align=right>Host:</td><td> $h <input type=hidden name=host value=\"$h\"></td>
      <tr><td align=right>Model:</td><td> $info->{model}</td>
    </table>";

  } else {  # storage
    my $t = $info->{LGroup};
    my $ix = rindex($t,"-");
    $t = substr($t,0,$ix);
    my $bn = "<tr><td align=right>Box:</td><td>$info->{BoxName}</td>"
              if ($info->{BoxName});
    
    my ($sel_host, $sel_cnt) = &find_host($info, $c2_info);
    my $selected_host = &host_list($q, $sel_host, $sel_cnt, $c2_info);
    return if (!$selected_host);

    my $ttype = ($c2_info->{node} eq "oob")? "OutOfBand":"InBand";
    $header ="
    <table border=0 width=100% bgcolor=#F0F0F0>
      <tr><td align=right>Run on Host:</td><td nowrap>$selected_host</td>
      <tr><td align=right>Name:</td><td> $info->{name}</td>
      $bn
      <tr><td align=right>Product:</td><td>$product $t</td>
    </table>";
  }



  my $but = &submit_b($submit, $deny, $warning, 0);


  print "
   <table border=0><tr><td></table>
   <table border=1 cellpadding=0 cellspacing=0 width=95% bgcolor=white>
   <tr bgcolor=#666699><td colspan=2>
     <table border=0 width=100% cellspacing=0 cellpadding=0><tr><td>
   <form method=post>
    <input type=hidden name=GO value=\"GUI::Test::get_test\">
    <input type=hidden name=EXPERT value=$q->{EXPERT}>
    <input type=hidden name=enc value=\"$q->{enc}\">
    <input type=hidden name=topo value=\"$q->{topo}\">
    <input type=hidden name=node value=\"$node\">
    <input type=hidden name=option value=\"$q->{option}\">

    &nbsp;$all_reg
    <font color=white><b>" . ucfirst($selected_test) . " $id</td><td align=right><font color=white><b> $but
    </td>
    </table></td>
 <tr><td colspan=2>
     $header
     </td>
 <tr>$reg_select</td>
  $upd
  </table>
  ";
  print &submit_b($submit, $deny, $warning, 1);
  print "</form>";
}

sub host_list {
  my($q, $sel_host, $sel_cnt, $c2_info) = @_;

    my %X = (ib => "DataPath/ InBand", oob => "Ethernet/ OutOfBand");
    if (!$sel_host) {
       print "&nbsp;<br>";
       print Html->warning("Cannot Test $X{$c2_info->{node}}!");
       return undef;
    }
    my $selected_host;
    if ($sel_cnt > 1) {
      $selected_host = Util->makeSelect("host",$sel_host, $q->{host});
      $selected_host = substr($selected_host,0,7) . " onchange=form.submit() " .
                     substr($selected_host, 7);
      $selected_host .= "<input type=submit name=ACTION value=go>";
    } else {
      chop($sel_host);
      $selected_host = "<table border=0><tr><td><b>$sel_host</table>";
    }
    return $selected_host;
}

sub skip {
  my($c2_info, $host_type) = @_;

  if ($c2_info eq "oob") {
     return 1 if ($host_type ne "oob");
  } else {
     return 1 if ($host_type eq "oob");
  }
}

sub find_host {
  my($info, $c2_info) = @_;
  my ($sel_host, $sel_cnt, $first, $ix);
  my $SW = 1 if (substr($info->{class} ,0,6) eq 'switch');

   # switch tests are oob even if Tests/switch.test says 'p'
   # this is a bug in the way the Tests/<file>.test were designed
  if ($c2_info->{node} eq "oob" || $SW) {
    my $renv = System->get_renv();
    my $C = PDM::ConfigFile->read();
    my $dev = $C->deviceByKey($info->{name});
    if ($dev) {
      $sel_host = ($dev->{host} || $renv->{hostname}) . "|" ;
      $first    = ($dev->{host} || $renv->{hostname});
      $sel_cnt++;
    }
  }

  foreach my $t1 ('host') {
      next if (!$info->{host});
      next if (&skip($c2_info->{node}, $info->{host_type}));

      if (index($sel_host, $info->{host}) < 0) {
        $sel_host .= "$info->{host}|" ;
        $first = $info->{host} if (!$first);
        $sel_cnt++;
      }
  }
  my $hosts = $info->{hosts};
  my $hostsT = $info->{hosts_type};
  for ($ix = 1; $ix <= $#$hostsT; $ix++) {
      next if (&skip($c2_info->{node}, $hostsT->[$ix]));

      if (index($sel_host, $hosts->[$ix]) < 0) {
        $sel_host .= "$hosts->[$ix]|" ;
        $first = $hosts->[$ix] if (!$first);
        $sel_cnt++;
      }
  }
  return ($sel_host, $sel_cnt, $first);

}




sub submit_b {
  my($submit, $deny, $warning, $dc) = @_;
  my $o;
  if ($submit && !$deny) {
    if ($warning) {
       $o .= "<b><input type=submit name=ACTION value=\"Start Test\" 
              onclick=\"return confirm('$warning')\" >&nbsp;";
    } else {
       $o .= "<b><input type=submit name=ACTION value=\"Start Test\">&nbsp;";
    }
  }
  if ($dc) {
     $o .= "<input type=submit name=ACTION value=\"Display Command&args\">";
  }
  return $o;
}


sub mode {
  my($q) = @_;
  my($err, $af, $upd);

  my $cache = Cache->read('tests','tests');
  $cache = {} if (!defined($cache));

  my($out, $w, $info);
  if (defined($q->{online})) {
     $cache->{MODE}{online} = $q->{online}; $w=1;
  }
  if (defined($q->{expert})) {
     $cache->{MODE}{expert} = $q->{expert}; $w=1;
  }

  Cache->write('test','tests', $cache) if ($w);

  $out .= "<tr><td><b>";
  if ($cache->{MODE}{online}) {
    $out .= "<a href=$Http::WEBPROC?GO=GUI::Test::mode&online=0 onmouseover=\"window.status='Click here to run tests OFFLINE'\"><font color=red>ON LINE</font></a>";
  } else {
   $out .= "<a href=$Http::WEBPROC?GO=GUI::Test::mode&online=1 onmouseover=\"window.status='Click here to run tests ONLINE'\">OFF LINE</a>";
  }
  $out .= "<tr><td><b>";
  if ($cache->{MODE}{expert}) {
    $out .= "<a href=$Http::WEBPROC?GO=GUI::Test::mode&expert=0 onmouseover=\"window.status='Click here to turn Expert-Mode OFF'\">EXPERT-ON</a>";
  } else {
    $out .= "<a href=$Http::WEBPROC?GO=GUI::Test::mode&expert=1 onmouseover=\"window.status='Click here to turn Export-Mode ON'\">EXPERT-OFF</a>";
  }
  print "\n<body bgcolor=#666699 link=navy vlink=navy blink=navy><center>
  <table border=0 bgcolor=white width=110% cellpadding=2 cellspacing=1>
   <tr><td bgcolor=#CCCCFF><b><center>Test Mode
   $out
   </table>&nbsp;";

}


sub defaults {

  my($q) = @_;
  my(@T, @tests, $info);

  if (my $err = Roles->verifyRole($q, "admin")) {
     print $err;
     return;
  }
  my $L = Labels->read('GUI::Test')->section('defaults');


  print "\n<body bgcolor=#E0E0E0><center>";
  my @tt = ('1=' . $L->{defaults});
  my $h = Html->header2("diagnose.test.defaults", "80%" );
  print $h;
  
  $T[1] = "DEFAULTS";

  my($af, $cache, $err,$err2, $upd, $test, $updG, $err1, $err3);
  ($err,$af) = AutoForm->new("System/Tests", {width=> "95%"});
  print $err if ($err);

  my $cnt = 2;
  my $select = "<select name=option onchange=form.submit()><option value=1>$L->{defaults}";
  $q->{option} = 1 if (!$q->{option});

  foreach my $com (sort $af->commandList()) {
     next if ($com eq "DEFAULTS"|| $com eq "MODE");
     my $c = $af->commandByName($com);
     my $info = $c->info();
     $T[$cnt] = $com;
     my $ck = ($q->{option} == $cnt) ? "selected" : "";
     $select .= "<option value=$cnt $ck>$info->{name}</option>";
     push(@tt, "$cnt=". $info->{name});
     $cnt++;
  }
  $select .= "</select>";
 
#  my $tab = Html::Tabs->create(list  =>  \@tt,
#                       url  => "$Http::WEBPROC?GO=GUI::Test::defaults",
#                     width  => "95%",
#             selectedColor  => "white",
#         selectedTextColor  => "blue",
#                        rows  => 2,
#           backgroundColor  => $main'LIGHT,
#        backgroundTextColor => 'black',
#                  selection => $q->{option}
#               );


  if ($q->{option} == 1) { # Defaults
    $cache = Cache->read('tests','tests');
    $cache = {} if (!defined($cache));

    if ($q->{ACTION_reset}) {
        $cache->{DEFAULTS} = $af->defaults('DEFAULTS');
        Cache->write('tests','tests', $cache);
        $info = "<font color=green>$L->{reset_done}</font>";

    } elsif ($q->{ACTION_update}) {
        ($err1, $cache->{DEFAULTS}) = $af->values('DEFAULTS', $q);
        if ($err1) {
           $err = "<font color=red><b>Error: $err1</font>";
           $info = "<font color=red>$L->{update_failed}</font>";
        } else {
           Cache->write('tests','tests', $cache);
           $info = "<font color=green>$L->{update_done}</font>";
        }
    }

    ($err, $upd) = $af->updateForm('DEFAULTS', {xheader => "", debug => 1},
                          $cache);

    print "<form><input type=hidden name=GO value=GUI::Test::defaults>
           <xinput type=hidden name=option value=1>";
    print "<table border=1 cellspacing=0 cellpadding=2 width=80% bgcolor=white>
    <tr><td bgcolor=#666699 colspan=3><font color=white>&nbsp;<b>$L->{label}</td>
    <tr><td bgcolor=#CCCCFF align=right>$L->{select_test}: </td><td colspan=2><b> $select <input type=submit name=ACTION value=GO></td>
   <tr bgcolor=white><td colspan=3><font color=black><b>&nbsp;$L->{default_option}: <center>$info</td> ";
    print $upd;
    print "<b></table>
       <input type=submit name=ACTION_update value=$L->{submit_update}>&nbsp;
       <input type=submit name=ACTION_reset value=$L->{submit_reset}>
    </form>";


  } else { # specific test

    $test = $T[$q->{option}];
    $cache = Cache->read('tests','tests');
    $cache = {} if (!defined($cache));

    if ($q->{ACTION_reset}) {
        ($err, $cache->{$test})          = $af->defaults($test);
        if (exists($cache->{DEFAULTS})) {
           ($err1 ,$cache->{$test}{DEFAULTS}) = $cache->{DEFAULTS};
        } else {
           ($err1 ,$cache->{$test}{DEFAULTS}) = $af->defaults('DEFAULTS');
        }
        Cache->write('tests','tests', $cache);
        $info = "<font color=yellow>$L->{reset_done}</font>";

    } elsif ($q->{ACTION_update}) {
        ($err1, $cache->{$test})          = $af->values($test, $q);
        ($err2, $cache->{$test}{DEFAULTS}) = $af->values('DEFAULTS', $q);
        if ($err1 || $err2) {
          $err = "<font color=red><b>Error: $err1 $err2</font>";
          $info = "<font color=yellow>$L->{update_failed}</font>";
        } else {
          $info = "<font color=yellow>$L->{update_done}</font>";
          Cache->write('tests','tests', $cache);
        }
    }


    ($err3, $upd) = $af->updateForm($test, {xheader => "", debug => 1},
                          $cache);
    if ($err3) {
       $err .= "<font color=red>" . L->expand('update_err', $err3). "</font>";
    }
    
    print "<form><input type=hidden name=GO value=GUI::Test::defaults>
           <Xinput type=hidden name=option value=$q->{option}>";
    if ($err) {
       print "<table border=1 cellpadding=1 cellspacing=0 width=80% bgcolor=white><tr><td><center>$err</table><table border=0><tr><td></table>";
    }
    print "<table border=1 cellspacing=0 width=80% bgcolor=white>
   <tr>
    <tr><td bgcolor=#CCCCFF align=right><b>$L->{select_test}: </td><td colspan=2><big> $select <input type=submit name=ACTION value=GO></td>
   <tr><td colspan=3 bgcolor=#666699><font color=white>&nbsp;<b>$test Options $info</td>
    $upd
    <b></table>
       <input type=submit name=ACTION_update value=$L->{submit_update}>&nbsp;
       <input type=submit name=ACTION_reset value=$L->{submit_reset}>
    </form>";

    
  }
  
}


  
  
  

sub run {
  my($q) = @_;
  my($err, $add, $update);
  print "\n<body bgcolor=white><center>";

  my $af = AutoForm->new("System/Tests", {language => 'fr', width=> "90%"});

  ($err, $add) = $af->addForm('DEFAULTS', {header => "extra", debug => 0} );

  ($err, $update) = $af->updateForm('DEFAULTS',
            {xheader => "", debug => 0},
            {A => 'val1', B=> 'val2', C => 0},
          );
  print "<font color=red>$err" if ($err);

  print "<form>";
  print "<table border=1 cellspacing=0 width=90%>";
  print $update;
  print "</table></form>";
  return;



}

#
# used to test automatic lists
#
sub XXXlist {
  my($q) = @_;
  my($x0, $x, $page, $list);
  print "\n<body bgcolor=#E0E0E0>";
  print "<table border=1 cellspacing=0 width=90% bgcolor=white>";
  System->set_language('fr');
  my @L;
  for ($x0=0; $x0 <= 100; $x0++) {
    $x = sprintf("%3.3d", $x0);
    push(@L, ["r$x c1","r$x c2","r$x c3" ,"r$x c4"]);
  }
  ($page, $list) =  Html::List->makeList($q, \@L,
                           ['Col1','Col2','Col3', 'Col4'],
                           ['l',     'r',     'c'],
                           ['+','-'],
                           {pageSize => 10, map => 'list1'}
                       );

  print "$list </table>&nbsp;<br></center> ".
        "<table border=0 cellpadding=3 bgcolor=white><tr><td>$page</table>";

}



1;
