Commit | Line | Data |
351625bd |
1 | |
2 | require 5; |
3 | package Pod::Simple::Debug; |
4 | use strict; |
5 | |
6 | sub import { |
7 | my($value,$variable); |
8 | |
9 | if(@_ == 2) { |
10 | $value = $_[1]; |
11 | } elsif(@_ == 3) { |
12 | ($variable, $value) = @_[1,2]; |
13 | |
14 | ($variable, $value) = ($value, $variable) |
15 | if defined $value and ref($value) eq 'SCALAR' |
16 | and not(defined $variable and ref($variable) eq 'SCALAR') |
17 | ; # tolerate getting it backwards |
18 | |
19 | unless( defined $variable and ref($variable) eq 'SCALAR') { |
20 | require Carp; |
21 | Carp::croak("Usage:\n use Pod::Simple::Debug (NUMVAL)\nor" |
22 | . "\n use Pod::Simple::Debug (\\\$var, STARTNUMVAL)\nAborting"); |
23 | } |
24 | } else { |
25 | require Carp; |
26 | Carp::croak("Usage:\n use Pod::Simple::Debug (NUMVAL)\nor" |
27 | . "\n use Pod::Simple::Debug (\\\$var, STARTNUMVAL)\nAborting"); |
28 | } |
29 | |
30 | if( defined &Pod::Simple::DEBUG ) { |
31 | require Carp; |
32 | Carp::croak("It's too late to call Pod::Simple::Debug -- " |
33 | . "Pod::Simple has already loaded\nAborting"); |
34 | } |
35 | |
36 | $value = 0 unless defined $value; |
37 | |
38 | unless($value =~ m/^-?\d+$/) { |
39 | require Carp; |
40 | Carp::croak( "$value isn't a numeric value." |
41 | . "\nUsage:\n use Pod::Simple::Debug (NUMVAL)\nor" |
42 | . "\n use Pod::Simple::Debug (\\\$var, STARTNUMVAL)\nAborting"); |
43 | } |
44 | |
45 | if( defined $variable ) { |
46 | # make a not-really-constant |
47 | *Pod::Simple::DEBUG = sub () { $$variable } ; |
48 | $$variable = $value; |
49 | print "# Starting Pod::Simple::DEBUG = non-constant $variable with val $value\n"; |
50 | } else { |
51 | *Pod::Simple::DEBUG = eval " sub () { $value } "; |
52 | print "# Starting Pod::Simple::DEBUG = $value\n"; |
53 | } |
54 | |
55 | require Pod::Simple; |
56 | return; |
57 | } |
58 | |
59 | 1; |
60 | |
61 | |
62 | __END__ |
63 | |
64 | =head1 NAME |
65 | |
66 | Pod::Simple::Debug -- put Pod::Simple into trace/debug mode |
67 | |
68 | =head1 SYNOPSIS |
69 | |
70 | use Pod::Simple::Debug (5); # or some integer |
71 | |
72 | Or: |
73 | |
74 | my $debuglevel; |
75 | use Pod::Simple::Debug (\$debuglevel, 0); |
76 | ...some stuff that uses Pod::Simple to do stuff, but which |
77 | you don't want debug output from... |
78 | |
79 | $debug_level = 4; |
80 | ...some stuff that uses Pod::Simple to do stuff, but which |
81 | you DO want debug output from... |
82 | |
83 | $debug_level = 0; |
84 | |
85 | =head1 DESCRIPTION |
86 | |
87 | This is an internal module for controlling the debug level (a.k.a. trace |
88 | level) of Pod::Simple. This is of interest only to Pod::Simple |
89 | developers. |
90 | |
91 | |
92 | =head1 CAVEATS |
93 | |
94 | Note that you should load this module I<before> loading Pod::Simple (or |
95 | any Pod::Simple-based class). If you try loading Pod::Simple::Debug |
96 | after &Pod::Simple::DEBUG is already defined, Pod::Simple::Debug will |
97 | throw a fatal error to the effect that |
98 | "it's s too late to call Pod::Simple::Debug". |
99 | |
100 | Note that the C<use Pod::Simple::Debug (\$x, I<somenum>)> mode will make |
101 | Pod::Simple (et al) run rather slower, since &Pod::Simple::DEBUG won't |
102 | be a constant sub anymore, and so Pod::Simple (et al) won't compile with |
103 | constant-folding. |
104 | |
105 | |
106 | =head1 GUTS |
107 | |
108 | Doing this: |
109 | |
110 | use Pod::Simple::Debug (5); # or some integer |
111 | |
112 | is basically equivalent to: |
113 | |
114 | BEGIN { sub Pod::Simple::DEBUG () {5} } # or some integer |
115 | use Pod::Simple (); |
116 | |
117 | And this: |
118 | |
119 | use Pod::Simple::Debug (\$debug_level,0); # or some integer |
120 | |
121 | is basically equivalent to this: |
122 | |
123 | my $debug_level; |
124 | BEGIN { $debug_level = 0 } |
125 | BEGIN { sub Pod::Simple::DEBUG () { $debug_level } |
126 | use Pod::Simple (); |
127 | |
128 | =head1 SEE ALSO |
129 | |
130 | L<Pod::Simple> |
131 | |
132 | The article "Constants in Perl", in I<The Perl Journal> issue |
9d65762f |
133 | 21. See L<http://interglacial.com/tpj/21/> |
351625bd |
134 | |
135 | =head1 COPYRIGHT AND DISCLAIMERS |
136 | |
137 | Copyright (c) 2002 Sean M. Burke. All rights reserved. |
138 | |
139 | This library is free software; you can redistribute it and/or modify it |
140 | under the same terms as Perl itself. |
141 | |
142 | This program is distributed in the hope that it will be useful, but |
143 | without any warranty; without even the implied warranty of |
144 | merchantability or fitness for a particular purpose. |
145 | |
146 | =head1 AUTHOR |
147 | |
148 | Sean M. Burke C<sburke@cpan.org> |
149 | |
150 | =cut |
151 | |