#!/usr/local/bin/perl -s
package romkan;
;######################################################################
;#
;# romkan.pl: romaji-to-kana convertion subroutine for Perl
;#
;# Copyright (c) 1993 Kazumasa Utashiro <utashiro@sra.co.jp>
;# Software Research Associates, Inc., Japan
;#
;# Original: Jan 12 1993
;; $rcsid = q$Id: romkan.pl,v 1.4 1993/05/03 16:28:13 utashiro Exp $;
;#
;######################################################################
;#
;# SYNOPSIS
;#
;#	$kana = &romkan($roma [, CODE [, KATAKANA]] );
;#
;# DESCRIPTION
;#
;#	Subroutine &romkan returns KANA string expressed by the first
;#	argument.  It returns undef when translation was failed.
;#
;#	Second argument specifies the encoding of return string.  It
;#	is encoded in 'euc' by default.  Use 'euc', 'sjis' or 'jis'.
;#
;#	If the third argument is supplied and its value is
;#	true, return string is expressed by KATAKANA rather
;#	than HIRAGANA which is default.  Use undef for
;#	second argument if you don't want to specify the code.
;#
;######################################################################
;#
;# SAMPLE:
;#
;#	require('romkan.pl');
;#	while (<>) {
;#	    s/[\w\-]+/&romkan($&)||$&/ge unless 1 .. /^$/;
;#	    print;
;#	}
;#
;######################################################################

require('jcode.pl');

$pcode = 'euc';

$romkan_table = <<'__TABLE_END__' unless $romkan_table;
a	あ	i	い	u	う	e	え	o	お
ka	か	ki	き	ku	く	ke	け	ko	こ
ga	が	gi	ぎ	gu	ぐ	ge	げ	go	ご
sa	さ	si	し	su	す	se	せ	so	そ
za	ざ	zi	じ	zu	ず	ze	ぜ	zo	ぞ
ta	た	ti	ち	tu	つ	te	て	to	と
				tsu	つ
da	だ	di	ぢ	du	づ	de	で	do	ど
na	な	ni	に	nu	ぬ	ne	ね	no	の
ha	は	hi	ひ	hu	ふ	he	へ	ho	ほ
fa	ふぁ	fi	ふぃ	fu	ふ	fe	ふぇ	fo	ふぉ
pa	ぱ	pi	ぴ	pu	ぷ	pe	ぺ	po	ぽ
ba	ば	bi	び	bu	ぶ	be	べ	bo	ぼ
ma	ま	mi	み	mu	む	me	め	mo	も
ya	や			yu	ゆ			yo	よ
ra	ら	ri	り	ru	る	re	れ	ro	ろ
wa	わ	wi	ゐ			we	ゑ	wo	を
kya	きゃ			kyu	きゅ	kye	きぇ	kyo	きょ
gya	ぎゃ			gyu	ぎゅ	gye	ぎぇ	gyo	ぎょ
sha	しゃ	shi	し	shu	しゅ	she	しぇ	sho	しょ
zya	じゃ			zyu	じゅ	zye	じぇ	zyo	じょ
ja	じゃ	ji	じ	ju	じゅ	je	じぇ	jo	じょ
jya	じゃ			jyu	じゅ	jye	じぇ	jyo	じょ
tya	ちゃ	thi	てぃ	tyu	ちゅ	tye	ちぇ	tyo	ちょ
cha	ちゃ	chi	ち	chu	ちゅ	che	ちぇ	cho	ちょ
dya	ぢゃ	dhi	でぃ	dyu	ぢゅ	dye	ぢぇ	dyo	ぢょ
nya	にゃ			nyu	にゅ	nye	にぇ	nyo	にょ
hya	ひゃ			hyu	ひゅ	hye	ひぇ	hyo	ひょ
pya	ぴゃ			pyu	ぴゅ	pye	ぴぇ	pyo	ぴょ
bya	びゃ			byu	びゅ	bye	びぇ	byo	びょ
mya	みゃ			myu	みゅ	mye	みぇ	myo	みょ
rya	りゃ			ryu	りゅ	rye	りぇ	ryo	りょ
xa	ぁ	xi	ぃ	xu	ぅ	xe	ぇ	xo	ぉ
xwa	ゎ	xtsu	っ	xtu	っ
xya	ゃ			xyu	ゅ			xyo	ょ
n'	ん	n	ん
-	ー
__TABLE_END__

&jcode'convert(*romkan_table, $pcode);
%romkan = @romkan = split(/\s+/, $romkan_table);
$consonants = 'ckgszjtdhfpbmyrw';
for ($consonants =~ /./g) { $romkan{"$_$_"} = $romkan{'xtsu'}; }
for (0..9) { $romkan{$_} = $_; }

;;; eval($sub_romkan = q%
sub main'romkan {
    local($_, $code, $katakana) = @_;
    local($kana) = '';
    while (length) {
% .	join('', grep(++$i%2 && ($_ = "\tnext if s/^$_//i;\n"), @romkan)) . q%
	next if s/^\d//;
	next if s/^([%.$consonants.q%])\1/\1/i;
	last;
    } continue {
	$kana .= $romkan{"\L$&"};
    }
    return undef if length;
    $kana =~ s/\244(.)/\245$1/g if $katakana;
    &jcode'convert(*kana, $code, $pcode) if $code && $code ne $pcode;
    $kana;
}
%);

;######################################################################
if (__FILE__ eq $0) {	# test main
    package main;

    print $romkan'sub_romkan if $debug; #''
    $/ = '' unless -t STDIN;
    while (<>) {
	print unless -t STDIN;
	s/[\w\-]+/&romkan($&)||$&/ge;
	print;
    }
}
;######################################################################

1;