Commit | Line | Data |
---|---|---|
fbcc39ad | 1 | package TestApp::View::Dump; |
2 | ||
3 | use strict; | |
ae0e35ee | 4 | use base 'Catalyst::View'; |
fbcc39ad | 5 | |
6 | use Data::Dumper (); | |
610bc6ec | 7 | use Scalar::Util qw(blessed weaken); |
fbcc39ad | 8 | |
9 | sub dump { | |
9310b818 | 10 | my ( $self, $reference, $purity ) = @_; |
fbcc39ad | 11 | |
12 | return unless $reference; | |
13 | ||
6721fe5a | 14 | $purity = defined $purity ? $purity : 1; |
9310b818 | 15 | |
fbcc39ad | 16 | my $dumper = Data::Dumper->new( [$reference] ); |
17 | $dumper->Indent(1); | |
9310b818 | 18 | $dumper->Purity($purity); |
fbcc39ad | 19 | $dumper->Useqq(0); |
20 | $dumper->Deepcopy(1); | |
a54d8c48 | 21 | $dumper->Quotekeys(1); |
fbcc39ad | 22 | $dumper->Terse(1); |
23 | ||
0a1a7923 | 24 | local $SIG{ __WARN__ } = sub { warn unless $_[ 0 ] =~ m{dummy} }; |
fbcc39ad | 25 | return $dumper->Dump; |
26 | } | |
27 | ||
28 | sub process { | |
9310b818 | 29 | my ( $self, $c, $reference, $purity ) = @_; |
fbcc39ad | 30 | |
31 | # Force processing of on-demand data | |
32 | $c->prepare_body; | |
33 | ||
fbcc39ad | 34 | # Remove body from reference if needed |
610bc6ec | 35 | $reference->{__body_type} = blessed $reference->body |
36 | if (blessed $reference->{_body}); | |
fbcc39ad | 37 | my $body = delete $reference->{_body}; |
38 | ||
610bc6ec | 39 | # Remove context from reference if needed |
40 | my $context = delete $reference->{_context}; | |
41 | ||
952ff530 | 42 | my $env = delete $reference->{env}; |
43 | ||
0eb98ebd | 44 | if (my $log = $reference->{_log}) { |
a273dd58 | 45 | $log->clear_psgi if ($log->can('psgienv')); |
0eb98ebd | 46 | } |
47 | ||
fbcc39ad | 48 | if ( my $output = |
9310b818 | 49 | $self->dump( $reference, $purity ) ) |
fbcc39ad | 50 | { |
51 | ||
52 | $c->res->headers->content_type('text/plain'); | |
53 | $c->res->output($output); | |
54 | ||
c3fd63d4 | 55 | if ($context) { |
56 | # Repair context | |
57 | $reference->{_context} = $context; | |
58 | weaken( $reference->{_context} ); | |
59 | } | |
60 | ||
61 | if ($body) { | |
62 | # Repair body | |
63 | delete $reference->{__body_type}; | |
64 | $reference->{_body} = $body; | |
65 | } | |
fbcc39ad | 66 | |
952ff530 | 67 | if($env) { $reference->{env} = $env } |
68 | ||
fbcc39ad | 69 | return 1; |
70 | } | |
71 | ||
72 | return 0; | |
73 | } | |
74 | ||
75 | 1; |