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