#!/usr/local/bin/perl
#
# italk2html.pl : convert italk log into html.
#
#  (c) 1997 Yutaka Oiwa. All rights are reserved. 
#
# $Id: italk2html.pl,v 1.4 1998/09/15 12:55:14 yutaka Exp $
#

%moduleopts = ();

if (! caller() ) {
    while ($_ = $ARGV[0], /^-/) {
	shift;
	last if /^--$/;
	/^-bg=(..*)/ && ($opt_bgcolor = $1);
	/^-bg/ && ($opt_bgcolor = 'White');
	/^-euc/ && ($moduleopts{euc} = 1);
	/^-facett/ && ($moduleopts{facett} = 1);
	/^-systemtt/ && ($moduleopts{systemtt} = 1);
	/^-timetag/ && ($moduleopts{timetag} = 1);
	/^-spencode/ && ($moduleopts{spencode} = 1);
	/^-newtarget/ && ($moduleopts{target} = '_new');
    }
    
    &italk2html::init(%moduleopts);
    
    print
"<HTML>
<HEAD>
<TITLE>italk log $ARGV[0]</TITLE>
<meta http-equiv=\"Content-Type\" content=\"text/html; charset=ISO-2022-JP\">
";

    $opt_bgcolor && print "<BODY bgcolor=\"$opt_bgcolor\">\n";
    $opt_bgcolor || print "<BODY>\n";
    
    while(<>) {
	print &italk2html::conv($_);
    }
    
    print "</BODY>\n";
    exit 0;
}

package italk2html;

sub first_init {
    $url = '(((https?|ftp|italk)://|mailto:)[A-Za-z0-9---.:\~\/\#&_%@!=+]+)';
    
    $face = '('. join('|',
		      '([:=]-?([()D]|\&[lg]t\;)[ ~]*)', # 横
		      '(\(?[i;:T]_[i;:T]\)?)', # 泣
		      '(\([-^]_?[-^]\)?;*)', # 汗
		      '(\([x\^\=\?-][o_][x\^\=\?-]\))' # その他横
		     ) . ')';
    
    # 無脳の名前は JIS コードの必要がある。スクリプトのコードに依存しないよう、
    # \e と ASCII で開いて表記しておく。
    {
	local $options{euc} = undef;
	$dengon_name = &upencode("\e\$BEA8\@7/\e(B"); # "伝言君"
	$chukei_name = &upencode("\e\$BCf7Q7/\e(B"); # "中継君"
    }
    
    $daemon_regexp = "$dengon_name|$chukei_name"; # care: ( ) might be required
    $firstinited = 1;
}
    
sub init {
    %options = @_;

    &first_init if (!$firstinited);

    $time = "_";

    $inited = 1;

    $BR = ($options{suppress_br} ? "" : "<BR>");
	
}

