ceph/src/boost/libs/asio/tools/handlerviz.pl

   1 #!/usr/bin/perl -w
   2 #
   3 # handlerviz.pl
   4 # ~~~~~~~~~~~~~
   5 #
   6 # A visualisation tool for post-processing the debug output generated by
   7 # Asio-based programs. Programs write this output to the standard error stream
   8 # when compiled with the define `BOOST_ASIO_ENABLE_HANDLER_TRACKING'.
   9 #
  10 # This tool generates output intended for use with the GraphViz tool `dot'. For
  11 # example, to convert output to a PNG image, use:
  12 #
  13 #   perl handlerviz.pl < output.txt | dot -Tpng > output.png
  14 #
  15 # To convert to a PDF file, use:
  16 #
  17 #   perl handlerviz.pl < output.txt | dot -Tpdf > output.pdf
  18 #
  19 # Copyright (c) 2003-2022 Christopher M. Kohlhoff (chris at kohlhoff dot com)
  20 #
  21 # Distributed under the Boost Software License, Version 1.0. (See accompanying
  22 # file LICENSE_1_0.txt or copy at http://www.boost.org/LICENSE_1_0.txt)
  23 #
  24
  25 use strict;
  26
  27 my %nodes = ();
  28 my @edges = ();
  29 my %locations = ();
  30 my %anon_nodes = ();
  31 my $anon_id = 0;
  32 my %all_nodes = ();
  33 my %pending_nodes = ();
  34
  35 #-------------------------------------------------------------------------------
  36 # Parse the debugging output and populate the nodes and edges.
  37
  38 sub parse_debug_output()
  39 {
  40   while (my $line = <>)
  41   {
  42     chomp($line);
  43
  44     if ($line =~ /\@asio\|([^|]*)\|([^|]*)\|(.*)$/)
  45     {
  46       my $timestamp = $1;
  47       my $action = $2;
  48       my $description = $3;
  49
  50       # Handler creation.
  51       if ($action =~ /^([0-9]+)\*([0-9]+)$/)
  52       {
  53         my $begin = $1;
  54         my $end = $2;
  55         my $label = $description;
  56         $label =~ s/\./\\n/g;
  57
  58         if ($begin eq "0")
  59         {
  60           $begin = "a" . $anon_id++;
  61           $anon_nodes{$begin} = $timestamp;
  62           $all_nodes{"$timestamp-$begin"} = $begin;
  63         }
  64
  65         my %edge = ( begin=>$begin, end=>$end, label=>$label );
  66         push(@edges, \%edge);
  67
  68         $pending_nodes{$end} = 1;
  69       }
  70
  71       # Handler location.
  72       elsif ($action =~ /^([0-9]+)\^([0-9]+)$/)
  73       {
  74         if ($1 ne "0")
  75         {
  76           if (not exists($locations{($1,$2)}))
  77           {
  78             $locations{($1,$2)} = ();
  79           }
  80           push(@{$locations{($1,$2)}}, $description);
  81         }
  82       }
  83
  84       # Begin handler invocation.
  85       elsif ($action =~ /^>([0-9]+)$/)
  86       {
  87         my %new_node = ( label=>$description, entry=>$timestamp );
  88         $new_node{content} = ();
  89         $nodes{$1} = \%new_node;
  90         $all_nodes{"$timestamp-$1"} = $1;
  91         delete($pending_nodes{$1});
  92       }
  93
  94       # End handler invocation.
  95       elsif ($action =~ /^<([0-9]+)$/)
  96       {
  97         $nodes{$1}->{exit} = $timestamp;
  98       }
  99
 100       # Handler threw exception.
 101       elsif ($action =~ /^!([0-9]+)$/)
 102       {
 103         push(@{$nodes{$1}->{content}}, "exception");
 104       }
 105
 106       # Handler was destroyed without being invoked.
 107       elsif ($action =~ /^~([0-9]+)$/)
 108       {
 109         my %new_node = ( label=>"$timestamp destroyed" );
 110         $new_node{content} = ();
 111         $nodes{$1} = \%new_node;
 112         $all_nodes{"$timestamp-$1"} = $1;
 113         delete($pending_nodes{$1});
 114       }
 115
 116       # Handler performed some operation.
 117       elsif ($action =~ /^([0-9]+)$/)
 118       {
 119         if ($1 eq "0")
 120         {
 121           my $id = "a" . $anon_id++;
 122           $anon_nodes{$id} = "$timestamp\\l$description";
 123           $all_nodes{"$timestamp-$id"} = $id;
 124         }
 125         else
 126         {
 127           push(@{$nodes{$1}->{content}}, "$description");
 128         }
 129       }
 130     }
 131   }
 132 }
 133
 134 #-------------------------------------------------------------------------------
 135 # Helper function to convert a string to escaped HTML text.
 136
 137 sub escape($)
 138 {
 139   my $text = shift;
 140   $text =~ s/&/\&amp\;/g;
 141   $text =~ s/</\&lt\;/g;
 142   $text =~ s/>/\&gt\;/g;
 143   $text =~ s/\t/    /g;
 144   return $text;
 145 }
 146
 147 #-------------------------------------------------------------------------------
 148 # Templates for dot output.
 149
 150 my $graph_header = <<"EOF";
 151 /* Generated by handlerviz.pl */
 152 digraph "handlerviz output"
 153 {
 154 graph [ nodesep="1" ];
 155 node [ shape="box", fontsize="9" ];
 156 edge [ arrowtail="dot", fontsize="9" ];
 157 EOF
 158
 159 my $graph_footer = <<"EOF";
 160 }
 161 EOF
 162
 163 my $node_header = <<"EOF";
 164 "%name%"
 165 [
 166 label=<<table border="0" cellspacing="0">
 167 <tr><td align="left" bgcolor="gray" border="0">%label%</td></tr>
 168 EOF
 169
 170 my $node_footer = <<"EOF";
 171 </table>>
 172 ]
 173 EOF
 174
 175 my $node_content = <<"EOF";
 176 <tr><td align="left" bgcolor="white" border="0">
 177 <font face="mono" point-size="9">%content%</font>
 178 </td></tr>
 179 EOF
 180
 181 my $anon_nodes_header = <<"EOF";
 182 {
 183 node [ shape="record" ];
 184 EOF
 185
 186 my $anon_nodes_footer = <<"EOF";
 187 }
 188 EOF
 189
 190 my $anon_node = <<"EOF";
 191 "%name%" [ label="%label%", color="gray" ];
 192 EOF
 193
 194 my $pending_nodes_header = <<"EOF";
 195 {
 196 node [ shape="record", color="red" ];
 197 rank = "max";
 198 EOF
 199
 200 my $pending_nodes_footer = <<"EOF";
 201 }
 202 EOF
 203
 204 my $pending_node = <<"EOF";
 205 "%name%";
 206 EOF
 207
 208 my $edges_header = <<"EOF";
 209 {
 210 edge [ style="dashed", arrowhead="open" ];
 211 EOF
 212
 213 my $edges_footer = <<"EOF";
 214 }
 215 EOF
 216
 217 my $edge = <<"EOF";
 218 "%begin%" -> "%end%" [ label="%label%", labeltooltip="%tooltip%" ]
 219 EOF
 220
 221 my $node_order_header = <<"EOF";
 222 {
 223 node [ style="invisible" ];
 224 edge [ style="invis", weight="100" ];
 225 EOF
 226
 227 my $node_order_footer = <<"EOF";
 228 }
 229 EOF
 230
 231 my $node_order = <<"EOF";
 232 {
 233 rank="same"
 234 "%begin%";
 235 "o%begin%";
 236 }
 237 "o%begin%" -> "o%end%";
 238 EOF
 239
 240 #-------------------------------------------------------------------------------
 241 # Generate dot output from the nodes and edges.
 242
 243 sub print_nodes()
 244 {
 245   foreach my $name (sort keys %nodes)
 246   {
 247     my $node = $nodes{$name};
 248     my $entry = $node->{entry};
 249     my $exit = $node->{exit};
 250     my $label = escape($node->{label});
 251     my $header = $node_header;
 252     $header =~ s/%name%/$name/g;
 253     $header =~ s/%label%/$label/g;
 254     print($header);
 255
 256     if (defined($exit) and defined($entry))
 257     {
 258       my $line = $node_content;
 259       my $content = $entry . " + " . sprintf("%.6f", $exit - $entry) . "s";
 260       $line =~ s/%content%/$content/g;
 261       print($line);
 262     }
 263
 264     foreach my $content (@{$node->{content}})
 265     {
 266       $content = escape($content);
 267       $content = " " if length($content) == 0;
 268       my $line = $node_content;
 269       $line =~ s/%content%/$content/g;
 270       print($line);
 271     }
 272
 273     print($node_footer);
 274   }
 275 }
 276
 277 sub print_anon_nodes()
 278 {
 279   print($anon_nodes_header);
 280   foreach my $name (sort keys %anon_nodes)
 281   {
 282     my $label = $anon_nodes{$name};
 283     my $line = $anon_node;
 284     $line =~ s/%name%/$name/g;
 285     $line =~ s/%label%/$label/g;
 286     print($line);
 287   }
 288   print($anon_nodes_footer);
 289 }
 290
 291 sub print_pending_nodes()
 292 {
 293   print($pending_nodes_header);
 294   foreach my $name (sort keys %pending_nodes)
 295   {
 296     my $line = $pending_node;
 297     $line =~ s/%name%/$name/g;
 298     print($line);
 299   }
 300   print($pending_nodes_footer);
 301 }
 302
 303 sub print_edges()
 304 {
 305   print($edges_header);
 306   foreach my $e (@edges)
 307   {
 308     my $begin = $e->{begin};
 309     my $end = $e->{end};
 310     my $label = $e->{label};
 311     my $tooltip = "";
 312     if (exists($locations{($begin,$end)}))
 313     {
 314       for my $line (@{$locations{($begin,$end)}})
 315       {
 316         $tooltip = $tooltip . escape($line) . "\n";
 317       }
 318     }
 319     my $line = $edge;
 320     $line =~ s/%begin%/$begin/g;
 321     $line =~ s/%end%/$end/g;
 322     $line =~ s/%label%/$label/g;
 323     $line =~ s/%tooltip%/$tooltip/g;
 324     print($line);
 325   }
 326   print($edges_footer);
 327 }
 328
 329 sub print_node_order()
 330 {
 331   my $prev = "";
 332   print($node_order_header);
 333   foreach my $name (sort keys %all_nodes)
 334   {
 335     if ($prev ne "")
 336     {
 337       my $begin = $prev;
 338       my $end = $all_nodes{$name};
 339       my $line = $node_order;
 340       $line =~ s/%begin%/$begin/g;
 341       $line =~ s/%end%/$end/g;
 342       print($line);
 343     }
 344     $prev = $all_nodes{$name};
 345   }
 346   foreach my $name (sort keys %pending_nodes)
 347   {
 348     if ($prev ne "")
 349     {
 350       my $begin = $prev;
 351       my $line = $node_order;
 352       $line =~ s/%begin%/$begin/g;
 353       $line =~ s/%end%/$name/g;
 354       print($line);
 355     }
 356     last;
 357   }
 358   print($node_order_footer);
 359 }
 360
 361 sub generate_dot()
 362 {
 363   print($graph_header);
 364   print_nodes();
 365   print_anon_nodes();
 366   print_pending_nodes();
 367   print_edges();
 368   print_node_order();
 369   print($graph_footer);
 370 }
 371
 372 #-------------------------------------------------------------------------------
 373
 374 parse_debug_output();
 375 generate_dot();