view release on metacpan or  search on metacpan

lib/Dancer/Error.pm  view on Meta::CPAN

sub tabulate {
    my ($number, $max) = @_;
    my $len = length($max);
    return $number if length($number) == $len;
    return " $number";
}

sub dumper {
    my $obj = shift;
    return "Unavailable without Data::Dumper"
      unless Dancer::ModuleLoader->load('Data::Dumper');


    # Take a copy of the data, so we can mask sensitive-looking stuff:
    my $data     = Dancer::ModuleLoader->load('Clone') ?
                   Clone::clone($obj)
                   : eval Data::Dumper->new([$obj])->Purity(1)->Terse(1)->Deepcopy(1)->Dump;

    $data = {%$data} if blessed($data); 

	my $censored = _censor($data);

    #use Data::Dumper;
    my $dd = Data::Dumper->new([$data]);
    $dd->Terse(1)->Quotekeys(0)->Indent(1)->Sortkeys(1);
    my $content = $dd->Dump();
    $content =~ s{(\s*)(\S+)(\s*)=>}{$1<span class="key">$2</span>$3 =&gt;}g;
    if ($censored) {
        $content
            .= "\n\nNote: Values of $censored sensitive-looking key"
            . ($censored == 1 ? '' : 's')
            . " hidden\n";
    }
    return $content;
}

# Given a hashref, censor anything that looks sensitive.  Returns number of
# items which were "censored".
sub _censor {
    my ( $hash, $recursecount ) = @_;
    $recursecount ||= 0;

    # we're checking recursion ourselves, no need to warn
    no warnings 'recursion';

    if ( $recursecount++ > 100 ) {
        warn "Data exceeding 100 levels, truncating\n";
        return $hash;
    }

    if (!$hash || ref $hash ne 'HASH') {
        carp "_censor given incorrect input: $hash";
        return;
    }

    my $censored = 0;
    for my $key (keys %$hash) {
        if (ref $hash->{$key} eq 'HASH') {
            $censored += _censor( $hash->{$key}, $recursecount );
        }
        elsif ($key =~ /(pass|card?num|pan|cvv2?|ccv|secret|private_key|cookie_key)/i) {
            $hash->{$key} = "Hidden (looks potentially sensitive)";
            $censored++;
        }
    }

    return $censored;
}

# Replaces the entities that are illegal in (X)HTML.
sub _html_encode {
    my $value = shift;

    $value =~ s/&/&amp;/g;
    $value =~ s/</&lt;/g;
    $value =~ s/>/&gt;/g;
    $value =~ s/'/&#39;/g;
    $value =~ s/"/&quot;/g;

    return $value;
}

sub render {
    my $self = shift;

    my $serializer = setting('serializer');
    my $ops = { title => $self->title,
		message => $self->message,
		code => $self->code,
		defined $self->exception ? ( exception => $self->exception ) : (),
	      };
    Dancer::Factory::Hook->instance->execute_hooks('before_error_render', $self, $ops);
    my $response;
    try {
        $response = $serializer ? $self->_render_serialized($ops) : $self->_render_html($ops);
    } continuation {
        my ($continuation) = @_;
        # If we have a Route continuation, run the after hook, then
        # propagate the continuation
        Dancer::Factory::Hook->instance->execute_hooks('after_error_render', $response);
        $continuation->rethrow();
    };
    Dancer::Factory::Hook->instance->execute_hooks('after_error_render', $response);
    $response;
}

sub _render_serialized {
    my $self = shift;

    my $message =
      !ref $self->message ? {error => $self->message} : $self->message;

    if (ref $message eq 'HASH' && defined $self->exception) {
        if (blessed($self->exception)) {
            $message->{exception} = ref($self->exception);
            $message->{exception} =~ s/^Dancer::Exception:://;
        } else {
            $message->{exception} = $self->exception;
        }
    }