sub conv {
    local ($_) = @_;
    my $result = "";
    $newtime = 0;

    &init() if (!$inited);
    s/\n$//;
    s/\r$//;
    $_ = &upencode($_);
    if (/^\(\[/) {
				# 出入り
	$_ = &ampencode($_);
	return &downdecode("<FONT COLOR=\"Red\">$_</FONT>$BR\n");
    } elsif (/^[\#]/) {
				# サーバ起動など
	$_ = &ampencode($_);
	if ($options{systemtt}) {
	    return &downdecode("<CODE><FONT COLOR=\"Purple\">$_</FONT></CODE>$BR\n");
	}
	return &downdecode("<FONT COLOR=\"Purple\">$_</FONT>$BR\n");
#    } elsif (/^(\(\d\d:\d\d:\d\d\))(\[[^\]]+\] )/o) {
    } elsif (/^(\(\d\d:\d\d:\d\d\))(\[([^\] ]+[\] ]?)+\] )/o) {
				# 通常のメッセージ
	$curtime = &maketimetag($1);
	if ($time ne $curtime) {
	    $newtime = 1;
	    $time = $curtime;
	}

	if ($newtime && $options{timetag}) {
	    $result .= "<a name=\"$curtime\">";
	}
	$result .= "<FONT COLOR=\"Blue\">$1</FONT>";
	if ($newtime && $options{timetag}) {
	    $result .= "</a>";
	}
	$a = &ampencode($2);
	if (/^(\(\d\d:\d\d:\d\d\))\[($daemon_regexp)\] (\[[^\]]+\] )/o) {
				# 伝言再生や中継メッセージ
	    $result .= &downdecode("<FONT COLOR=\"Purple\">[$2] </FONT>");
	    $a = &ampencode($3);
	    $result .= &downdecode("<FONT COLOR=\"Green\">$a</FONT>");
	} elsif (/^(\(\d\d:\d\d:\d\d\))\[($daemon_regexp)\] /o) {
				# 伝言君や中継君の自主発言
	    $result .= &downdecode("<FONT COLOR=\"Purple\">[$2] </FONT>");
	} else {
				# 一般メンバー
	    $result .= &downdecode("<FONT COLOR=\"Green\">$a</FONT>");
	}
	$_ = $';
	$_ = &ampencode($_);	# & などを変換して
	if ($options{target}) {
	    s|$url|<a href="$&" target="$options{target}">$&</a>|go;
	} else {
	    s|$url|<a href="$&">$&</a>|go;
	}
	# URL をマーク。
	s@$face@<tt>$&</tt>@go if $options{facett};

	if ($options{timetag}) {
	    s/(\(\d\d:\d\d:\d\d\))\[/&maketimelink($&)/e;
	}
	
	$result .= &downdecode("$_");
	$result .= "$BR\n";
    } else {
	# 謎。(^^;
	$result .= &downdecode(&ampencode($_)). "$BR\n";
    }
    return $result;
}

sub maketimetag {
    local($_) = @_;
    tr/()://d;
    $_;
}

sub maketimelink {
    local($_) = @_;

    return $_ unless /\(\d\d:\d\d:\d\d\)/;
    $` . "<a href=\"#" . &maketimetag($&) . "\">" . $& . "</a>" . $';
}

sub lower {
    local ($_, $rem) = @_;
    s/$rem//g;
    tr/\200-\377/\000-\177/;
    $_;
}

sub upencode {
    local ($_) = @_;

    if ($options{euc}) {
	s/([\xa1-\xfe][\xa1-\xfe])+/"\e\$B".lower($&,0)."\e(B"/eg; # G1 is JISX0208
	s/(\x8e[\xa1-\xfe])+/"\e(I".lower($&,"\x8e")."\e(B"/eg; # G2 is JISX0201
	s/(\x8f[\xa1-\xfe][\xa1-\xfe])+/"\e\$(D".lower($&,"\x8f")."\e(B"/eg; # G2 is JISX0201
    }

    $iso2022char = '((\e(\$[\(\)\*\+]?[@A-D]|[\(\)\*\+][@HIJ]|[---.\/]A)[!-~]*)+\e\(B)';

    s/$iso2022char/&encode2($&)/ego;

#        if ($options{euc}) {
#	s/([\xa1-\xfe][\xa1-\xfe])+/\233\244\302$&\233\250\302/g; # G1 is JISX0208
#	s/(\x8e[\xa1-\xfe])+/\233\250\311$&\233\250\302/g; # G2 is JISX0201
#	s/(\x8f[\xa1-\xfe][\xa1-\xfe])+/\233\244\304$&\233\250\302/g; # G2 is JISX0201
#    }

    $_;
}

sub encode2 {
    local ($_) = @_;

    s/[\200-\377]/\377$&/g;	# C1 -> 0xff + ?
    tr/\000-\176/\200-\376/;	# C0 -> convert to C1
    $_;
}

sub downdecode {
    local ($_) = @_;
    s/\377?[\200-\377]/&down2($&)/eg;

    $_;
}

sub down2 {
    local ($_) = @_;

    ($_ =~ /\377(.)/) ? $1 : (tr/\200-\376/\000-\176/, $_);
}

sub ampencode {
    local ($_) = @_;

    s/&/&amp;/g;
    s/</&lt;/g;
    s/>/&gt;/g;
    if ($options{spencode}) {
	s/ ( +)/" " . "&nbsp;" x length($1)/eg;
    }
    # Latin 1 might be converted here. (ex. &Agrave;)
    $_;
}

sub hexdump {			# for debug
    local ($_) = @_;

    s/./unpack("H2",$&)/eg;
    $_;
}

1;

