File Coverage

blib/lib/Data/Format/Pretty/HTML.pm

Criterion	Covered	Total	%
statement	80	83	96.3
branch	11	14	78.5
condition	7	10	70.0
subroutine	16	18	88.8
pod	1	3	33.3
total	115	128	89.8

package Data::Format::Pretty::HTML;

use 5.010001;
use strict;
use warnings;
use Log::Any '$log';

use Data::Format::Pretty::Console 0.24;
use HTML::Entities;
use Scalar::Util qw(looks_like_number);
use URI::Find::Schemeless;
use YAML::Any;

require Exporter;
our @ISA = qw(Exporter Data::Format::Pretty::Console);
our @EXPORT_OK = qw(format_pretty);

our $VERSION = '0.09'; # VERSION

sub content_type { "text/html" }

sub format_pretty {
    my ($data, $opts) = @_;
    $opts //= {};
    __PACKAGE__->new($opts)->_format($data);
}

# OO interface is hidden
sub new {
    my ($class, $opts) = @_;
    my $obj = $class->SUPER::new($opts);
    #my $obj = Data::Format::Pretty::Console->new($opts);
    $obj->{opts}{linkify_urls_in_text} //= 1;
    $obj->{opts}{interactive} = 1;
    $obj->{opts}{list_max_columns} = 1;
    #bless $class, $obj;
    $obj;
}

sub _htmlify {
    my ($self, $text) = @_;

    $text = encode_entities($text);
    if ($self->{opts}{linkify_urls_in_text}) {
        URI::Find::Schemeless->new(
            sub {
                #my $uri = encode_entities $_[0];
                #my $uri = $_[0];
                my $uri = decode_entities $_[0];
                return qq|$uri|;
            })->find(\$text);
    }
    if ($text =~ /\R/) {
        return "$text";
    } else {
        return $text;
    }
}

sub _render_table {
    my ($self, $t) = @_;
    my @t = ("\n"); \n"; "; \n"; \n"; \n"; "; "; ", \n"; \n"; 




63




 





 





 





 





 





 



   




64




3





 





 





 





 





8



     my $sh = $t->{at_opts}{show_header}; 




65




3




  
100
  



  
 66
  




 





 





17



     unless (defined($sh) && !$sh) { 




66




2





 





 





 





 





5



         push @t, "  




67




2





 





 





 





 





4



         push @t, "    




68




2





 





 





 





 





2



         for my $c (@{$t->{cols}}) { 




 




2





 





 





 





 





6



   




69




3




  
 50
  




 





 





 





55



             push @t, ( 




70




 





 





 





 





 





 



                 "", 




71




 





 





 





 





 





 



                 $self->_htmlify($c), 




72




 





 





 





 





 





 



                 "", 




73




 





 





 





 





 





 



             ); 




74




 





 





 





 





 





 



         } 




75




2





 





 





 





 





4



         push @t, "




76




2





 





 





 





 





4



         push @t, "  




77




 





 





 





 





 





 



     } 




78




 





 





 





 





 





 



   




79




3





 





 





 





 





8



     push @t, "  




80




3





 





 





 





 





5



     for my $r (@{$t->{rows}}) { 




 




3





 





 





 





 





9



   




81




5





 





 





 





 





8



         push @t, "    




82




5





 





 





 





 





29



         my $cidx = 0; 




83




5





 





 





 





 





9



         for my $c (@$r) { 




84




7




  
100
  



  
100
  




 





 





37



             if ($t->{html_cols} && $t->{html_cols}[$cidx]) { 




85




2





 





 





 





 





14



                 push @t, "", $c, "




86




 





 





 





 





 





 



             } else { 




87




5




  
100
  




 





 





 





27



                 push @t, ( 




88




 





 





 





 





 





 



                     "", 




89




 





 





 





 





 





 



                     $self->_htmlify($c), 




90




 





 





 





 





 





 



                     "




91




 





 





 





 





 





 



                 ); 




92




 





 





 





 





 





 



             } 




93




7





 





 





 





 





21



             $cidx++; 




94




 





 





 





 





 





 



         } 




95




5





 





 





 





 





13



         push @t, "




96




 





 





 





 





 





 



     } 




97




3





 





 





 





 





6



     push @t, "  




98




3





 





 





 





 





6



     push @t, "\n";

    my $sh = $t->{at_opts}{show_header};
    unless (defined($sh) && !$sh) {
        push @t, "
        push @t, "
        for my $c (@{$t->{cols}}) {
            push @t, (
                "",
                $self->_htmlify($c),
                "",
            );
        }
        push @t, "
        push @t, "
    }

    push @t, "
    for my $r (@{$t->{rows}}) {
        push @t, "
        my $cidx = 0;
        for my $c (@$r) {
            if ($t->{html_cols} && $t->{html_cols}[$cidx]) {
                push @t, "
            } else {
                push @t, (
                    "",
                    $self->_htmlify($c),
                    "
                );
            }
            $cidx++;
        }
        push @t, "
    }
    push @t, "
    push @t, "
    join "", @t;
}

# format unknown structure, the default is to dump YAML structure
sub _format_unknown {
    my ($self, $data) = @_;
    $self->_htmlify(Dump $data);
}

sub _format_scalar {
    my ($self, $data) = @_;

    my $sdata = defined($data) ? "$data" : "";
    $self->_htmlify($sdata);
}

sub _format_hot {
    my ($self, $data) = @_;
    my @t;
    # format as 2-column table of key/value
    my $t = {cols=>[qw/key value/], html_cols=>[0, 1], rows=>[]};
    for my $k (sort keys %$data) {
        push @{ $t->{rows} }, [$k, $self->_format($data->{$k})];
    }
    $self->_render_table($t);
}

1;
# ABSTRACT: Pretty-print data structure for HTML output

__END__