Convert raw ANSI to IRC or HTML

ansi2unicode.pl

#!/usr/bin/perl

# ansi2unicode.pl
# 4/18/2007
#
# convert an ANSI file to unicode, suitable for display in irssi/mirc or html
# usage: ansi2unicode.pl inputfile [-tc] [-o outputmode] [outputfile]
#                        -t = terminal output, no color
#                        -o = output mode, currently only html and irc supported, default is irc
#                outputfile = filename to output to if html specified

use strict;
use warnings;
use Encode qw (from_to encode _utf8_on _utf8_off);
use Getopt::Long;
use Data::Dumper;

my $COLS = 80;
my $esc = "\x1b";

*color2mirc_bg = \&color2mirc_fg;

my %ans2mircmap = (
    30 => 1,
    31 => 4,
    32 => 9,
    33 => 8,
    34 => 12,
    35 => 13,
    36 => 11,
    37 => 15,
    40 => 1,                  
    41 => 5,                 
    42 => 3,                  
    43 => 7,                 
    44 => 2,                 
    45 => 6,                 
    46 => 10,                   
    47 => 14,
);

# generate background colors

$ans2mircmap{49} = 1; # default is black not white for background color

my %mirc2colormap = (
    0  => 'white',
    1  => 'black',
    2  => 'navy',
    3  => 'green',
    4  => 'red',
    5  => 'brown',
    6  => 'purple',
    7  => 'olive',
    8  => 'yellow',                  # dark yellow
    9  => 'lime',                  # ltgreen
    10 => 'teal',
    11 => 'cyan',
    12 => 'blue',                  # ltblue,
    13 => 'fuchsia',                  # pink
    14 => 'grey',
    15 => 'lightgrey',

    # extra mappings for high intensity colors to mirc
);

# normal -> high intensity colors (for ANSI 'bold')


my %color2mircmap;
@color2mircmap{values %mirc2colormap} = keys %mirc2colormap;

my $termout = 0;
my $output;
GetOptions(
    "termout|t" => \$termout,
    "cols|c=i" => \$COLS,
    "output|o=s" => \$output,
);

my $infilename = shift @ARGV;
die "Input filename required\n" unless $infilename;

my $infh;
open($infh, $infilename) or die "Could not open $infilename: $!\n";

my @map = ();
my @colormap = ();
my $row = 1;
my $col = 1;
my $temp_row = 1;
my $temp_col = 1;
my $linewrap;

