File: Dump.pm

package info (click to toggle)
libcatalyst-perl 5.90015-1
  • links: PTS, VCS
  • area: main
  • in suites: wheezy
  • size: 2,352 kB
  • sloc: perl: 16,643; makefile: 9
file content (67 lines) | stat: -rw-r--r-- 1,486 bytes parent folder | download
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
package TestApp::View::Dump;

use strict;
use base 'Catalyst::View';

use Data::Dumper ();
use Scalar::Util qw(blessed weaken);

sub dump {
    my ( $self, $reference, $purity ) = @_;

    return unless $reference;

    $purity = defined $purity ? $purity : 1;

    my $dumper = Data::Dumper->new( [$reference] );
    $dumper->Indent(1);
    $dumper->Purity($purity);
    $dumper->Useqq(0);
    $dumper->Deepcopy(1);
    $dumper->Quotekeys(0);
    $dumper->Terse(1);

    local $SIG{ __WARN__ } = sub { warn unless $_[ 0 ] =~ m{dummy} };
    return $dumper->Dump;
}

sub process {
    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};

    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;
        }

        return 1;
    }

    return 0;
}

1;