#
# onccnv.pl --- HTML to ONCコンバータ
#
# 改造、再配布など煮るなり焼くなり好きにしてください。
# by M.Kawakami
#
# $Id: onccnv.pl,v 1.1 2000/07/02 07:58:33 yar-3 Exp $
#
# ChangeLog:
# 2.0β HTML Parseを使わないで自前でどうにかする
# 2.0.1 自分自身($gwurl)へのリンクをG/W機能を経由せずに処理する
# ようにSELのリンクを修正
use Socket;
package ONCConv;
require Exporter;
@ISA = qw(Exporter);
@EXPORT = qw(paser);
@EXPORT_OK = qw(to_url);
$knjconv_unchecked = 1;
$use_nkf = 0; # 1ならNKF.pm、0ならjcode.plを使用する
sub new {
my $self = {};
my $class = shift;
bless $self;
$self->{gwurl} = shift;
$self->{baseuri} = shift;
$self->{ref_max} = shift || 40; # 最大リンク数
$self->{use_maru} = shift; # 丸数字使用
$self->{ref_count} = 0; # LINKカウント
$self->{strings} = '';
$self->{links} = [];
return $self;
}
# 漢字変換パッケージ自動判別
sub chk_knj_conv {
if ($knjconv_unchecked) {
if (defined &main::nkf) {
$use_nkf = 1;
} else {
$use_nkf = 0;
}
#print "** use_nkf = $use_nkf **\n";
$knjconv_unchecked = 0;
}
}
# HTMLテキストを解析してリンクを取り出す
sub parse {
my $self = shift;
my $intext = shift;
#print "**intext=[$intext]\n";
$self->{strings} = '';
my $links = $self->{links};
while ($intext =~ /<(.*?)>/) {
my $tag = $1;
my $post_tag = $';
$self->{strings} .= $`;
if ($tag =~ /a.+?href="(.*?)"/i) {
my $maru;
my $link = $self->to_url($1);
push(@$links, $link);
$self->{ref_count}++;
if ($self->{use_maru} && $self->{ref_count} <= 20) {
$maru = pack("CC", 0xad, 0xa0 + $self->{ref_count});
} else {
$maru = sprintf("[%d]", $self->{ref_count});
}
$self->{strings} .= $maru;
}
if ($tag =~ /^(br|p|li|h\d+|address)$/i) {
$self->{strings} .= "\n";
}
if ($tag =~ /^hr$/i) {
$self->{strings} .= "\n_____________\n";
}
$intext = $post_tag;
}
$self->{strings} .= $intext;
if ($self->{ref_count} >= $self->{ref_max}) {
$self->{strings} .= "[リンクが多すぎます(>" . $self->{ref_max} . ")]\n";
}
$self->{links} = $links;
}
#
sub to_url {
my $self = shift;
my $link = shift;
my $url;
if ($link =~ /http:\/\/.*?\/.*?\/?[^\/]*/) {
$url = $link;
} elsif ($link =~/^\/.*?\/?[^\/]*/) {
$self->{baseuri} =~/http:\/\/([^\/]*?)(\/.*?\/?)([^\/]*)$/;
$url = "http://" . $1 . $link;
} else {
# $url = "http://" . $self->{baseuri} . $link;
$url = $self->{baseuri} . $link;
}
return $url;
}
# HTMLをONCに変換
sub main::conv_html2onc($$$;$$) {
my ($intext, $gwurl, $baseuri, $refmax, $usemaru) = @_;
my $out, $sels, $url, $link, $i;
&ONCConv::chk_knj_conv;
$refmax = 40 if (!$refmax);
my $onccnv = new ONCConv($gwurl, $baseuri, $refmax, $usemaru);
$intext =~ s/\n\s+/\n/g;
$intext =~ s/\s+\n/\n/g;
$intext =~ s/\n/ /g;
$onccnv->parse($intext);
$out = $onccnv->{strings};
# $out =~ s/[ \t]+\n/\n/g; # 行末空白除去
# $out =~ s/\n\n+/\n/g; # 複数改行は１つに
# $out =~ s/(\S)[ \t]+/$1 /g; # 行中の複数空白は１つに
# $out =~ s/^\n//; # Contents先頭の空行を除去
{
my $u = $gwurl;
$u =~ s/^http://;
$sels = "\n";
$i = 0;
}
$links = $onccnv->{links};
for $link (@$links) {
my $u = $link;
$u =~ s/([:?=&\/\.~])/sprintf("%%%2X",ord($1))/egi ;
$i++;
if (index($link, "$gwurl?") == 0) {
# 自分自身($gwurl)へのリンク
$u = $link;
$u =~ s/[?]/?d=/; # i-system special feature
# http://hoge/hoge.cgi?20000101 --> http://hoge/hoge.cgi?d=20000101
} else {
$u = "$gwurl?U=$u";
}
$u =~ s/^http://;
$sels .= "\n";
}
$out = "Content-type: text/plain\n\n"
. "From: $baseuri\n"
. "Subject: $baseuri\n"
. "Content-Type: Text/X-PmailDX\n\n"
. "$sels$out";
$out;
}
package main;
# オープンネットコンテンツ GW動作
sub onc_gateway ($$;$$) {
my ($url, $gwurl, $ref_max, $flag_maru) = @_;
&ONCConv::chk_knj_conv;
# 表題or本文で URL を指定した場合、全角で送って来る端末もある。
if ($ONCConv::use_nkf) {
$url = nkf('-e', $url) ;
} else {
jcode::convert( \$url , 'euc' ) ;
}
$url =~ s/\s+$// ;
$url =~ s/^\s+// ;
if ($ONCConv::use_nkf) {
$url = nkf('-Z', $url) ;
} else {
jcode::tr( \$url , "〜￣―ー−" , "~~---" ) ;
jcode::tr( \$url ,
"０-９Ａ-Ｚａ-ｚ " , "0-9A-Za-z " ) ;
jcode::tr( \$url ,
"＃♯＄％＆（）＊＋，．／：；＜＝＞？＠［］＾＿" ,
"##\$%&()*+,./:;<=>?\@[]^_" ) ;
}
# オープンネットコンテンツの処理
if ( $url =~ /^\.(.+)/ ) { # '.' による省略の補完(masato)
$url = $abbrev . $1 ;
}
if ( $url !~ /^[a-z]+:/ ) { # proto:が無い場合は http://を付加する
$url = 'http://' . $url;
}
if ( $url =~ /^http:\/\/[^\"\\]+$/i ) { #"
my $baseurl = $url;
$baseurl =~ s/[?](.+)$//;
my $intext = &get_html_text($url);
if ($ONCConv::use_nkf) {
$intext = nkf('-e', $intext) ;
} else {
jcode::convert( \$intext , 'euc' ) ;
}
my $text = &main::conv_html2onc($intext, $gwurl, $baseurl, $ref_max, $flag_maru);
$text .= "\n0:終了\n" ;
if ($ONCConv::use_nkf) {
$text = nkf('-s', $text) ;
} else {
jcode::convert( \$text , 'sjis' ) ;
}
print $text ;
} else {
# http以外のプロトコルは、禁止。
# ftp,telnet,file://... などは危険＆無駄。
my $ans = <<"EOF" ;
Content-type: text/plain
X-PmailDX-CTRL: LineDisconnect
From: $baseuri
Subject: プロトコルには http しか使えません。
Content-Type: Text/X-PmailDX
$url
切断します。
EOF
if ($ONCConv::use_nkf) {
$intext = nkf('-s', $intext) ;
} else {
jcode::convert( \$ans , 'sjis' ) ;
}
print $ans ;
}
}
# 自前でHTMLテキストを得る
sub get_html_text ($) {
my ($url) = @_;
my $intext = '';
local (*IN);
return '' if ($url eq '');
my ($h, $d, $server, $file) = split(/\//, $url, 4);
my ($server, $port)= split(/\:/, $server);
$port = 80 if ($port eq '');
$remote_address = sockaddr_in($port, inet_aton($server));
$proto = getprotobyname('tcp');
socket(IN,PF_INET,SOCK_STREAM,$proto)
|| die "Socket: $!";
my $c = 0;
do {
$result = connect(IN, $remote_address);
if ($c++ >= 10) {
return <
CONNECT ERROR
Connect Error!