X-Git-Url: http://git.shadowcat.co.uk/gitweb/gitweb.cgi?p=catagits%2FCatalyst-Runtime.git;a=blobdiff_plain;f=t%2Flib%2FTestApp%2FView%2FDump.pm;h=016df8116ae8d0b32da943a3c64e4654ef085837;hp=9e0aa63790881c16722ff208ca2c68985657ef2c;hb=82010ea176741c7a4f2baf3f6f27377b1d9f6b15;hpb=dd4e6fd2152eea9f5b0c1f559575ced7684ef257 diff --git a/t/lib/TestApp/View/Dump.pm b/t/lib/TestApp/View/Dump.pm index 9e0aa63..016df81 100644 --- a/t/lib/TestApp/View/Dump.pm +++ b/t/lib/TestApp/View/Dump.pm @@ -1,34 +1,72 @@ package TestApp::View::Dump; use strict; -use base qw[Catalyst::Base]; +use base 'Catalyst::View'; use Data::Dumper (); +use Scalar::Util qw(blessed weaken); sub dump { - my ( $self, $reference ) = @_; + my ( $self, $reference, $purity ) = @_; return unless $reference; - my $dumper = Data::Dumper->new( [ $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}; + + my $env = delete $reference->{env}; + + if (my $log = $reference->{_log}) { + $log->clear_psgi if ($log->can('psgienv')); + } + + if ( my $output = + $self->dump( $reference, $purity ) ) + { + + $c->res->headers->content_type('text/plain'); + $c->res->output($output); + + if ($context) { + # Repair context + $reference->{_context} = $context; + weaken( $reference->{_context} ); + } + + if ($body) { + # Repair body + delete $reference->{__body_type}; + $reference->{_body} = $body; + } - if ( my $output = $self->dump( $reference || $c->stash->{dump} || $c->stash ) ) { + if($env) { $reference->{env} = $env } - $c->res->headers->content_type('text/plain'); - $c->res->output($output); - return 1; + return 1; } return 0;