[Summary view] [Print] [Text view]

   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
 133  21.  See L<http://www.sysadminmag.com/tpj/issues/vol5_5/>
 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