X-Git-Url: http://git.shadowcat.co.uk/gitweb/gitweb.cgi?a=blobdiff_plain;f=t%2Flib%2FTestApp%2FView%2FDump.pm;h=43cc976a1a10280dff16a104538f7d17e5dd3c82;hb=0eb98ebd1624e8181a4bd88c26605f2a0f1c91d7;hp=ad0f546a8f4f5f4624692cd5f2662bedad30178e;hpb=66741f94ac93b7ba0989db3556d0e3fe36c1be87;p=catagits%2FCatalyst-Runtime.git diff --git a/t/lib/TestApp/View/Dump.pm b/t/lib/TestApp/View/Dump.pm index ad0f546..43cc976 100644 --- a/t/lib/TestApp/View/Dump.pm +++ b/t/lib/TestApp/View/Dump.pm @@ -1,52 +1,66 @@ package TestApp::View::Dump; use strict; -use base 'Catalyst::Base'; +use base 'Catalyst::View'; use Data::Dumper (); -use Scalar::Util qw(weaken); +use Scalar::Util qw(blessed weaken); sub dump { - my ( $self, $reference ) = @_; + my ( $self, $reference, $purity ) = @_; return unless $reference; + $purity = defined $purity ? $purity : 1; + my $dumper = Data::Dumper->new( [$reference] ); $dumper->Indent(1); - $dumper->Purity(1); + $dumper->Purity($purity); $dumper->Useqq(0); $dumper->Deepcopy(1); - $dumper->Quotekeys(0); + $dumper->Quotekeys(1); $dumper->Terse(1); + local $SIG{ __WARN__ } = sub { warn unless $_[ 0 ] =~ m{dummy} }; return $dumper->Dump; } sub process { - my ( $self, $c, $reference ) = @_; + my ( $self, $c, $reference, $purity ) = @_; # Force processing of on-demand data $c->prepare_body; + # Remove body from reference if needed + $reference->{__body_type} = blessed $reference->body + if (blessed $reference->{_body}); + my $body = delete $reference->{_body}; + # Remove context from reference if needed my $context = delete $reference->{_context}; - # Remove body from reference if needed - my $body = delete $reference->{_body}; + if (my $log = $reference->{_log}) { + $log->clear_psgienv if $log->can('psgienv'); + } if ( my $output = - $self->dump( $reference || $c->stash->{dump} || $c->stash ) ) + $self->dump( $reference, $purity ) ) { $c->res->headers->content_type('text/plain'); $c->res->output($output); - # Repair context - $reference->{_context} = $context; - weaken( $reference->{_context} ); - - # Repair body - $reference->{_body} = $body; + if ($context) { + # Repair context + $reference->{_context} = $context; + weaken( $reference->{_context} ); + } + + if ($body) { + # Repair body + delete $reference->{__body_type}; + $reference->{_body} = $body; + } return 1; }