while (my $ln = <$infh>) {
    next unless $ln;

    # filter out stuff we don't care about
    $linewrap ||= $ln =~ s/$esc\[.?7h//g; # enable linewrap

    # go through each character
    my $idx = 0;
    while ($ln) {
        last if $idx >= length $ln;

        my $c = substr($ln, $idx, 1);
        $idx++;

        if ($c eq $esc) {
            # escape sequence, oh noes!
            my $seq = substr($ln, $idx);
            if ($seq =~ s/^\[(\d+)?C//) {
                # move forward
                $col += $1 || 1;
            } elsif ($seq =~ s/^\[(\d+)?D//) {
                # move back
                if ($1 && $1 > 254) {
                    $col = 1;
                } else {
                    $col -= $1 || 1;
                }
            } elsif ($seq =~ s/^\[(\d+)?A//) {
                # move up
                $row -= $1 || 1;
            } elsif ($seq =~ s/^\[(\d+)?B//) {
                # move down
                $row += $1 || 1;
            } elsif ($seq =~ s/^\[(\d+)?H//) {
                # move to specific row
                $row = $1;
                $col = 1;
            } elsif ($seq =~ s/^\[(\d+);(\d+)?H//) {
                $row = $1;
                $col = $2;
            
            } elsif ($seq =~ s/^\[(\d+)m//) {
                if ($1 == 0) {
                    # reset
                    $colormap[$row][$col] = {fgcolor => 'white', bgcolor => 'black'};
                } elsif ($1 < 30) {
                    # ignore font/color attribute for now
                } elsif ($1 >= 30 && $1 < 40) {
                    $colormap[$row][$col] = {fgcolor => ans2color($1)};
                } elsif ($1 >= 40 && $1 < 50) {
                    $colormap[$row][$col] = {bgcolor => ans2color($1)};
                } else {
                    print STDERR "Unknown ANSI color code: $1\n";
                }

            } elsif ($seq =~ s/^\[(\d*);(\d*);?(\d*)m//) {
                my $color_info = {};
                my @attrs = ($1, $2, $3);
                while (@attrs) {
                    my $attr = shift @attrs;
                    next if ! defined $attr || $attr eq '';
                    if ($attr == 0) {
                        # reset
                        $color_info = {fgcolor => 'white', bgcolor => 'black'};
                    } elsif ($attr < 30) {
                        if ($attr == 1) {
                            $color_info->{bold} = 1;
                        } elsif ($attr == 5) {
                            #print STDERR "Unhandled attribute $attr\n";
                            $color_info->{bgcolor} = 'grey';
                        }
                        # other color/text attribute. ignore for now.
                    } elsif ($attr < 40) {
                        # fg
                        if($1 == 5){
                            # blinking
                            $color_info->{bgcolor} = ans2color(47);
                        }
                        $color_info->{fgcolor} = ans2color($attr);
                    } elsif ($attr < 50) {
                        #bg
                        if($1 == 5){
                            # blinking
                            $color_info->{bgcolor} = ans2color(47);
                        }
                            $color_info->{bgcolor} = ans2color($attr);
                    } else {
                        print STDERR "Unrecognized ANSI color code: $attr\n";
                    }
                }

                # don't allow white on white text

                $colormap[$row][$col] = $color_info;

            } elsif ($seq =~ s/^\[(\d*);(\d*);(\d*);?(\d*)m//) {
                my $color_info = {};
                my @attrs = ($1, $2, $3, $4);
                my $force;
                while (@attrs) {
                    my $attr = shift @attrs;
                    next if ! defined $attr || $attr eq '';

                    if ($attr == 0) {
                        # reset
                        $color_info = {fgcolor => 'white', bgcolor => 'black'};
                    } elsif ($attr < 30) {
                        if ($attr == 1) {
                            $color_info->{bold} = 1;
                        } elsif ($attr == 5) {
                            #print STDERR "Unhandled attribute $attr\n";
                           ## $color_info->{bgcolor} = 'grey';
                        }
                        # other color/text attribute. ignore for now.
                    } elsif ($attr < 40) {
                        # fg
                        $color_info->{fgcolor} = ans2color($attr);
                    } elsif ($attr < 50) {
                        #bg
                        $color_info->{bgcolor} = ans2color($attr);
                    } elsif (! $force) {
                        print STDERR "Unrecognized ANSI color code: $attr\n";
                    }
                }

                # don't allow white on white text

                $colormap[$row][$col] = $color_info;
            } elsif ($seq =~ s/^\[2J//) {
                # erase display and reset cursor... okay
                $col=1;
                $row=1;

            } elsif ($seq =~ s/^\[u//) {
                $col=$temp_col;
                $row=$temp_row;
                
            } elsif ($seq =~ s/^\[s//) {
                
                $temp_col=$col;
                $temp_row=$row;
                $col = 1;
            } else {
                print STDERR "Unrecognized ANSI escape sequence, chunk='" .
                    substr($seq, 0, 7) . "'\n";
            }
            
            # change the rest of $ln past $idx to $seq
            substr($ln, $idx) = $seq;
            
        } elsif ($c eq "\n") {
            #print "line break\n";
            $col = 1;
            $row++;
        } elsif ($c eq "\r") {
            #$col = 1;
            $col = 1;
        } else {
            # otherwise it's a normal char
           # print "Char: " . ord($c) ." ";
            cp437_to_unicode(\$c) if ord($c) > 127;
            $map[$row][$col] = $c;
            $col++;
        }
    
        if ($col >= $COLS) {
            # linewrap
            $col = $col % $COLS;
            $row++;
        }
    }
}

close $infh;

############ OUTPUT ##############
my $outfilename = shift @ARGV;
my $output_fh;
if ($outfilename) {
    open($output_fh, ">$outfilename") or die "Could not write to file $outfilename: $!\n";
} else {
    open($output_fh, ">&=", STDOUT);
}

if ($output && $output eq 'html') {
    html_output();
} elsif (! $output || $output eq 'irc') {
    # default
    irc_output();
}

close $output_fh;

sub html_output {
    print $output_fh qq {<table style="font-family: monospace; font-size: 11px;" cellspacing="0" cellpadding="0">} . "\n";

    my $rows = $row;
    my $last_style = '';
    my ($fgcolor, $bgcolor);
    my $color_info = {fgcolor => 'white', bgcolor => 'black'};

    for ($row = 0; $row <= $rows; $row++) {
        print $output_fh '<tr bgcolor="black">';

        for ($col = 0; $col < $COLS; $col++) {
            my $c = $map[$row][$col];

            if ($colormap[$row][$col]) {
                foreach my $attr (qw/ fgcolor bgcolor bold /) {
                    next unless my $newattr = $colormap[$row][$col]->{$attr};
                    $color_info->{$attr} = $newattr;
                }
            }

            $fgcolor = $color_info->{fgcolor} if $color_info->{fgcolor};
            $bgcolor = $color_info->{bgcolor} if $color_info->{bgcolor};

            if ($color_info->{bold}) {
                # bold really doesn't mean bold, it means use the high-intensity version of the color
                $fgcolor = color_hi($fgcolor);
            }

            my $char_uni_html = '';

            my ($td_fgcolor, $td_bgcolor);

            # look up $c's unicode value
            if (! defined $c) {
                # no char, make this a blank cell
                $bgcolor = '#000';
                $char_uni_html = '&nbsp;';
            } elsif ($c eq ' ') {
                # turn space into nbsp
                $char_uni_html = '&nbsp;';
            } else {
                # convert char to unicode
                cp437_to_unicode(\$c);
                _utf8_on($c);
                $char_uni_html = '&#' . ord($c) . ';';
            }

            $td_fgcolor ||= qq{ style="color: $fgcolor"};
            $td_bgcolor ||= qq{ bgcolor="$bgcolor"};

            $td_bgcolor = '' if $bgcolor eq '#000' || $bgcolor eq 'black';

            print $output_fh "<td$td_bgcolor$td_fgcolor>$char_uni_html</td>";
        }

        print $output_fh "</tr>\n";
    }

    print $output_fh "</table>\n";
}

sub irc_output {
    my $rows = $row;
    my $lastcolor;
    my $ret;
    my $last_c;

    $ret .= colorinfo2mirc({fgcolor => "white", bgcolor => "black"});
    my $color_info;
    my $mirc_color;
    my $last_color;

    for ($row = 1; $row <= $rows; $row++) {

        for ($col = 1; $col < $COLS; $col++) {
            if ($colormap[$row][$col]) {
                foreach my $attr (qw/ fgcolor bgcolor bold /) {
                    my $newattr = $colormap[$row][$col]->{$attr};
                    next unless defined $newattr;
                    $color_info->{$attr} = $newattr;
                }
            }

            my $c = $map[$row][$col];
            
            if (defined $c) {
                $mirc_color = colorinfo2mirc($color_info);

                # print out new color code if we have a new color
                if (($mirc_color && ! $last_color) || ($last_color && $mirc_color && $mirc_color ne $last_color)){
                    $ret .= "$mirc_color";
                }
                $last_color = $mirc_color;
                # output char
                $ret .= $c;
            } else {
                if(defined $last_c){
                    $ret .= colorinfo2mirc({fgcolor => "white", bgcolor => "black"});
                    $last_color = colorinfo2mirc({fgcolor => "white", bgcolor => "black"});
                    $ret .= " ";
                }
                else{
                    $ret .= " ";
                }
            }
            $last_c = $c;
        }

        $ret .= "\n";

        # new line, keep last color
        $ret .= "$last_color" if $last_color;
    }

    # dont output utf8 to irssi/whatever, it won't be happy
    #_utf8_off($ret);

    my @lines = split("\n", $ret);
    foreach my $line (@lines) {
        if(length($line)+45 > 450){
            $line = substr $line,1,400;
        }
        if($line =~ s/                                                                              //){
        }
        else{
            print $output_fh "$line\n";
        }
        select undef, undef, undef, 0.05;
    }
}

# takes strref
sub cp437_to_unicode {
    my $strref = shift;
    from_to($$strref, "IBM437", "utf8");
    #_utf8_on($$strref);
    my $mapped = Encode::encode_utf8($$strref);
    $strref = \$mapped;

    # fix perl's gay mapping
    $$strref =~ s/\x{004}/\x{2666}/g;
}

# returns the high-intensity version of this color, if available


sub color2mirc_fg {
    my $color = shift;
    return $color2mircmap{$color};
}

sub colorinfo2mirc {
    my $color = shift;

    my $fgcolor = $color->{fgcolor};
    my $bgcolor = $color->{bgcolor};

    #    return '' if $termout;
    return '' unless $fgcolor || $bgcolor;



    my $fg = $fgcolor ? color2mirc_fg($fgcolor) : '';
    my $bg = $bgcolor ? color2mirc_bg($bgcolor) : '';

    #print "ansi fg: $fgcolor irc: $fg";
    #print "ansi bg: $bgcolor irc: $bg";

    #$fg =  color2mirc_fg($fgcolor) if $fgcolor && $color->{bold};
    
    return "\033[1m$fgcolor;$bgcolor;m" if $termout;

    if ($bg) {
        $fg ||= 0;
        if ($fgcolor && defined $color->{bold}){
            return "\002\003$fg,$bg";
        }
        else{
            return "\003$fg,$bg";
        }
    }

    return "\003$fg";
}
;

sub ans2color {
    my $ans = shift;
    return '' unless $ans;
    my $mirc_color = $ans2mircmap{$ans};
    return '' unless defined $mirc_color;
    return $mirc2colormap{$mirc_color};
}

Depends heavily on the length of the channel's name + nick name + host + ident + real name.