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=7acfa6d8b438a7034fda22923d0fb706813d40e2;hb=82010ea176741c7a4f2baf3f6f27377b1d9f6b15;hpb=f9bcc1280f6685f1d937688ed9c035bc9994a01e diff --git a/t/lib/TestApp/View/Dump.pm b/t/lib/TestApp/View/Dump.pm index 7acfa6d..016df81 100644 --- a/t/lib/TestApp/View/Dump.pm +++ b/t/lib/TestApp/View/Dump.pm @@ -4,49 +4,67 @@ use strict; 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}; + my $env = delete $reference->{env}; + + if (my $log = $reference->{_log}) { + $log->clear_psgi 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} ); + if ($context) { + # Repair context + $reference->{_context} = $context; + weaken( $reference->{_context} ); + } + + if ($body) { + # Repair body + delete $reference->{__body_type}; + $reference->{_body} = $body; + } - # Repair body - $reference->{_body} = $body; + if($env) { $reference->{env} = $env } return 1; }