cpan/Pod-Simple/lib/Pod/Simple/Debug.pm

   1
   2 require 5;
   3 package Pod::Simple::Debug;
   4 use strict;
   5 use vars qw($VERSION );
   6 $VERSION = '3.18';
   7
   8 sub import {
   9   my($value,$variable);
  10
  11   if(@_ == 2) {
  12     $value = $_[1];
  13   } elsif(@_ == 3) {
  14     ($variable, $value) = @_[1,2];
  15
  16     ($variable, $value) = ($value, $variable)
  17        if     defined $value    and ref($value)    eq 'SCALAR'
  18       and not(defined $variable and ref($variable) eq 'SCALAR')
  19     ; # tolerate getting it backwards
  20
  21     unless( defined $variable and ref($variable) eq 'SCALAR') {
  22       require Carp;
  23       Carp::croak("Usage:\n use Pod::Simple::Debug (NUMVAL)\nor"
  24                 . "\n use Pod::Simple::Debug (\\\$var, STARTNUMVAL)\nAborting");
  25     }
  26   } else {
  27     require Carp;
  28     Carp::croak("Usage:\n use Pod::Simple::Debug (NUMVAL)\nor"
  29                     . "\n use Pod::Simple::Debug (\\\$var, STARTNUMVAL)\nAborting");
  30   }
  31
  32   if( defined &Pod::Simple::DEBUG ) {
  33     require Carp;
  34     Carp::croak("It's too late to call Pod::Simple::Debug -- "
  35               . "Pod::Simple has already loaded\nAborting");
  36   }
  37
  38   $value = 0 unless defined $value;
  39
  40   unless($value =~ m/^-?\d+$/) {
  41     require Carp;
  42     Carp::croak( "$value isn't a numeric value."
  43             . "\nUsage:\n use Pod::Simple::Debug (NUMVAL)\nor"
  44                     . "\n use Pod::Simple::Debug (\\\$var, STARTNUMVAL)\nAborting");
  45   }
  46
  47   if( defined $variable ) {
  48     # make a not-really-constant
  49     *Pod::Simple::DEBUG = sub () { $$variable } ;
  50     $$variable = $value;
  51     print "# Starting Pod::Simple::DEBUG = non-constant $variable with val $value\n";
  52   } else {
  53     *Pod::Simple::DEBUG = eval " sub () { $value } ";
  54     print "# Starting Pod::Simple::DEBUG = $value\n";
  55   }
  56
  57   require Pod::Simple;
  58   return;
  59 }
  60
  61 1;
  62
  63
  64 __END__
  65
  66 =head1 NAME
  67
  68 Pod::Simple::Debug -- put Pod::Simple into trace/debug mode
  69
  70 =head1 SYNOPSIS
  71
  72  use Pod::Simple::Debug (5);  # or some integer
  73
  74 Or:
  75
  76  my $debuglevel;
  77  use Pod::Simple::Debug (\$debuglevel, 0);
  78  ...some stuff that uses Pod::Simple to do stuff, but which
  79   you don't want debug output from...
  80
  81  $debug_level = 4;
  82  ...some stuff that uses Pod::Simple to do stuff, but which
  83   you DO want debug output from...
  84
  85  $debug_level = 0;
  86
  87 =head1 DESCRIPTION
  88
  89 This is an internal module for controlling the debug level (a.k.a. trace
  90 level) of Pod::Simple.  This is of interest only to Pod::Simple
  91 developers.
  92
  93
  94 =head1 CAVEATS
  95
  96 Note that you should load this module I<before> loading Pod::Simple (or
  97 any Pod::Simple-based class).  If you try loading Pod::Simple::Debug
  98 after &Pod::Simple::DEBUG is already defined, Pod::Simple::Debug will
  99 throw a fatal error to the effect that
 100 "it's s too late to call Pod::Simple::Debug".
 101
 102 Note that the C<use Pod::Simple::Debug (\$x, I<somenum>)> mode will make
 103 Pod::Simple (et al) run rather slower, since &Pod::Simple::DEBUG won't
 104 be a constant sub anymore, and so Pod::Simple (et al) won't compile with
 105 constant-folding.
 106
 107
 108 =head1 GUTS
 109
 110 Doing this:
 111
 112   use Pod::Simple::Debug (5);  # or some integer
 113
 114 is basically equivalent to:
 115
 116   BEGIN { sub Pod::Simple::DEBUG () {5} }  # or some integer
 117   use Pod::Simple ();
 118
 119 And this:
 120
 121   use Pod::Simple::Debug (\$debug_level,0);  # or some integer
 122
 123 is basically equivalent to this:
 124
 125   my $debug_level;
 126   BEGIN { $debug_level = 0 }
 127   BEGIN { sub Pod::Simple::DEBUG () { $debug_level }
 128   use Pod::Simple ();
 129
 130 =head1 SEE ALSO
 131
 132 L<Pod::Simple>
 133
 134 The article "Constants in Perl", in I<The Perl Journal> issue
 135 21.  See L<http://interglacial.com/tpj/21/>
 136
 137 =head1 SUPPORT
 138
 139 Questions or discussion about POD and Pod::Simple should be sent to the
 140 pod-people@perl.org mail list. Send an empty email to
 141 pod-people-subscribe@perl.org to subscribe.
 142
 143 This module is managed in an open GitHub repository,
 144 L<http://github.com/theory/pod-simple/>. Feel free to fork and contribute, or
 145 to clone L<git://github.com/theory/pod-simple.git> and send patches!
 146
 147 Patches against Pod::Simple are welcome. Please send bug reports to
 148 <bug-pod-simple@rt.cpan.org>.
 149
 150 =head1 COPYRIGHT AND DISCLAIMERS
 151
 152 Copyright (c) 2002 Sean M. Burke.
 153
 154 This library is free software; you can redistribute it and/or modify it
 155 under the same terms as Perl itself.
 156
 157 This program is distributed in the hope that it will be useful, but
 158 without any warranty; without even the implied warranty of
 159 merchantability or fitness for a particular purpose.
 160
 161 =head1 AUTHOR
 162
 163 Pod::Simple was created by Sean M. Burke <sburke@cpan.org>.
 164 But don't bother him, he's retired.
 165
 166 Pod::Simple is maintained by:
 167
 168 =over
 169
 170 =item * Allison Randal C<allison@perl.org>
 171
 172 =item * Hans Dieter Pearcey C<hdp@cpan.org>
 173
 174 =item * David E. Wheeler C<dwheeler@cpan.org>
 175
 176 =back
 177
 178 =cut