CGI::Ex 2.08

[chaz/p5-CGI-Ex] / lib / CGI / Ex / Dump.pm

diff --git a/lib/CGI/Ex/Dump.pm b/lib/CGI/Ex/Dump.pm
index fd762913ed77fa99b799c7dac29d12d1f247f314..bffe94d37ee6e839a9b21fabf5d031c90e7c3fc3 100644 (file)
--- a/lib/CGI/Ex/Dump.pm
+++ b/lib/CGI/Ex/Dump.pm
@@ -1,41 +1,46 @@
 package CGI::Ex::Dump;
 
-### CGI Extended Data::Dumper Extension
+=head1 NAME
+
+CGI::Ex::Dump - A debug utility
+
+=cut
 
 ###----------------------------------------------------------------###
-#  Copyright 2004 - Paul Seamons                                     #
+#  Copyright 2007 - Paul Seamons                                     #
 #  Distributed under the Perl Artistic License without warranty      #
 ###----------------------------------------------------------------###
 
-### See perldoc at bottom
-
-use vars qw(@ISA @EXPORT @EXPORT_OK $ON $SUB $QR1 $QR2 $full_filename);
+use vars qw(@ISA @EXPORT @EXPORT_OK $VERSION
+            $CALL_LEVEL
+            $ON $SUB $QR1 $QR2 $full_filename $DEPARSE);
 use strict;
 use Exporter;
 
+$VERSION   = '2.08';
 @ISA       = qw(Exporter);
 @EXPORT    = qw(dex dex_warn dex_text dex_html ctrace dex_trace);
-@EXPORT_OK = qw(dex dex_warn dex_text dex_html ctrace dex_trace debug what_is_this);
+@EXPORT_OK = qw(dex dex_warn dex_text dex_html ctrace dex_trace debug);
 
 ### is on or off
 sub on  { $ON = 1 };
 sub off { $ON = 0; }
-&on();
 
-sub set_deparse {
-  $Data::Dumper::Deparse = eval {require B::Deparse};
-}
+sub set_deparse { $DEPARSE = 1 }
 
 ###----------------------------------------------------------------###
 
 BEGIN {
-  ### setup the Data::Dumper usage
-  $Data::Dumper::Sortkeys  = 1    if ! defined $Data::Dumper::Sortkeys; # not avail pre 5.8
-  $Data::Dumper::Useqq     = 1    if ! defined $Data::Dumper::Useqq;
-  $Data::Dumper::Quotekeys = 0    if ! defined $Data::Dumper::Quotekeys;
-  $Data::Dumper::Pad       = '  ' if ! defined $Data::Dumper::Pad;
-  #$Data::Dumper::Deparse   = 1    if ! defined $Data::Dumper::Deparse; # very useful
+  on();
+
   $SUB = sub {
+    ### setup the Data::Dumper usage
+    local $Data::Dumper::Deparse   = $DEPARSE && eval {require B::Deparse};
+    local $Data::Dumper::Pad       = '  ';
+    local $Data::Dumper::Sortkeys  = 1;
+    local $Data::Dumper::Useqq     = 1;
+    local $Data::Dumper::Quotekeys = 0;
+
     require Data::Dumper;
     return Data::Dumper->Dumpperl(\@_);
   };
@@ -50,11 +55,10 @@ BEGIN {
 
 ### same as dumper but with more descriptive output and auto-formatting
 ### for cgi output
-sub what_is_this {
+sub _what_is_this {
   return if ! $ON;
   ### figure out which sub we called
-  my ($pkg, $file, $line_n, $called) = caller(0);
-  ($pkg, $file, $line_n, $called) = caller(1) if $pkg eq __PACKAGE__;
+  my ($pkg, $file, $line_n, $called) = caller(1 + ($CALL_LEVEL || 0));
   substr($called, 0, length(__PACKAGE__) + 2, '');
 
   ### get the actual line
@@ -72,9 +76,13 @@ sub what_is_this {
   ### dump it out
   my @dump = map {&$SUB($_)} @_;
   my @var  = ('$VAR') x ($#dump + 1);
-  if ($line =~ s/^ .*\b \Q$called\E ( \(?\s* | \s+ )//x
-      && $line =~ s/(?:\s+if\s+.+)? ;? \s*$//x) {
-    $line =~ s/ \s*\) $ //x if $1 && $1 =~ /\(/;
+  my $hold;
+  if ($line =~ s/^ .*\b \Q$called\E ( \s* \( \s* | \s+ )//x
+      && ($hold = $1)
+      && (   $line =~ s/ \s* \b if \b .* \n? $ //x
+          || $line =~ s/ \s* ; \s* $ //x
+          || $line =~ s/ \s+ $ //x)) {
+    $line =~ s/ \s*\) $ //x if $hold =~ /^\s*\(/;
     my @_var = map {/^[\"\']/ ? 'String' : $_} split (/\s*,\s*/, $line);
     @var = @_var if $#var == $#_var;
   }
@@ -92,27 +100,27 @@ sub what_is_this {
     elsif ($called eq 'dex_warn') { warn  $txt  }
     else                          { print $txt  }
   } else {
-    my $html = "<pre><b>$called: $file line $line_n</b>\n";
+    my $html = "<pre class=debug><span class=debughead><b>$called: $file line $line_n</b></span>\n";
     for (0 .. $#dump) {
       $dump[$_] =~ s/\\n/\n/g;
       $dump[$_] = _html_quote($dump[$_]);
-      $dump[$_] =~ s|\$VAR1|<b>$var[$_]</b>|g;
+      $dump[$_] =~ s|\$VAR1|<span class=debugvar><b>$var[$_]</b></span>|g;
       $html .= $dump[$_];
     }
     $html .= "</pre>\n";
     return $html if $called eq 'dex_html';
     require CGI::Ex;
-    &CGI::Ex::print_content_type();
+    CGI::Ex::print_content_type();
     print $html;
   }
 }
 
 ### some aliases
-sub debug    { &what_is_this }
-sub dex      { &what_is_this }
-sub dex_warn { &what_is_this }
-sub dex_text { &what_is_this }
-sub dex_html { &what_is_this }
+sub debug    { &_what_is_this }
+sub dex      { &_what_is_this }
+sub dex_warn { &_what_is_this }
+sub dex_text { &_what_is_this }
+sub dex_html { &_what_is_this }
 
 sub _html_quote {
   my $value = shift;
@@ -135,7 +143,7 @@ sub ctrace {
   my $max1 = 0;
   my $max2 = 0;
   my $max3 = 0;
-  while (my %i = &Carp::caller_info(++$i)) {
+  while (my %i = Carp::caller_info(++$i)) {
     $i{sub_name} =~ s/\((.*)\)$//;
     $i{args} = $i{has_args} ? $1 : "";
     $i{sub_name} =~ s/^.*?([^:]+)$/$1/;
@@ -153,7 +161,7 @@ sub ctrace {
 }
 
 sub dex_trace {
-  &what_is_this(ctrace(1));
+  _what_is_this(ctrace(1));
 }
 
 ###----------------------------------------------------------------###
@@ -162,10 +170,6 @@ sub dex_trace {
 
 __END__
 
-=head1 NAME
-
-CGI::Ex::Dump - A debug utility
-
 =head1 SYNOPSIS
 
   use CGI::Ex::Dump; # auto imports dex, dex_warn, dex_text and others