1#!/usr/bin/perl -w
2#
3# handlerlive.pl
4# ~~~~~~~~~~~~~~
5#
6# A tool for post-processing the debug output generated by Asio-based programs
7# to print a list of "live" handlers. These are handlers that are associated
8# with operations that have not yet completed, or running handlers that have
9# not yet finished their execution. Programs write this output to the standard
10# error stream when compiled with the define `BOOST_ASIO_ENABLE_HANDLER_TRACKING'.
11#
12# Copyright (c) 2003-2021 Christopher M. Kohlhoff (chris at kohlhoff dot com)
13#
14# Distributed under the Boost Software License, Version 1.0. (See accompanying
15# file LICENSE_1_0.txt or copy at http://www.boost.org/LICENSE_1_0.txt)
16#
17
18use strict;
19
20my %pending_handlers = ();
21my %running_handlers = ();
22
23#-------------------------------------------------------------------------------
24# Parse the debugging output and update the set of pending handlers.
25
26sub parse_debug_output()
27{
28  while (my $line = <>)
29  {
30    chomp($line);
31
32    if ($line =~ /\@asio\|([^|]*)\|([^|]*)\|(.*)$/)
33    {
34      my $action = $2;
35
36      # Handler creation.
37      if ($action =~ /^([0-9]+)\*([0-9]+)$/)
38      {
39        $pending_handlers{$2} = 1;
40      }
41
42      # Begin handler invocation.
43      elsif ($action =~ /^>([0-9]+)$/)
44      {
45        delete($pending_handlers{$1});
46        $running_handlers{$1} = 1;
47      }
48
49      # End handler invocation.
50      elsif ($action =~ /^<([0-9]+)$/)
51      {
52        delete($running_handlers{$1});
53      }
54
55      # Handler threw exception.
56      elsif ($action =~ /^!([0-9]+)$/)
57      {
58        delete($running_handlers{$1});
59      }
60
61      # Handler was destroyed without being invoked.
62      elsif ($action =~ /^~([0-9]+)$/)
63      {
64        delete($pending_handlers{$1});
65      }
66    }
67  }
68}
69
70#-------------------------------------------------------------------------------
71# Print a list of incompleted handers, on a single line delimited by spaces.
72
73sub print_handlers($)
74{
75  my $handlers = shift;
76  my $prefix = "";
77  foreach my $handler (sort { $a <=> $b } keys %{$handlers})
78  {
79    print("$prefix$handler");
80    $prefix = " ";
81  }
82  print("\n") if ($prefix ne "");
83}
84
85#-------------------------------------------------------------------------------
86
87parse_debug_output();
88print_handlers(\%running_handlers);
89print_handlers(\%pending_handlers);
90