HTML::FromANSI - Mark up ANSI sequences as HTML

    use HTML::FromANSI (); # avoid exports if using OO
    use Term::ANSIColor;

    my $h = HTML::FromANSI->new(
        fill_cols => 1,
    );




    $h->add_text(color('bold blue'), "This text is bold blue.");

    print $h->html;




    # you can append text in the new api:

    $h->add_text(color('bold blue'), " still blue.");

    print $h->html







    # The old API still works:

    $HTML::FromANSI::Options{fill_cols} = 1; # fill all 80 cols
    print ansi2html(color('bold blue'), "This text is bold blue.");

    use HTML::FromANSI ();

package HTML::FromANSI;
$HTML::FromANSI::VERSION = '2.03';

use strict;
use base qw/Exporter/;
use vars qw/@EXPORT @EXPORT_OK @Color %Options/;
use Term::VT102::Boundless;
use HTML::Entities;
use Scalar::Util qw(blessed reftype);
use Carp qw(croak);

@EXPORT = '&ansi2html';
@EXPORT_OK = qw|@Color %Options|;

@Color = (qw(
    black   darkred darkgreen),'#8b8b00',qw(darkblue darkmagenta darkcyan gray
    dimgray     red     green    yellow         blue     magenta     cyan white
));

%Options = (
    linewrap	=> 1,		# wrap long lines
    lf_to_crlf	=> (		# translate \n to \r\n on Unix
        $^O !~ /^(?:MSWin32|MacOS)$/
    ),
    fill_cols	=> 0,		# fill all (80) columns with space
    html_entity => 0,		# escape all HTML entities
    cols	=> 80,		# column width
    rows	=> undef,	# let ansi2html figure it out
    font_face	=> 'fixedsys, lucida console, terminal, vga, monospace',
    style	=> 'line-height: 1; letter-spacing: 0; font-size: 12pt',
    tt		=> 1,
    show_cursor	=> 0,

    terminal_class => 'Term::VT102::Boundless',
);

sub import {
    my $class = shift;
    while (my ($k, $v) = splice(@_, 0, 2)) {
        $Options{$k} = $v;
    }
    $class->export_to_level(1);
}

sub new {
    my ( $class, @args ) = @_;

    if ( @args == 1 && reftype($args[0]) eq 'HASH' ) {
        return bless { %Options, %{ $args[0] } }, $class;
    } elsif ( @args % 2 == 0 ) {
        return bless { %Options, @args }, $class;
    } else {
        croak "Constructor arguments must be an even sized list or a hash ref";
    }
}

sub _obj_args {
    if ( blessed($_[0]) and $_[0]->isa(__PACKAGE__) ) {
        return @_;
    } else {
        return ( __PACKAGE__->new(), @_ );
    }
}

sub ansi2html {
    my ( $self, @args ) = _obj_args(@_);
    $self->ansi_to_html(@args);
}

sub terminal_object {
    my ( $self, @args ) = @_;
    $self->{terminal_object} ||= $self->create_terminal_object(@args);
}

sub create_terminal_object {
    my ( $self, %args ) = @_;

    my $class = $self->{terminal_class};

    if ( $class ne 'Term::VT102::Boundless' ) {
        ( my $file = "${class}.pm" ) =~ s{::}{/}g;
        require $file;
    }

    my $vt = $class->new(
        cols => $self->{cols},
        ( defined($self->{rows}) ? ( rows => $self->{rows} ) : () ),
    );

    $vt->option_set(LINEWRAP => $self->{linewrap});
    $vt->option_set(LFTOCRLF => $self->{lf_to_crlf});

    $vt->_code_DECTCEM( $self->{show_cursor} );

    return $vt;
}

sub add_text {
    my ( $self, @lines ) = @_;
    $self->terminal_object->process($_) for @lines;
}

sub ansi_to_html {
    my ( $self, @lines ) = @_;

    $self->add_text(@lines);

    return $self->html;
}

sub html {
    my ( $self, @args ) = @_;

    my $result = $self->parse_vt($self->terminal_object);

    if (length $self->{font_face} or length $self->{style}) {
        $result = "<font face='$self->{font_face}' style='$self->{style}'>".
        $result."</font>";
    }

    $result = "<tt>$result</tt>" if $self->{tt};

    return $result;
}

sub parse_vt {
    my ( $self, $vt ) = _obj_args(@_);

    my (%prev, %this); # attributes
    my $out;

    my ($x, $y) = ($vt->x, $vt->y);

    my $total_rows = $vt->rows;

    foreach my $row_num (1 .. $total_rows) {
        local $SIG{__WARN__} = sub {}; # abandon all hope, ye who enter here

        my $row = $vt->row_text($row_num);
        my $att = $vt->row_attr($row_num);

        if ( $row_num == $total_rows and $total_rows != ($self->{rows}||0) # this is the last row
            and $row =~ /^[\s\x00]*$/s # and it's completely empty
            and !$self->{show_cursor} # and we're not showing a cursor
        ) { last } # skip it

        foreach my $col_num (0 .. length($row)) {
            my $text = substr($row, $col_num,, 1);

            @this{qw|fg bg bo fo st ul bl rv|} = $vt->attr_unpack(
                substr($att, $col_num * 2, 2)
            );

            if ($y == $row_num and $x == $col_num + 1 and $self->{show_cursor}) {
                # this block is the cursor
                @this{qw|fg bg bo bl|} = (@this{qw|bg fg bl bo|});
                $text = ' ' if $text eq '\000';
            }
            elsif ($text eq "\000") {
                next unless $self->{fill_cols};
            }

            $out .= $self->diff_attr(\%prev, \%this) . (
                ($text eq ' ' or $text eq "\000") ? '&nbsp;':
                $self->{html_entity} ? encode_entities($text)
                : encode_entities($text, '<>"&')
            );

            %prev = %this;
        }

        $out .= "<br>";
    }

    return "$out</span>";
}

sub diff_attr {
    my ($self, $prev, $this) = _obj_args(@_);
    my $out = '';

    # skip if the attributes remain unchanged
    return if %{$prev} and not scalar (grep {
            ($_->[0] ne $_->[1])
        } map {
            [ $prev->{$_}, $this->{$_} ]
        } keys %{$this}
    );

    # bold, faint, standout, underline, blink and reverse
    my ($fg, $bg, $bo, $fo, $st, $ul, $bl, $rv)
        = @{$this}{qw|fg bg bo fo st ul bl rv|};

    ($fg, $bg) = ($bg, $fg) if $rv;

    $out .= "</span>" if %{$prev};
    $out .= "<span style='";
    $out .= "color: $Color[$fg + $bo * 8]; ";
    $out .= "background: $Color[$bg + $bl * 8]; ";
    $out .= "text-decoration: underline; " if $ul;
    $out .= "'>";

    return $out;
}

1;

__END__