]>
Dogcows Code - chaz/p5-CGI-Ex/blob - lib/CGI/Ex/Dump.pm
5 CGI::Ex::Dump - A debug utility
9 ###----------------------------------------------------------------###
10 # Copyright 2004-2012 - Paul Seamons #
11 # Distributed under the Perl Artistic License without warranty #
12 ###----------------------------------------------------------------###
14 use vars
qw(@ISA @EXPORT @EXPORT_OK $VERSION
16 $ON $SUB $QR1 $QR2 $full_filename $DEPARSE);
22 @EXPORT = qw(dex dex_warn dex_text dex_html ctrace dex_trace);
23 @EXPORT_OK = qw(dex dex_warn dex_text dex_html ctrace dex_trace debug caller_trace);
29 sub set_deparse
{ $DEPARSE = 1 }
31 ###----------------------------------------------------------------###
37 ### setup the Data::Dumper usage
38 local $Data::Dumper
::Deparse
= $DEPARSE && eval {require B
::Deparse
};
39 local $Data::Dumper
::Pad
= ' ';
40 local $Data::Dumper
::Sortkeys
= 1;
41 local $Data::Dumper
::Useqq
= 1;
42 local $Data::Dumper
::Quotekeys
= 0;
45 return Data
::Dumper-
>Dumpperl(\
@_);
48 ### how to display or parse the filename
49 $QR1 = qr{\A(?:/[^/]+){2,}/(?:perl|lib)/(.+)\Z
};
50 $QR2 = qr{\A.+?([\w\.\-]+/[\w\.\-]+)\Z};
53 ###----------------------------------------------------------------###
56 ### same as dumper but with more descriptive output and auto-formatting
60 ### figure out which sub we called
61 my ($pkg, $file, $line_n, $called) = caller(1 + ($CALL_LEVEL || 0));
62 substr($called, 0, length(__PACKAGE__
) + 2, '');
64 ### get the actual line
67 $line = <IN
> for 1 .. $line_n;
71 ### get rid of extended filename
72 if (! $full_filename) {
73 $file =~ s/$QR1/$1/ || $file =~ s/$QR2/$1/;
77 my @dump = map {&$SUB($_)} @_;
78 my @var = ('$VAR') x
($#dump + 1);
80 if ($line =~ s/^ .*\b \Q$called\E ( \s* \( \s* | \s+ )//x
82 && ( $line =~ s/ \s* \b if \b .* \n? $ //x
83 || $line =~ s/ \s* ; \s* $ //x
84 || $line =~ s/ \s+ $ //x)) {
85 $line =~ s/ \s*\) $ //x if $hold =~ /^\s*\(/;
86 my @_var = map {/^[\"\']/ ? 'String' : $_} split (/\s*,\s*/, $line);
87 @var = @_var if $#var == $#_var;
91 if ($called eq 'dex_text'
92 || $called eq 'dex_warn'
93 || ! $ENV{REQUEST_METHOD
}) {
94 my $txt = "$called: $file line $line_n\n";
96 $dump[$_] =~ s
|\
$VAR1|$var[$_]|g
;
99 if ($called eq 'dex_text') { return $txt }
100 elsif ($called eq 'dex_warn') { warn $txt }
103 my $html = "<pre class=debug><span class=debughead><b>$called: $file line $line_n</b></span>\n";
105 $dump[$_] =~ s/(?<!\\)\\n/\n/g;
106 $dump[$_] = _html_quote
($dump[$_]);
107 $dump[$_] =~ s
|\
$VAR1|<span
class=debugvar
><b
>$var[$_]</b></span
>|g
;
111 return $html if $called eq 'dex_html';
113 CGI
::Ex
::print_content_type
();
120 sub debug
{ &_what_is_this
}
121 sub dex
{ &_what_is_this
}
122 sub dex_warn
{ &_what_is_this
}
123 sub dex_text
{ &_what_is_this
}
124 sub dex_html
{ &_what_is_this
}
128 return '' if ! defined $value;
129 $value =~ s/&/&/g;
130 $value =~ s/</</g;
131 $value =~ s/>/>/g;
132 # $value =~ s/\"/"/g;
136 ### ctrace is intended for work with perl 5.8 or higher's Carp
140 local $Carp::MaxArgNums
= 3;
141 local $Carp::MaxArgLen
= 20;
147 while (my %i = Carp
::caller_info
(++$i)) {
148 $i{sub_name
} =~ s/\((.*)\)$//;
149 $i{args
} = $i{has_args
} ? $1 : "";
150 $i{sub_name
} =~ s/^.*?([^:]+)$/$1/;
151 $i{file
} =~ s/$QR1/$1/ || $i{file
} =~ s/$QR2/$1/;
152 $max1 = length($i{sub_name
}) if length($i{sub_name
}) > $max1;
153 $max2 = length($i{file
}) if length($i{file
}) > $max2;
154 $max3 = length($i{line
}) if length($i{line
}) > $max3;
157 foreach my $ref (@i) {
158 $ref = sprintf("%-${max1}s at %-${max2}s line %${max3}s", $ref->{sub_name
}, $ref->{file
}, $ref->{line
})
159 . ($ref->{args
} ? " ($ref->{args})" : "");
164 *caller_trace
= \
&ctrace
;
167 _what_is_this
(ctrace
(1));
170 ###----------------------------------------------------------------###
178 use CGI::Ex::Dump; # auto imports dex, dex_warn, dex_text and others
181 foo => ['a', 'b', 'Foo','a', 'b', 'Foo','a', 'b', 'Foo','a'],
184 dex $hash; # or dex_warn $hash;
190 dex $hash, "hi", $hash;
192 dex \@INC; # print to STDOUT, or format for web if $ENV{REQUEST_METHOD}
194 dex_warn \@INC; # same as dex but to STDOUT
196 print FOO dex_text \@INC; # same as dex but return dump
200 use CGI::Ex::Dump qw(debug);
206 Uses the base Data::Dumper of the distribution and gives it nicer formatting - and
207 allows for calling just about anytime during execution.
209 Calling &CGI::Ex::set_deparse() will allow for dumped output of subroutines
212 perl -e 'use CGI::Ex::Dump; dex "foo";'
214 See also L<Data::Dumper>.
216 Setting any of the Data::Dumper globals will alter the output.
222 =item C<dex>, C<debug>
224 Prints out pretty output to STDOUT. Formatted for the web if on the web.
232 Return the text as a scalar.
236 Caller trace returned as an arrayref. Suitable for use like "debug ctrace".
237 This does require at least perl 5.8.0's Carp.
241 Turns calls to routines on or off. Default is to be on.
247 This module may distributed under the same terms as Perl itself.
251 Paul Seamons <perl at seamons dot com>
This page took 0.047996 seconds and 4 git commands to generate.