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