File Coverage

blib/lib/Term/Emit/Format/HTML.pm

Criterion	Covered	Total	%
statement	95	96	98.9
branch	41	52	78.8
condition	1	2	50.0
subroutine	12	12	100.0
pod	1	1	100.0
total	150	163	92.0

# Term::Emit::Format::HTML - Formats Term::Emit output into HTML
#
# $Id: HTML.pm 23 2009-02-13 17:41:11Z steve $

package Term::Emit::Format::HTML;
use warnings;
use strict;
use 5.008;

our $VERSION = '0.0.2';
use Exporter;
use base qw/Exporter/;
our @EXPORT_OK = qw/format_html/;
our %EXPORT_TAGS = (all => [@EXPORT_OK]);

sub format_html {
    my $opts = ref $_[0] eq 'HASH' ? shift : {};
    my $text = shift;
    my @lines = split(/\n/, $text);
    my %indent_index = ();
    my $prior_ix = 0;
    my $prior_he = 0;
    my $blob = q{};
    my @blobs = ();
    foreach my $line (@lines) {
        $line = _clean_line($line);
        next if length $line == 0;
        my $blip = _extract_blip($line);
        my $he = _has_ellipsis($line);
        my $st = _has_status($line);
        my $ix = _amount_of_indentation($line);
        $indent_index{$ix}++;

        # Level changed (with or without status): a blob transition
        if ($ix != $prior_ix) {
            # Close off prior blob
            push @blobs, {-indent => $prior_ix,
                          -status => undef,
                          -style  => $prior_he? 'h' : 'p',
                          -text   => $blob,
                         } if length $blob;

            # Start this blob
            $blob = $blip;
            $prior_ix = $ix;

            # Finish it now?
            if ($st) {
                # Look back to close the balancing open
                my $info = _find_rollback($blob, $ix, \@blobs);
                if ($info) {
                    $info->{-status} = $st;
                }
                else {
                    push @blobs, {-indent => $ix,
                                -status => $st,
                                -style  => 'h',
                                -text   => $blob,
                                } if length $blob;
                }
                $blob = q{};
            }
            elsif ($he) {
                push @blobs, {-indent => $ix,
                              -status => undef,
                              -style  => 'h',
                              -text   => $blob,
                             } if length $blob;
                $blob = q{};
            }
        }

        # Same level, has status - add to & finish a multiline wrap
        elsif ($st) {
            $blob .= q{ } if length $blob;
            $blob .= $blip;
            if (length $blob) {
                push @blobs, {-indent => $ix,
                              -status => $st,
                              -style  => 'h',
                              -text   => $blob,
                             };
                $blob = q{};
            }
        }

        # Same level, no status, just ellipsis - add to & finish the prior blob
        elsif ($he) {
            $blob .= q{ } if length $blob;
            $blob .= $blip;
            if (length $blob) {
                push @blobs, {-indent => $ix,
                              -status => undef,
                              -style  => 'h',
                              -text   => $blob,
                             };
                $blob = q{};
            }
        }

        # Same level, no status, no ellipsis - we are continuing the prior blob
        else {
            $blob .= q{ } if length $blob;
            $blob .= $blip;
        }

        $prior_he = $he;
    }

    # Anything left over?
    push @blobs, {-indent => $prior_ix,
                  -status => undef,
                  -style  => $prior_he? 'h' : 'p',
                  -text   => $blob,
                 } if length $blob;

    # Determine levels from indentation
    my $lev = 0;
    foreach my $ix (sort {$a <=> $b} keys %indent_index) {
        $indent_index{$ix} = ++$lev;
    }

    # Make the HTML
    my $html = q{};
    foreach my $b (@blobs) {
        my $level = $indent_index{$b->{-indent}} || 0;
        $html .= q{  } x $level;
        if ($b->{-style} eq 'h') {
            ### TODO: handle levels > 6
            $html .= qq{
            if ($b->{-status}) {
                my $cls = lc $b->{-status};
                $html .= qq{ class="$cls"};
            }
            $html .= qq{>$b->{-text}};
            $html .= qq{\n};
        }
        else {
            $html .= qq{$b->{-text}\n};
        }
    }

    return $html;
}

sub _amount_of_indentation {
    my $line = shift;
    return length $1 if $line =~ m{^(\s+)\S}sxm;
    return 0;
}

sub _clean_line {
    my $line = shift;

    # Remove bullets
    $line =~ s{^\s?[\#\@\*\+\-\.]}{}sxm;

    # Remove backspaced-over content
    while ($line =~ s{[^\010]\010}{}sxm) {};

    # Trim trailing only
    $line =~ s{\s+$}{}sxm;
    return $line;
}

sub _extract_blip {
    my $line = shift;   # presumes already cleaned line
    return q{}
        unless $line =~ m{\s*               # Skip leading space
                          (.+?)             # The blob we want
                          \s*               # Possible trailing space
                          (\.\.\.           # Maybe ellipsis
                            .*?             # Maybe anything else, like prog/over
                            (\s\[\S+\])?    # with  [STAT]
                          )?$               # to end of line
                         }sxm;
    return $1;
}

sub _find_rollback {
    my ($blob, $ix, $blobs) = @_;
    foreach my $b (reverse @{$blobs}) {
        if ($b->{-indent} == $ix) {
            return $b
                if $b->{-text} eq $blob;
            last;
        }
    }
    return 0;
}

sub _has_ellipsis {
    my $line = shift;
    return $line =~ m{[^\.]                 # Any non-dot
                        \.\.\.              # Then three dots in a row
                        (.+?                # Maybe anything else
                            (\s\[\S+\])?    # with  [STAT]
                        )?$                 # to end of line
                      }sxm;
}

sub _has_status {
    my $line = shift;
    return $line =~ m{\s\[(\S+)\]$}sxm? $1 : 0;
}

1;
__END__