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, 2014-2016 -- leonerd@leonerd.org.uk 5 6package Tickit::Debug 0.72; 7 8use v5.14; 9use warnings; 10 11use constant DEBUG => _enabled(); 12 13use Exporter 'import'; 14our @EXPORT = qw( DEBUG ); 15 16=head1 NAME 17 18C<Tickit::Debug> - debug logging support for C<Tickit> 19 20=head1 DESCRIPTION 21 22This module implements the debug logging logic for L<Tickit>. It is controlled 23by a number of environment variables. It exports a constant called C<DEBUG> 24which will be true if the debug logging is enabled; allowing code to 25efficiently skip over it if it isn't. 26 27Debug messages themselves each have a flag name, which is a short string 28identifying the Tickit subsystem or kind of event that caused it. A given 29subset of these flags can be enabled for printing. Flags not enabled will not 30be printed. 31 32=cut 33 34=head1 FLAGS 35 36Each flag name starts with a upper-case letters indicating the subsystem it 37relates to, then lower-case letters to indicate the particular kind of event 38or message. 39 40=head2 B (RenderBuffer) 41 42=head3 Bd 43 44Drawing operations 45 46=head3 Bf 47 48Flushing 49 50=head3 Bs 51 52State stack save/restore 53 54=head3 Bt 55 56Transformations (translate, clip, mask) 57 58=head2 I (Input) 59 60=head3 Ik 61 62Keyboard events 63 64=head3 Im 65 66Mouse events 67 68=head3 Ir 69 70Resize events 71 72=head2 W (Window) 73 74=head3 Wd 75 76Rectangles of damage queued on the root window for re-expose 77 78=head3 Wh 79 80Hierarchy changes on Windows (creates, deletes, re-orderings) 81 82=head3 Ws 83 84Calls to C<< $win->scrollrect >> 85 86=head3 Wsr 87 88Calls to C<< $term->scrollrect >> on the root window as part of scrollrect 89 90=head3 Wx 91 92Expose events on Windows; which may result in calls to its C<on_expose> 93handler. As this event is recursive, it prints an indent. 94 95=cut 96 97=head1 ENVIRONMENT 98 99=head2 TICKIT_DEBUG_FLAGS 100 101A comma-separated list of the flags or flag categories to enable for printing. 102Each potential flag exists in a category, given by the leading upper-case 103letters of its name. Entire categories can be enabled by name, as can 104individual flags. 105 106See the L</FLAGS> list above for the available flags. 107 108=head2 TICKIT_DEBUG_FD 109 110If set, debug logging is sent directly to the opened filehandle given by this 111file descriptor number, rather than opening a log file. 112 113Typically this is most useful to start a C<Tickit>-based application in a new 114terminal but have its debug logging printed to STDERR of the original terminal 115the new one was launched from. For example 116 117 $ TICKIT_DEBUG_FD=3 TICKIT_DEBUG_FLAGS=... $TERM perl my-tickit-app.pl 3>&2 118 119This requests that C<Tickit::Debug> log to file descriptor 3, which has been 120created by copying the original shell's standard error output, and so logging 121is printed to the shell this was run from. 122 123=head2 TICKIT_DEBUG_FILE 124 125Gives the name of a file to open and write logging to, if C<TICKIT_DEBUG_FD> 126is not set. If this is not set either, a filename will be generated using the 127PID of the process, named as 128 129 tickit-PID.log 130 131=cut 132 133=head1 METHODS 134 135=cut 136 137=head2 log 138 139 Tickit::Debug->log( $flag => $format, @args ) 140 141Prints a line to the debug log if the specified C<$flag> is present in the set 142of enabled flags. 143 144Any arguments that are C<CODE> references are called and replaced by the 145list of values they return, then the line itself is generated by calling 146C<sprintf> using the format string and the given arguments. It is then 147printed to the log, prefixed by the flag name and with a linefeed appended. 148 149It is not necessary to include the C<\n> linefeed in the C<$format> itself. 150 151=cut 152 153sub log :method 154{ 155 shift; 156 my ( $flag, $format, @args ) = @_; 157 158 return unless _enabled(); 159 160 my $message = sprintf $format, map { ref eq "CODE" ? $_->() : $_ } @args; 161 162 _log( $flag, $message ); 163} 164 165=head1 AUTHOR 166 167Paul Evans <leonerd@leonerd.org.uk> 168 169=cut 170 1710x55AA; 172