view release on metacpan or  search on metacpan

lib/YAML/PP/Highlight.pm  view on Meta::CPAN

    QUESTION => 'question',
    YAML_DIRECTIVE => 'yaml_directive',
    TAG_DIRECTIVE => 'tag_directive',
    TAG => 'tag',
    COMMENT => 'comment',
    LITERAL => 'literal',
    FOLDED => 'folded',
    DOC_START => 'doc_start',
    DOC_END => 'doc_end',
    BLOCK_SCALAR_CONTENT => 'block_scalar_content',
    TAB => 'tab',
    ERROR => 'error',
    EOL => 'eol',
    TRAILING_SPACE => 'trailing_space',
    FLOWSEQ_START => 'flowseq_start',
    FLOWSEQ_END => 'flowseq_end',
    FLOWMAP_START => 'flowmap_start',
    FLOWMAP_END => 'flowmap_end',
    FLOW_COMMA => 'flow_comma',
    PLAINKEY => 'plainkey',
    NOEOL => 'noeol',
);
sub htmlcolored {
    require HTML::Entities;
    my ($class, $tokens) = @_;
    my $html = '';
    my @list = $class->transform($tokens);
    for my $token (@list) {
        my $name = $token->{name};
        my $str = $token->{value};
        my $colorclass = $htmlcolors{ $name } || 'default';
        $str = HTML::Entities::encode_entities($str);
        $html .= qq{<span class="$colorclass">$str</span>};
    }
    return $html;
}

sub transform {
    my ($class, $tokens) = @_;
    my @list;
    for my $token (@$tokens) {
        my @values;
        my $value = $token->{value};
        my $subtokens = $token->{subtokens};
        if ($subtokens) {
            @values = @$subtokens;
        }
        else {
            @values = $token;
        }
        for my $token (@values) {
            my $value = defined $token->{orig} ? $token->{orig} : $token->{value};
            if ($token->{name} eq 'EOL' and not length $value) {
                push @list, { name => 'NOEOL', value => '' };
                next;
            }
            push @list, map {
                    $_ =~ tr/\t/\t/
                    ? { name => 'TAB', value => $_ }
                    : { name => $token->{name}, value => $_ }
                } split m/(\t+)/, $value;
        }
    }
    for my $i (0 .. $#list) {
        my $token = $list[ $i ];
        my $name = $token->{name};
        my $str = $token->{value};
        my $trailing_space = 0;
        if ($token->{name} eq 'EOL') {
            if ($str =~ m/ +([\r\n]|\z)/) {
                $token->{name} = "TRAILING_SPACE";
            }
        }
        elsif ($i < $#list) {
            if ($name eq 'PLAIN') {
                for my $n ($i+1 .. $#list) {
                    my $next = $list[ $n ];
                    last if $next->{name} eq 'EOL';
                    next if $next->{name} =~ m/^(WS|SPACE)$/;
                    if ($next->{name} eq 'COLON') {
                        $token->{name} = 'PLAINKEY';
                    }
                }
            }
            my $next = $list[ $i + 1];
            if ($next->{name} eq 'EOL') {
                if ($str =~ m/ \z/ and $name =~ m/^(BLOCK_SCALAR_CONTENT|WS|INDENT)$/) {
                    $token->{name} = "TRAILING_SPACE";
                }
            }
        }
    }
    return @list;
}

1;

__END__

=pod

=encoding utf-8

=head1 NAME

YAML::PP::Highlight - Syntax highlighting utilities

=head1 SYNOPSIS


    use YAML::PP::Highlight qw/ Dump /;

    my $highlighted = Dump $data;

=head1 FUNCTIONS

=over

=item Dump

=back