]>
Dogcows Code - chaz/p5-CGI-Ex/blob - lib/CGI/Ex/Dump.pm
5 CGI::Ex::Dump - A debug utility
9 ###----------------------------------------------------------------###
10 # Copyright 2006 - 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);
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);
31 $Data::Dumper
::Deparse
= eval {require B
::Deparse
};
34 ###----------------------------------------------------------------###
37 ### setup the Data::Dumper usage
38 $Data::Dumper
::Sortkeys
= 1 if ! defined $Data::Dumper
::Sortkeys
; # not avail pre 5.8
39 $Data::Dumper
::Useqq
= 1 if ! defined $Data::Dumper
::Useqq
;
40 $Data::Dumper
::Quotekeys
= 0 if ! defined $Data::Dumper
::Quotekeys
;
41 $Data::Dumper
::Pad
= ' ' if ! defined $Data::Dumper
::Pad
;
42 #$Data::Dumper::Deparse = 1 if ! defined $Data::Dumper::Deparse; # very useful
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);
79 if ($line =~ s/^ .*\b \Q$called\E ( \(?\s* | \s+ )//x
80 && $line =~ s/(?:\s+if\s+.+)? ;? \s*$//x) {
81 $line =~ s/ \s*\) $ //x if $1 && $1 =~ /\(/;
82 my @_var = map {/^[\"\']/ ? 'String' : $_} split (/\s*,\s*/, $line);
83 @var = @_var if $#var == $#_var;
87 if ($called eq 'dex_text'
88 || $called eq 'dex_warn'
89 || ! $ENV{REQUEST_METHOD
}) {
90 my $txt = "$called: $file line $line_n\n";
92 $dump[$_] =~ s
|\
$VAR1|$var[$_]|g
;
95 if ($called eq 'dex_text') { return $txt }
96 elsif ($called eq 'dex_warn') { warn $txt }
99 my $html = "<pre class=debug><span class=debughead><b>$called: $file line $line_n</b></span>\n";
101 $dump[$_] =~ s/\\n/\n/g;
102 $dump[$_] = _html_quote
($dump[$_]);
103 $dump[$_] =~ s
|\
$VAR1|<span
class=debugvar
><b
>$var[$_]</b></span
>|g
;
107 return $html if $called eq 'dex_html';
109 CGI
::Ex
::print_content_type
();
115 sub debug
{ &_what_is_this
}
116 sub dex
{ &_what_is_this
}
117 sub dex_warn
{ &_what_is_this
}
118 sub dex_text
{ &_what_is_this
}
119 sub dex_html
{ &_what_is_this
}
123 return '' if ! defined $value;
124 $value =~ s/&/&/g;
125 $value =~ s/</</g;
126 $value =~ s/>/>/g;
127 # $value =~ s/\"/"/g;
131 ### ctrace is intended for work with perl 5.8 or higher's Carp
135 local $Carp::MaxArgNums
= 3;
136 local $Carp::MaxArgLen
= 20;
142 while (my %i = Carp
::caller_info
(++$i)) {
143 $i{sub_name
} =~ s/\((.*)\)$//;
144 $i{args
} = $i{has_args
} ? $1 : "";
145 $i{sub_name
} =~ s/^.*?([^:]+)$/$1/;
146 $i{file
} =~ s/$QR1/$1/ || $i{file
} =~ s/$QR2/$1/;
147 $max1 = length($i{sub_name
}) if length($i{sub_name
}) > $max1;
148 $max2 = length($i{file
}) if length($i{file
}) > $max2;
149 $max3 = length($i{line
}) if length($i{line
}) > $max3;
152 foreach my $ref (@i) {
153 $ref = sprintf("%-${max1}s at %-${max2}s line %${max3}s", $ref->{sub_name
}, $ref->{file
}, $ref->{line
})
154 . ($ref->{args
} ? " ($ref->{args})" : "");
160 _what_is_this
(ctrace
(1));
163 ###----------------------------------------------------------------###
171 use CGI::Ex::Dump; # auto imports dex, dex_warn, dex_text and others
174 foo => ['a', 'b', 'Foo','a', 'b', 'Foo','a', 'b', 'Foo','a'],
177 dex $hash; # or dex_warn $hash;
183 dex $hash, "hi", $hash;
185 dex \@INC; # print to STDOUT, or format for web if $ENV{REQUEST_METHOD}
187 dex_warn \@INC; # same as dex but to STDOUT
189 print FOO dex_text \@INC; # same as dex but return dump
193 use CGI::Ex::Dump qw(debug);
199 Uses the base Data::Dumper of the distribution and gives it nicer formatting - and
200 allows for calling just about anytime during execution.
202 Calling &CGI::Ex::set_deparse() will allow for dumped output of subroutines
205 perl -e 'use CGI::Ex::Dump; dex "foo";'
207 See also L<Data::Dumper>.
209 Setting any of the Data::Dumper globals will alter the output.
215 =item C<dex>, C<debug>
217 Prints out pretty output to STDOUT. Formatted for the web if on the web.
225 Return the text as a scalar.
229 Caller trace returned as an arrayref. Suitable for use like "debug ctrace".
230 This does require at least perl 5.8.0's Carp.
234 Turns calls to routines on or off. Default is to be on.
240 Paul Seamons <perlspam at seamons dot com>
This page took 0.051014 seconds and 4 git commands to generate.