# Použití:   X:\>perl mping.pl 
#
# Zobrazí uzel v barvě dané jeho chutí odpovídat včas (na ping).
#
# Nepoužívá moduly, instalaci perlu lze nahradit pouhým 
# uložením souborů perl.exe a perl58.dll do běžného adresáře.
# Oťukávané uzly jsou definovány uvnitř zde vloženého html dokumentu 
# a to jako >[Název;adresa]< tedy např. >[AP Rebeca;10.102.24.1]<
#
# Protože neumím lehce ovládat DNS timeout, jsou všechny adresy numerické
# a tak je bude občas třeba občerstvit.

my $progressbar = 1;

my $H = <<EOF
<html>

<head>
  <meta content="text/html; charset=windows-1250" http-equiv="content-type">

  <style type="text/css"> 
    td     { font-size: 90%; }
    td.unk {background-color: gray;  border: 3px solid black; width: 100px;}
    td.req {background-color: blue;  border: 3px solid black; width: 100px;}
    td.bad {background-color: red;   border: 3px solid black; width: 100px;}
    td.var {background-color: orange;border: 3px solid black; width: 100px;}
    td.ok  {background-color: green; border: 3px solid black; width: 100px;}
    td.arr {font-size: 300%;}
    p.log  {background-color: #B0B0B0; margin: 20px; width: 500px; font-size: 70%; text-align: left;}
  </style>
  <title>Test dostupnosti</title>
</head>
<body>

<table style="text-align: center;" border="0" cellpadding="2" cellspacing="2" align="center">
  <tbody>
    <tr>
      <td >WHEN</td>
      <td ></td>
      <td >[Ovis 2648;10.102.24.20]</td>
      <td ></td>
      <td ></td>
      <td ></td>
    </tr>
    <tr>
      <td ></td>
      <td ></td>
      <td class="arr">&darr;</td>
      <td ></td>
      <td ></td>
      <td ></td>
    </tr>
    <tr>
      <td ></td>
      <td ></td>
      <td >[AP Rebeca;10.102.24.1]</td>
      <td ></td>
      <td ></td>
      <td ></td>
    </tr>
    <tr>
      <td ></td>
      <td ></td>
      <td class="arr">&darr;</td>
      <td ></td>
      <td ></td>
      <td ></td>
    </tr>
    <tr>
      <td >[Libušín;10.102.159.129]</td>
      <td class="arr">&larr</td>
      <td >[Silver;10.102.222.15]</td>
      <td ></td>
      <td class="arr">&rarr;</td>
      <td >[Pražská;10.102.1.73]</td>
    </tr>
    <tr>
      <td ></td>
      <td ></td>
      <td class="arr">&darr;</td>
      <td ></td>
      <td ></td>
      <td ></td>
    </tr>
    <tr>
      <td ></td>
      <td ></td>
      <td >[Sloane Praha;62.240.166.129]</td>
      <td ></td>
      <td class="arr">&rarr;</td>
      <td >[NIX.cz;194.50.100.190]</td>
    </tr>
    <tr>
      <td ></td>
      <td ></td>
      <td class="arr">&darr;</td>
      <td ></td>
      <td ></td>
      <td class="arr">&darr;</td>
    </tr>
    <tr>
      <td ></td>
      <td ></td>
      <td >[Google;64.233.183.147]</td>
      <td ></td>
      <td ></td>
      <td >[Seznam;212.80.76.18]</td>
    </tr>
    <tr>
      <td ></td>
      <td ></td>
      <td ></td>
      <td ></td>
      <td ></td>
      <td ></td>
    </tr>
  </tbody>
</table>

<div align="center">
<p class="log">
LOGHERE
<p>
</div>
</html> 
EOF
;

my $U = $H;

my @nodes;

# find all nodes [name;adress] within the <table> 
while ($U=~m/> *(\[.*?\]) *</g) {unshift(@nodes,$1);} 

my $tmp = $ENV{temp};
my $now = substr(`date /T`.'  '.`time /T`,2,100);
my $LOG = $now.'<br>';
my @cls = qw/bad var ok/; #color depends on nuber of replies

# ping them all
while ($n=pop(@nodes)) {
  if ($n=~/\[(.*);(.*)\]/) {
    my $name = $1;
    my $ipx = $2;
    my @Q = pingstatus($ipx);
    my $P = join(',' , @Q);
    my $replies = $#Q+1;
    
    print '.' if ($progressbar); 
    
#   now convert '>[Silver;10.102.222.15]<' into ' class="ok">Silver<br>10.102.222.15<br>11ms,14ms<'
    
    my $cx = ' class="'.$cls[$replies].'">'.$name.'<br>'.$ipx.'<br>'.$P.'<';
    $U =~ s/> *\[$name;$ipx\] *</$cx/;      
  }
}

$U =~ s/LOGHERE/$LOG/s;
$U =~ s/WHEN/$now/s;
open (HTM , ">$tmp\\tmppinginfo.htm");
print HTM $U;
close(HTM);

system("start $tmp\\tmppinginfo.htm");

sub pingstatus {
 my  ($ip) = @_;
 my  $P1 =        `ping -w 100 -n 1 $ip`;  # short timeout
 sleep(0.1);
 my  $P2 =        `ping -w 600 -n 1 $ip`;  # long timeout
     
 my  $replies = 0;
 $LOG.='<br>Ping '.$ip.'<br> '.$P1.'<br>'.$P2."<br>\n";
 
 my @Q = ();
 if ($P1=~/( .as| time)(=|<)(\d+ms)/) {push(@Q,(($2 eq '<')?$2:'').$3);}
 if ($P2=~/( .as| time)(=|<)(\d+ms)/) {push(@Q,(($2 eq '<')?$2:'').$3);}
     
 return @Q;    
} 