Frey/View/Dumper.pm

package Frey::View::Dumper;
use Moose;

extends 'Frey';
with 'Frey::Web';

use Data::Dump qw/dump/;
use POSIX qw/strftime/;
use DateTime;

=head1 DESCRIPTION

dump C<data> as html tree

=cut

has data => (
        is => 'rw',
        required => 1,
        documentation => "input data",
);

sub as_markup {
        my ($self) = @_;
        qq|<div class="frey-dumper">| . $self->unroll( $self->data ) . qq|</div>|;
}

sub unroll {
        my ($self,$data,$ref,$key) = @_;
        my $out;
        my $title = $ref ? qq| title="$ref"| : '';

        $out .= qq|<li${title}>|;
        my $mark = $key || '&diams;';
        $out .= $ref && $ref !~ m{^(ARRAY|HASH)$} ? qq|<a href="/$ref" class="blessed" target="blessed" title="$ref">$mark</a>| : ( $key || '' );

        if ( ref($data) eq 'ARRAY' ) {
                $out .= " &darr;</li>" if $key;
                $out .= qq|<ol${title} start=0>\n|;
                $out .= $self->unroll($_,ref($_)) foreach @$data;
                $out .= "</ol>\n";
        } elsif ( ref($data) && eval { %$data } ) {
                $out .= " &darr;</li>" if $key;
                $out .= qq|<ul${title}>\n|;
                $out .= $self->unroll($data->{$_},ref($data->{$_}),$_) foreach keys %$data;
                $out .= "</ul>\n";
        } else {
                $out .= " &rarr; " if $key;
                if ( defined $data && $data =~ m{<(\w+).*>.+</\1>} ) {
                        $out .= qq|<div style="background: #eee; color: #000" title="HTML">$data</div></li>|;
                } elsif ( $data =~ m{^(\d+(?:\.\d+)?)$} && $1 <= time() ) {
                        $out .= qq|<span title="| . DateTime->from_epoch( epoch => $1 ) . qq|">$data</span>|;
                } else {
                        $out .= "<span>" . $self->html_dump( $data ) . "</span></li>";
                }
        }
        $out .= "</li>";

        return $out;
}

__PACKAGE__->meta->make_immutable;
no Moose;

1;
1	dpavlin	467	package Frey::View::Dumper;
2	dpavlin	287	use Moose;
3
4	dpavlin	467	extends 'Frey';
5	dpavlin	455	with 'Frey::Web';
6	dpavlin	327
7	dpavlin	325	use Data::Dump qw/dump/;
8	dpavlin	563	use POSIX qw/strftime/;
9			use DateTime;
10	dpavlin	325
11	dpavlin	467	=head1 DESCRIPTION
12	dpavlin	287
13	dpavlin	467	dump C<data> as html tree
14	dpavlin	287
15			=cut
16
17			has data => (
18			is => 'rw',
19			required => 1,
20	dpavlin	467	documentation => "input data",
21	dpavlin	287	);
22
23	dpavlin	455	sub as_markup {
24	dpavlin	287	my ($self) = @_;
25	dpavlin	327	qq\|<div class="frey-dumper">\| . $self->unroll( $self->data ) . qq\|</div>\|;
26			}
27	dpavlin	325
28	dpavlin	327	sub unroll {
29			my ($self,$data,$ref,$key) = @_;
30			my $out;
31			my $title = $ref ? qq\| title="$ref"\| : '';
32	dpavlin	357
33			$out .= qq\|<li${title}>\|;
34			my $mark = $key \|\| '&diams;';
35	dpavlin	367	$out .= $ref && $ref !~ m{^(ARRAY\|HASH)$} ? qq\|<a href="/$ref" class="blessed" target="blessed" title="$ref">$mark</a>\| : ( $key \|\| '' );
36	dpavlin	357
37	dpavlin	327	if ( ref($data) eq 'ARRAY' ) {
38	dpavlin	357	$out .= " ↓</li>" if $key;
39	dpavlin	329	$out .= qq\|<ol${title} start=0>\n\|;
40	dpavlin	327	$out .= $self->unroll($_,ref($_)) foreach @$data;
41	dpavlin	329	$out .= "</ol>\n";
42	dpavlin	357	} elsif ( ref($data) && eval { %$data } ) {
43			$out .= " ↓</li>" if $key;
44	dpavlin	329	$out .= qq\|<ul${title}>\n\|;
45	dpavlin	327	$out .= $self->unroll($data->{$_},ref($data->{$_}),$_) foreach keys %$data;
46	dpavlin	329	$out .= "</ul>\n";
47	dpavlin	327	} else {
48	dpavlin	357	$out .= " → " if $key;
49	dpavlin	433	if ( defined $data && $data =~ m{<(\w+).*>.+</\1>} ) {
50	dpavlin	360	$out .= qq\|<div style="background: #eee; color: #000" title="HTML">$data</div></li>\|;
51	dpavlin	563	} elsif ( $data =~ m{^(\d+(?:\.\d+)?)$} && $1 <= time() ) {
52			$out .= qq\|<span title="\| . DateTime->from_epoch( epoch => $1 ) . qq\|">$data</span>\|;
53	dpavlin	347	} else {
54			$out .= "<span>" . $self->html_dump( $data ) . "</span></li>";
55			}
56	dpavlin	325	}
57	dpavlin	357	$out .= "</li>";
58
59	dpavlin	327	return $out;
60	dpavlin	287	}
61
62	dpavlin	1133	__PACKAGE__->meta->make_immutable;
63			no Moose;
64
65	dpavlin	287	1;