1#  You may distribute under the terms of either the GNU General Public License
2#  or the Artistic License (the same terms as Perl itself)
3#
4#  (C) Paul Evans, 2015 -- leonerd@leonerd.org.uk
5
6package IO::Async::Debug;
7
8use strict;
9use warnings;
10
11our $VERSION = '0.800';
12
13our $DEBUG = $ENV{IO_ASYNC_DEBUG} || 0;
14our $DEBUG_FD   = $ENV{IO_ASYNC_DEBUG_FD};
15our $DEBUG_FILE = $ENV{IO_ASYNC_DEBUG_FILE};
16our $DEBUG_FH;
17our %DEBUG_FLAGS = map { $_ => 1 } split m/,/, $ENV{IO_ASYNC_DEBUG_FLAGS} || "";
18
19=head1 NAME
20
21C<IO::Async::Debug> - debugging control and support for L<IO::Async>
22
23=head1 DESCRIPTION
24
25The following methods and behaviours are still experimental and may change or
26even be removed in future.
27
28Debugging support is enabled by an environment variable called
29C<IO_ASYNC_DEBUG> having a true value.
30
31When debugging is enabled, the C<make_event_cb> and C<invoke_event> methods
32on L<IO::Async::Notifier> (and their C<maybe_> variants) are altered such that
33when the event is fired, a debugging line is printed, using the C<debug_printf>
34method. This identifes the name of the event.
35
36By default, the line is only printed if the caller of one of these methods is
37the same package as the object is blessed into, allowing it to print the
38events of the most-derived class, without the extra verbosity of the
39lower-level events of its parent class used to create it. All calls regardless
40of caller can be printed by setting a number greater than 1 as the value of
41C<IO_ASYNC_DEBUG>.
42
43By default the debugging log goes to C<STDERR>, but two other environment
44variables can redirect it. If C<IO_ASYNC_DEBUG_FILE> is set, it names a file
45which will be opened for writing, and logging written into it. Otherwise, if
46C<IO_ASYNC_DEBUG_FD> is set, it gives a file descriptor number that logging
47should be written to. If opening the named file or file descriptor fails then
48the log will be written to C<STDERR> as normal.
49
50Extra debugging flags can be set in a comma-separated list in an environment
51variable called C<IO_ASYNC_DEBUG_FLAGS>. The presence of these flags can cause
52extra information to be written to the log. Full details on these flags will
53be documented by the implementing classes. Typically these flags take the form
54of one or more capital letters indicating the class, followed by one or more
55lowercase letters enabling some particular feature within that class.
56
57=cut
58
59sub logf
60{
61   my ( $fmt, @args ) = @_;
62
63   $DEBUG_FH ||= do {
64      my $fh;
65      if( $DEBUG_FILE ) {
66         open $fh, ">", $DEBUG_FILE or undef $fh;
67      }
68      elsif( $DEBUG_FD ) {
69         $fh = IO::Handle->new;
70         $fh->fdopen( $DEBUG_FD, "w" ) or undef $fh;
71      }
72      $fh ||= \*STDERR;
73      $fh->autoflush;
74      $fh;
75   };
76
77   printf $DEBUG_FH $fmt, @args;
78}
79
80sub log_hexdump
81{
82   my ( $bytes ) = @_;
83
84   foreach my $chunk ( $bytes =~ m/(.{1,16})/sg ) {
85      my $chunk_hex = join " ", map { sprintf "%02X", ord $_ } split //, $chunk;
86      ( my $chunk_safe = $chunk ) =~ s/[^\x20-\x7e]/./g;
87
88      logf "  | %-48s | %-16s |\n", $chunk_hex, $chunk_safe;
89   }
90}
91
92=head1 AUTHOR
93
94Paul Evans <leonerd@leonerd.org.uk>
95
96=cut
97
980x55AA;
99